diff --git a/ChangeLog b/ChangeLog index ce791e684d36..47ebaca41b8d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,114 @@ ====================================================================== +Originator: fischer-ncar +Date: July 7, 2016 +Tag: cime4.5.22 +Answer Changes: None +Tests: +Dependencies: + +Brief Summary: Fix broken compset names + +User interface changes: + +Modified files: git diff --name-status + +M cime_config/cesm/allactive/config_compsets.xml +M cime_config/cesm/allactive/testlist_allactive.xml + +====================================================================== + +Originator: cacraigucar, fischer-ncar +Date: July 7, 2016 +Tag: cime4.5.21 +Answer Changes: Possible answer changes only on corip1 +Tests: Ran with CAM tag geotrace3_cac_n59_cam5_4_57 +Dependencies: None + +Brief Summary: + Incorporating water isotopes + Update modules for corip1 + +User interface changes: none + +Modified files: git diff --name-status +M ChangeLog +M cime_config/cesm/allactive/config_compsets.xml +M cime_config/cesm/allactive/config_pes.xml +M cime_config/cesm/allactive/testlist_allactive.xml +M cime_config/cesm/machines/config_machines.xml +M driver_cpl/bld/build-namelist +M driver_cpl/bld/namelist_files/namelist_definition_drv.xml +M driver_cpl/cime_config/config_component.xml +A driver_cpl/driver/mrg_mod.F90 +M driver_cpl/driver/prep_ice_mod.F90 +M driver_cpl/driver/prep_ocn_mod.F90 +M driver_cpl/driver/prep_rof_mod.F90 +M driver_cpl/driver/seq_diag_mct.F90 +M driver_cpl/driver/seq_flux_mct.F90 +M driver_cpl/shr/seq_flds_mod.F90 +M share/csm_share/shr/shr_const_mod.F90 +M share/csm_share/shr/shr_flux_mod.F90 +A share/csm_share/shr/water_isotopes.F90 +A share/csm_share/shr/water_types.F90 + +====================================================================== + +Originator: fischer-ncar, Brain Kauffman +Date: 6 July 2016 +Tag: cime4.5.20 +Answer Changes: None +Tests: +Dependencies: + +Brief Summary: Updates to config_files.xml and config_grids.xml to support mpas-o + +User interface changes: + +Modified files: git diff --name-status +M cime_config/cesm/config_files.xml +M cime_config/cesm/config_grids.xml + +====================================================================== + +Originator: apcraig +Date: 6 July 2016 +Tag: cime4.5.19 +Answer Changes: None +Tests: +Dependencies: + +Brief Summary: Addition of ice to ocean coupling fields Fioi_bcphi, + Fioi_bcpho, Fioi_flxdst + +User interface changes: + +Modified files: git diff --name-status +M driver_cpl/shr/seq_flds_mod.F90 + +====================================================================== + +Originator: fischer-ncar, jtruesdal +Date: 6 July 2016 +Tag: cime4.5.18 +Answer Changes: Answer changes for compset with WaveWatch turned on. + All others are bit-for-bit. +Tests: Namelist test ran on yellowstone, WAV_GRID manually looked at. +Dependencies: + +Brief Summary: Add support to run WaveWatch. Allactive + compset not being tested were removed. + +User interface changes: + +Modified files: git diff --name-status +M cime_config/cesm/allactive/config_compsets.xml +M cime_config/cesm/allactive/config_pes.xml +M cime_config/cesm/allactive/testlist_allactive.xml +M cime_config/cesm/config_grids.xml + +====================================================================== + Originator: fischer-ncar Date: 21 June 2016 Tag: cime4.5.17 diff --git a/cime_config/cesm/allactive/config_compsets.xml b/cime_config/cesm/allactive/config_compsets.xml index 486141e79cdc..c21a9261a76b 100644 --- a/cime_config/cesm/allactive/config_compsets.xml +++ b/cime_config/cesm/allactive/config_compsets.xml @@ -13,7 +13,7 @@ TIME_ATM[%phys]_LND[%phys]_ICE[%phys]_OCN[%phys]_ROF[%phys]_GLC[%phys]_WAV[%phys][_ESP%phys][_BGC%phys] Where for the CAM specific compsets below the following is supported TIME = Time period (e.g. 2000, HIST, RCP8...) - ATM = [CAM40, CAM5] + ATM = [CAM4, CAM5] LND = [CLM40, CLM45, CLM50, SLND] ICE = [CICE, DICE, SICE] OCN = [DOCN, ,AQUAP, SOCN] @@ -41,42 +41,17 @@ - BC4L40P1DR - 2000_CAM40_CLM40%SP_CICE_POP2%1D_RTM_SGLC_SWAV - - - - B1850RG - 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_RTM_CISM1%NOEVOLVE_SWAV_BGC%BDRD - - - - B1850RW - 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_RTM_SGLC_DWAV_BGC%BDRD - - - - B1850GW - 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_MOSART_CISM1%NOEVOLVE_DWAV_BGC%BDRD - - - - B1850W - 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_MOSART_SGLC_DWAV_BGC%BDRD - - - - B1850 + B1850Ws 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_MOSART_CISM1%NOEVOLVE_SWAV_BGC%BDRD - B1850R - 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD + B1850 + 1850_CAM55_CLM50%BGC_CICE_POP2%ECO_MOSART_CISM1%NOEVOLVE_WW3_BGC%BDRD - B1850Cw + B1850CwWs 1850_CAM55%WTSM_CLM50%BGC_CICE_POP2%ECO_MOSART_SGLC_SWAV @@ -87,155 +62,171 @@ - - BC4L40SPR - 2000_CAM40_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV - - - - - BC5L40SPR - 2000_CAM50_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV - - - - - BC5L45BGCR - 2000_CAM50_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV - - BC5L45BGC - 2000_CAM50_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV + 2000_CAM5_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV BC4FCHML40CNR - 2000_CAM40%FCHM_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + 2000_CAM4%FCHM_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV BC4TMOZL40SPR - 2000_CAM40%TMOZ_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV + 2000_CAM4%TMOZ_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV B1850C5L40SPR - 1850_CAM50_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM5_CLM40%SP_CICE_POP2_RTM_SGLC_SWAV + + Bi1850C5 + 1850_CAM5%WISOall_CLM40%SP_WISO_CICE%WISO_POP2%ISO_RTM%WISO_SGLC_SWAV + B1850C4L40CNR - 1850_CAM40_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM4_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV B1850C5L40CNR - 1850_CAM50_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM5_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + + + + Bi1850C5CN + 1850_CAM5%WISOall_CLM40%CN_WISO_CICE%WISO_POP2%ISO_RTM%WISO_SGLC_SWAV B1850C5L45BGCR - 1850_CAM50_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM5_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV B1850C5L45BGC - 1850_CAM50_CLM45%BGC_CICE_POP2_MOZART_SGLC_SWAV + 1850_CAM5_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV B1850C4RCO2L40CNR - 1850_CAM40%RCO2_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM4%RCO2_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV B1850C5WCCML45CNR - 1850_CAM50%WCCM_CLM45%CN_CICE_POP2_RTM_SGLC_SWAV + 1850_CAM5%WCCM_CLM45%CN_CICE_POP2_RTM_SGLC_SWAV B1850C5WCCML45CN - 1850_CAM50%WCCM_CLM45%CN_CICE_POP2_MOSART_SGLC_SWAV + 1850_CAM5%WCCM_CLM45%CN_CICE_POP2_MOSART_SGLC_SWAV BC4WCBCL40CNR - 2013_CAM40%WCBC_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + 2013_CAM4%WCBC_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV B1850C4L40CNRBDRD - 1850_CAM40_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD + 1850_CAM4_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD + + + + BHISTC5L40CNRWs + HIST_CAM5_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + + BiHISTC5CN + HIST_CAM5_CLM40%CN_WISO_CICE%WISO_POP2%ISO_RTM%WISO_SGLC_SWAV + BHISTC5L40CNR - HIST_CAM50_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + HIST_CAM5_CLM40%CN_CICE_POP2_RTM_SGLC_WW3 + + + + BHISTC5L45BGCRWs + HIST_CAM5_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV BHISTC5L45BGCR - HIST_CAM50_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV + HIST_CAM5_CLM45%BGC_CICE_POP2_RTM_SGLC_WW3 + + + + BHISTC5L45BGCWs + HIST_CAM5_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV BHISTC5L45BGC - HIST_CAM50_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV + HIST_CAM5_CLM45%BGC_CICE_POP2_MOSART_SGLC_WW3 + + + + BHISTC4FCHML40CNRWs + HIST_CAM4%FCHM_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV BHISTC4FCHML40CNR - HIST_CAM40%FCHM_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + HIST_CAM4%FCHM_CLM40%CN_CICE_POP2_RTM_SGLC_WW3 BRCP26C4L40CNR - RCP2_CAM40_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV + RCP2_CAM4_CLM40%CN_CICE_POP2_RTM_SGLC_SWAV BRCP45C4L40CNRBDRD - RCP4_CAM40_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD + RCP4_CAM4_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD BRCP85C4L40CNRBPRP - RCP8_CAM40_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP + RCP8_CAM4_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP BRCP85C5L45BGCR - RCP8_CAM50_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV + RCP8_CAM5_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV BRCP85C5L45BGC - RCP8_CAM50_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV + RCP8_CAM5_CLM45%BGC_CICE_POP2_MOSART_SGLC_SWAV B1850C4L45BGCRBPRP - 1850_CAM40_CLM45%BGC_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP + 1850_CAM4_CLM45%BGC_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP B1850C4L45BGCBPRP - 1850_CAM40_CLM45%BGC_CICE_POP2%ECO_MOSART_SGLC_SWAV_BGC%BPRP + 1850_CAM4_CLM45%BGC_CICE_POP2%ECO_MOSART_SGLC_SWAV_BGC%BPRP B1850C5L45BGCRBPRP - 1850_CAM50_CLM45%BGC_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP + 1850_CAM5_CLM45%BGC_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BPRP BHISTC4L40CNRBDRD - HIST_CAM40_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD + HIST_CAM4_CLM40%CN_CICE_POP2%ECO_RTM_SGLC_SWAV_BGC%BDRD @@ -243,59 +234,34 @@ BC5L45BGCRG - 2000_CAM50_CLM45%BGC_CICE_POP2_RTM_CISM1_SWAV + 2000_CAM5_CLM45%BGC_CICE_POP2_RTM_CISM1_SWAV - BC5L45BGCG - 2000_CAM50_CLM45%BGC_CICE_POP2_MOSART_CISM1_SWAV + BC5L45BGCR + 2000_CAM5_CLM45%BGC_CICE_POP2_RTM_SGLC_SWAV B1850C5L45BGCRG2 - 1850_CAM50_CLM45%BGC_CICE_POP2_RTM_CISM2_SWAV - - - - B1850C5L45BGCG2 - 1850_CAM50_CLM45%BGC_CICE_POP2_MOSART_CISM2_SWAV + 1850_CAM5_CLM45%BGC_CICE_POP2_RTM_CISM2_SWAV - - - - - ETEST - 2000_CAM55_CLM50_CICE_DOCN%SOM_MOSART_SGLC_SWAV_TEST - - - - E1850C5L40CNR - 1850_CAM50_CLM40%SP_CICE_DOCN%SOM_RTM_SGLC_SWAV - Requires additional user-supplied datasets> - - E1850C5L45TEST - 1850_CAM50_CLM45%SP_CICE_DOCN%SOM_MOSART_SGLC_SWAV_TEST - - - - E1850C4L40CNR - Requires additional user-supplied datasets - 1850_CAM40_CLM40%CN_CICE_DOCN%SOM_RTM_SGLC_SWAV + 1850_CAM5_CLM45%SP_CICE_DOCN%SOM_MOSART_SGLC_SWAV_TEST 0001-01-01 diff --git a/cime_config/cesm/allactive/config_pes.xml b/cime_config/cesm/allactive/config_pes.xml index 2f3de2879b63..b304093cc54e 100644 --- a/cime_config/cesm/allactive/config_pes.xml +++ b/cime_config/cesm/allactive/config_pes.xml @@ -897,7 +897,7 @@ -7 -8 -1 - -12 + -8 -12 @@ -960,6 +960,43 @@ + + + + none + + 640 + 96 + 96 + 544 + 96 + 180 + 180 + 640 + + + 2 + 1 + 1 + 2 + 1 + 2 + 2 + 2 + + + 0 + 544 + 544 + 0 + 640 + 0 + 0 + 0 + + + + @@ -1259,7 +1296,81 @@ - + + none + + -40 + -24 + -24 + -16 + -6 + -40 + -40 + -40 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + -24 + -40 + 0 + 0 + 0 + + + + + + + + none + + -40 + -24 + -24 + -16 + -6 + -40 + -8 + -40 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + -24 + -40 + 0 + 0 + 0 + + + + + + + none -40 diff --git a/cime_config/cesm/allactive/testlist_allactive.xml b/cime_config/cesm/allactive/testlist_allactive.xml index db7f93ad0985..edfe2502978c 100644 --- a/cime_config/cesm/allactive/testlist_allactive.xml +++ b/cime_config/cesm/allactive/testlist_allactive.xml @@ -49,7 +49,7 @@ - + @@ -57,7 +57,7 @@ - + @@ -67,7 +67,7 @@ - + @@ -151,7 +151,7 @@ - + @@ -159,7 +159,7 @@ - + @@ -199,14 +199,6 @@ - - - - - - - - @@ -292,7 +284,7 @@ - + diff --git a/cime_config/cesm/config_files.xml b/cime_config/cesm/config_files.xml index 7f4dcc803d4a..13643c765dcd 100644 --- a/cime_config/cesm/config_files.xml +++ b/cime_config/cesm/config_files.xml @@ -88,6 +88,7 @@ $SRCROOT/components/clm/cime_config/config_compsets.xml $SRCROOT/components/cice/cime_config/config_compsets.xml $SRCROOT/components/pop/cime_config/config_compsets.xml + $SRCROOT/components/mpas-o/cime_config/config_compsets.xml case_last env_case.xml @@ -105,6 +106,7 @@ $SRCROOT/components/clm/cime_config/config_pes.xml $SRCROOT/components/cice/cime_config/config_pes.xml $SRCROOT/components/pop/cime_config/config_pes.xml + $SRCROOT/components/mpas-o/cime_config/config_pes.xml case_last env_case.xml @@ -162,6 +164,7 @@ $SRCROOT/components/rtm/cime_config/usermods_dirs $SRCROOT/components/mosart/cime_config/usermods_dirs $SRCROOT/components/pop/cime_config/usermods_dirs + $SRCROOT/components/mpas-o/cime_config/usermods_dirs case_last env_case.xml @@ -243,6 +246,7 @@ unset $SRCROOT/components/pop/cime_config/config_component.xml + $SRCROOT/components/mpas-o/cime_config/config_component.xml $SRCROOT/components/aquap/cime_config/config_component.xml $CIMEROOT/components/data_comps/docn/cime_config/config_component.xml $CIMEROOT/components/stub_comps/socn/cime_config/config_component.xml diff --git a/cime_config/cesm/config_grids.xml b/cime_config/cesm/config_grids.xml index 0889974be051..5081b2a389be 100644 --- a/cime_config/cesm/config_grids.xml +++ b/cime_config/cesm/config_grids.xml @@ -21,6 +21,7 @@ + a%gx1v6_l%gx1v6_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%null gx1v6_gx1v6 @@ -103,260 +104,455 @@ - + T31_gx3v7 T31_g37 - a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%ww3a + + + T31_gx3v7 + T31_g37 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%ww3a - T31_gx3v7 T31_g37 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%null - T31_gx3v7 T31_g37 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%null + + T31_gx3v7 + T31_g37 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%null_w%ww3a + + + T31_gx3v7 + T31_g37 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + + + + + T31_gx3v7_gland4 + T31_g37_gl4 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%ww3a + T31_gx3v7_gland4 T31_g37_gl4 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%null + + + + T31_gx3v7_gland10 + T31_g37_gl10 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland10_w%ww3a + T31_gx3v7_gland10 T31_g37_gl10 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland10_w%null + + + T31_gx3v7_gland20 + T31_g37_gl20 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland20_w%ww3a + T31_gx3v7_gland20 T31_g37_gl20 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland20_w%null + + + + T31_gx3v7_gl5 + T31_g37_gl5 + a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%ww3a + T31_gx3v7_gl5 T31_g37_gl5 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%null + + + + T85_0.9x1.25_tx0.1v2 + T85_f09_t12 + a%T85_l%0.9x1.25_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a + T85_0.9x1.25_tx0.1v2 T85_f09_t12 a%T85_l%0.9x1.25_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + + + + T341_0.23x0.31_tx0.1v2 + T341_f02_t12 + a%T341_l%0.23x0.31_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a + T341_0.23x0.31_tx0.1v2 T341_f02_t12 a%T341_l%0.23x0.31_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + T31_T31 T31_T31 a%T31_l%T31_oi%T31_r%r05_m%gx3v7_g%null_w%null - T31_T31 T31_T31 a%T31_l%T31_oi%T31_r%r05_m%gx3v7_g%gland5UM_w%null + + T31_T31 T31_T31 a%T31_l%T31_oi%T31_r%r05_m%gx3v7_g%gland4_w%null + + T31_T31_gl5 T31_T31_gl5 a%T31_l%T31_oi%T31_r%r05_m%gx3v7_g%gland5UM_w%null + + T42_T42 T42_T42 a%T42_l%T42_oi%T42_r%r05_m%usgs_g%null_w%null + + T85_T85 T85_T85 a%T85_l%T85_oi%T85_r%r05_m%usgs_g%null_w%null + + + + T62_gx3v7 + T62_g37 + a%T62_l%T62_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%ww3a + T62_gx3v7 T62_g37 a%T62_l%T62_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%null + + + + T62_tx1v1 + T62_s11 + a%T62_l%T62_oi%tx1v1_r%rx1_m%tx1v1_g%null_w%ww3a + T62_tx1v1 T62_s11 a%T62_l%T62_oi%tx1v1_r%rx1_m%tx1v1_g%null_w%null + + + + T62_tx0.1v2 + T62_t12 + a%T62_l%T62_oi%tx0.1v2_r%rx1_m%tx0.1v2_g%null_w%ww3a + T62_tx0.1v2 T62_t12 a%T62_l%T62_oi%tx0.1v2_r%rx1_m%tx0.1v2_g%null_w%null + + + + T62_gx1v6 + T62_g16 + a%T62_l%T62_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%ww3a + T62_gx1v6 T62_g16 a%T62_l%T62_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%null + + + + T62_mpas120 + T62_m120 + a%T62_l%T62_oi%mpas120_r%rx1_m%mpas120_g%null_w%ww3a + T62_mpas120 T62_m120 a%T62_l%T62_oi%mpas120_r%rx1_m%mpas120_g%null_w%null + + + + T62_oQU120 + T62_oQU120 + a%T62_l%T62_oi%oQU120_r%rx1_m%oQU120_g%null_w%null + + + + + + 0.23x0.31_gx1v6 + f02_g16 + a%0.23x0.31_l%0.23x0.31_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + 0.23x0.31_gx1v6 f02_g16 a%0.23x0.31_l%0.23x0.31_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + + 0.23x0.31_tx0.1v2 + f02_t12 + a%0.23x0.31_l%0.23x0.31_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a + 0.23x0.31_tx0.1v2 f02_t12 a%0.23x0.31_l%0.23x0.31_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + + + 0.47x0.63_gx1v6 + f05_g16 + a%0.47x0.63_l%0.47x0.63_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + 0.47x0.63_gx1v6 f05_g16 a%0.47x0.63_l%0.47x0.63_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + 0.47x0.63_tx0.1v2 + f05_t12 + a%0.47x0.63_l%0.47x0.63_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a + 0.47x0.63_tx0.1v2 f05_t12 a%0.47x0.63_l%0.47x0.63_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null - + + + 0.9x1.25_gx1v6 f09_g16 - a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a - - + 0.9x1.25_gx1v6 f09_g16 - a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a - - + 0.9x1.25_gx1v6 f09_g16 - a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null - 0.9x1.25_gx1v6 f09_g16 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null - - + 0.9x1.25_gx1v6 f09_g16 - a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + + + 0.9x1.25_gx1v6 + f09_g16 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null - + + + 0.9x1.25_gx1v6 f09_g16 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + + 0.9x1.25_gx1v6 + f09_g16 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + + + 0.9x1.25_gx1v6_gland4 + f09_g16_gl4 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + 0.9x1.25_gx1v6_gland4 f09_g16_gl4 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null + + + + 0.9x1.25_gx1v6_gland10 + f09_g16_gl10 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland10_w%ww3a + 0.9x1.25_gx1v6_gland10 f09_g16_gl10 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland10_w%null + + + + 0.9x1.25_gx1v6_gland20 + f09_g16_gl20 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland20_w%ww3a + 0.9x1.25_gx1v6_gland20 f09_g16_gl20 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland20_w%null + + + + 0.9x1.25_gx1v6_gl5 + f09_g16_gl5 + a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + 0.9x1.25_gx1v6_gl5 f09_g16_gl5 a%0.9x1.25_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null - + + + 1.9x2.5_gx1v6 f19_g16 - a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a - 1.9x2.5_gx1v6 f19_g16 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null - - + 1.9x2.5_gx1v6 f19_g16 - a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a - 1.9x2.5_gx1v6 f19_g16 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null - - + 1.9x2.5_gx1v6 f19_g16 - a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a - - + + 1.9x2.5_gx1v6 + f19_g16 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + 1.9x2.5_gx1v6 f19_g16 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + + 1.9x2.5_gx1v6 + f19_g16 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + + + 1.9x2.5_gx1v6_gland4 + f19_g16_gl4 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + 1.9x2.5_gx1v6_gland4 f19_g16_gl4 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null + + + 1.9x2.5_gx1v6_gl5 + f19_g16_gl5 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + 1.9x2.5_gx1v6_gl5 f19_g16_gl5 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null + + 1.9x2.5_gx1v6_r01 + f19_g16_r01 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r01_m%gx1v6_g%null_w%ww3a + Non-standard grid, for testing high resolution RTM grid + 1.9x2.5_gx1v6_r01 f19_g16_r01 @@ -364,23 +560,40 @@ Non-standard grid, for testing high resolution RTM grid - + + + 4x5_gx3v7 f45_g37 - a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%ww3a + + + 4x5_gx3v7 + f45_g37 + a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%ww3a - 4x5_gx3v7 f45_g37 a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%null - 4x5_gx3v7 f45_g37 a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%null + + 4x5_gx3v7 + f45_g37 + a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%null_w%ww3a + + + 4x5_gx3v7 + f45_g37 + a%4x5_l%4x5_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + + + 0.23x0.31_0.23x0.31 @@ -388,47 +601,46 @@ a%0.23x0.31_l%0.23x0.31_oi%0.23x0.31_r%r05_m%gx1v6_g%null_w%null + + 0.9x1.25_0.9x1.25 f09_f09 a%0.9x1.25_l%0.9x1.25_oi%0.9x1.25_r%r05_m%gx1v6_g%null_w%null - 0.9x1.25_0.9x1.25 f09_f09 a%0.9x1.25_l%0.9x1.25_oi%0.9x1.25_r%r05_m%gx1v6_g%gland5UM_w%null - 0.9x1.25_0.9x1.25 f09_f09 a%0.9x1.25_l%0.9x1.25_oi%0.9x1.25_r%r05_m%gx1v6_g%gland4_w%null - 0.9x1.25_0.9x1.25_gl5 f09_f09_gl5 a%0.9x1.25_l%0.9x1.25_oi%0.9x1.25_r%r05_m%gx1v6_g%gland5UM_w%null - - 1.9x2.5_1.9x2.5 - f19_f19 - a%1.9x2.5_l%1.9x2.5_oi%1.9x2.5_r%r05_m%gx1v6_g%null_w%null - 1.9x2.5_1.9x2.5 f19_f19 a%1.9x2.5_l%1.9x2.5_oi%1.9x2.5_r%r05_m%gx1v6_g%gland5UM_w%null - 1.9x2.5_1.9x2.5 f19_f19 a%1.9x2.5_l%1.9x2.5_oi%1.9x2.5_r%r05_m%gx1v6_g%gland4_w%null + + 1.9x2.5_1.9x2.5 + f19_f19 + a%1.9x2.5_l%1.9x2.5_oi%1.9x2.5_r%r05_m%gx1v6_g%null_w%null + + 1.9x2.5_1.9x2.5_gland10 @@ -459,7 +671,6 @@ f45_f45 a%4x5_l%4x5_oi%4x5_r%r05_m%gx3v7_g%gland5UM_w%null - 4x5_4x5 f45_f45 @@ -471,13 +682,11 @@ f10_f10 a%10x15_l%10x15_oi%10x15_r%r05_m%usgs_g%null_w%null - 10x15_10x15 f10_f10 a%10x15_l%10x15_oi%10x15_r%r05_m%usgs_g%gland5UM_w%null - 10x15_10x15 f10_f10 @@ -486,63 +695,118 @@ - + + ne16np4_gx3v7 ne16_g37 - a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%ww3a + + + ne16np4_gx3v7 + ne16_g37 + a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%ww3a + + + ne16np4_gx3v7 + ne16_g37 + a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%null_w%ww3a - ne16np4_gx3v7 ne16_g37 a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%null - ne16np4_gx3v7 ne16_g37 a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%null - + ne16np4_gx3v7 + ne16_g37 + a%ne16np4_l%ne16np4_oi%gx3v7_r%r05_m%gx3v7_g%null_w%null + + + + + ne30np4_gx1v6 ne30_g16 - a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + + + ne30np4_gx1v6 + ne30_g16 + a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a - ne30np4_gx1v6 ne30_g16 a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null - ne30np4_gx1v6 ne30_g16 a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null - + + ne30np4_gx1v6 + ne30_g16 + a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + + ne30np4_gx1v6 + ne30_g16 + a%ne30np4_l%ne30np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + + + ne30np4_1.9x2.5_gx1v6 ne30_f19_g16 - a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + For testing tri-grid + + + ne30np4_1.9x2.5_gx1v6 + ne30_f19_g16 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a For testing tri-grid - ne30np4_1.9x2.5_gx1v6 ne30_f19_g16 a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null For testing tri-grid - ne30np4_1.9x2.5_gx1v6 ne30_f19_g16 a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null For testing tri-grid + + ne30np4_1.9x2.5_gx1v6 + ne30_f19_g16 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + For testing tri-grid + + + ne30np4_1.9x2.5_gx1v6 + ne30_f19_g16 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + For testing tri-grid + + + + + ne30np4_0.9x1.25_gx1v6 + ne30_f09_g16 + a%ne30np4_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + For testing tri-grid + ne30np4_0.9x1.25_gx1v6 ne30_f09_g16 @@ -550,62 +814,120 @@ For testing tri-grid + + + + + ne30np4_0.9x1.25_gx1v6 + ne30_f09_g16 + a%ne30np4_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + For testing tri-grid + + + ne30np4_0.9x1.25_gx1v6 + ne30_f09_g16 + a%ne30np4_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + For testing tri-grid + ne30np4_0.9x1.25_gx1v6 ne30_f09_g16 a%ne30np4_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null For testing tri-grid - ne30np4_0.9x1.25_gx1v6 ne30_f09_g16 a%ne30np4_l%0.9x1.25_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null For testing tri-grid - + + ne60np4_gx1v6 + ne60_g16 + a%ne60np4_l%ne60np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + ne60np4_gx1v6 ne60_g16 a%ne60np4_l%ne60np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null - + + + + ne120np4_gx1v6 ne120_g16 - a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a + + + ne120np4_gx1v6 + ne120_g16 + a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a - ne120np4_gx1v6 ne120_g16 a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%null - ne120np4_gx1v6 ne120_g16 a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%null - + + ne120np4_gx1v6 + ne120_g16 + a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + + ne120np4_gx1v6 + ne120_g16 + a%ne120np4_l%ne120np4_oi%gx1v6_r%r05_m%gx1v6_g%null_w%null + + + + + + ne120np4_tx0.1v2 ne120_t12 - a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%gland5UM_w%ww3a + + + ne120np4_tx0.1v2 + ne120_t12 + a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%gland4_w%ww3a + + + ne120np4_tx0.1v2 + ne120_t12 + a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a - ne120np4_tx0.1v2 ne120_t12 a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%gland5UM_w%null - ne120np4_tx0.1v2 ne120_t12 a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%gland4_w%null + + ne120np4_tx0.1v2 + ne120_t12 + a%ne120np4_l%ne120np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + + + + + ne240np4_0.23x0.31_gx1v6 + ne240_f02_g16 + a%ne240np4_l%0.23x0.31_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a + For testing high resolution tri-grid + ne240np4_0.23x0.31_gx1v6 ne240_f02_g16 @@ -613,47 +935,56 @@ For testing high resolution tri-grid + + + + ne240np4_tx0.1v2 + ne240_t12 + a%ne240np4_l%ne240np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%ww3a + ne240np4_tx0.1v2 ne240_t12 a%ne240np4_l%ne240np4_oi%tx0.1v2_r%r05_m%tx0.1v2_g%null_w%null + + ne16np4_ne16np4 ne16_ne16 a%ne16np4_l%ne16np4_oi%ne16np4_r%r05_m%gx3v7_g%null_w%null - ne16np4_ne16np4 ne16_ne16 a%ne16np4_l%ne16np4_oi%ne16np4_r%r05_m%gx3v7_g%gland5UM_w%null - ne16np4_ne16np4 ne16_ne16 a%ne16np4_l%ne16np4_oi%ne16np4_r%r05_m%gx3v7_g%gland4_w%null - - ne30np4_ne30np4 - ne30_ne30 - a%ne30np4_l%ne30np4_oi%ne30np4_r%r05_m%gx1v6_g%null_w%null - + ne30np4_ne30np4 ne30_ne30 a%ne30np4_l%ne30np4_oi%ne30np4_r%r05_m%gx1v6_g%gland5UM_w%null - ne30np4_ne30np4 ne30_ne30 a%ne30np4_l%ne30np4_oi%ne30np4_r%r05_m%gx1v6_g%gland4_w%null + + ne30np4_ne30np4 + ne30_ne30 + a%ne30np4_l%ne30np4_oi%ne30np4_r%r05_m%gx1v6_g%null_w%null + + + ne60np4_ne60np4 @@ -661,23 +992,25 @@ a%ne60np4_l%ne60np4_oi%ne60np4_r%r05_m%gx1v6_g%null_w%null - - ne120np4_ne120np4 - ne120_ne120 - a%ne120np4_l%ne120np4_oi%ne120np4_r%r05_m%gx1v6_g%null_w%null - + ne120np4_ne120np4 ne120_ne120 a%ne120np4_l%ne120np4_oi%ne120np4_r%r05_m%gx1v6_g%gland5UM_w%null - ne120np4_ne120np4 ne120_ne120 a%ne120np4_l%ne120np4_oi%ne120np4_r%r05_m%gx1v6_g%gland4_w%null + + ne120np4_ne120np4 + ne120_ne120 + a%ne120np4_l%ne120np4_oi%ne120np4_r%r05_m%gx1v6_g%null_w%null + + + ne240np4_ne240np4 @@ -685,98 +1018,174 @@ a%ne240np4_l%ne240np4_oi%ne240np4_r%null_m%gx1v6_g%null_w%null + + + + T31_gx3v7_rx1 + T31_g37_rx1 + a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%ww3a + T31_gx3v7_rx1 T31_g37_rx1 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%null - + + T31_gx3v7_rx1 + T31_g37_rx1 + a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland5UM_w%ww3a + + + T31_gx3v7_rx1 + T31_g37_rx1 + a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland4_w%ww3a + T31_gx3v7_rx1 T31_g37_rx1 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland5UM_w%null - T31_gx3v7_rx1 T31_g37_rx1 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland4_w%null + + + + 4x5_gx3v7_rx1 + f45_g37_rx1 + a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%ww3a + + + 4x5_gx3v7_rx1 + f45_g37_rx1 + a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%gland5UM_w%ww3a + + + 4x5_gx3v7_rx1 + f45_g37_rx1 + a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%gland4_w%ww3a + 4x5_gx3v7_rx1 f45_g37_rx1 a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%null - 4x5_gx3v7_rx1 f45_g37_rx1 a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%gland5UM_w%null - 4x5_gx3v7_rx1 f45_g37_rx1 a%4x5_l%4x5_oi%gx3v7_r%rx1_m%gx3v7_g%gland4_w%null + + + + 1.9x2.5_gx1v6_rx1 + f19_g16_rx1 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%ww3a + + + 1.9x2.5_gx1v6_rx1 + f19_g16_rx1 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%ww3a + + + 1.9x2.5_gx1v6_rx1 + f19_g16_rx1 + a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%ww3a + 1.9x2.5_gx1v6_rx1 f19_g16_rx1 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%null - 1.9x2.5_gx1v6_rx1 f19_g16_rx1 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%null - 1.9x2.5_gx1v6_rx1 f19_g16_rx1 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%null + + + + ne30np4_gx1v6_rx1 + ne30_g16_rx1 + a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%ww3a + + + ne30np4_gx1v6_rx1 + ne30_g16_rx1 + a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%ww3a + + + ne30np4_gx1v6_rx1 + ne30_g16_rx1 + a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%ww3a + ne30np4_gx1v6_rx1 ne30_g16_rx1 a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%null - ne30np4_gx1v6_rx1 ne30_g16_rx1 a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%null - ne30np4_gx1v6_rx1 ne30_g16_rx1 a%ne30np4_l%ne30np4_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%null + + + + ne30np4_1.9x2.5_gx1v6_rx1 + ne30_f19_g16_rx1 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%ww3a + + + ne30np4_1.9x2.5_gx1v6_rx1 + ne30_f19_g16_rx1 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%ww3a + + + ne30np4_1.9x2.5_gx1v6_rx1 + ne30_f19_g16_rx1 + a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%ww3a + ne30np4_1.9x2.5_gx1v6_rx1 ne30_f19_g16_rx1 a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%null - ne30np4_1.9x2.5_gx1v6_rx1 ne30_f19_g16_rx1 a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%null - ne30np4_1.9x2.5_gx1v6_rx1 ne30_f19_g16_rx1 a%ne30np4_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%null + @@ -792,91 +1201,86 @@ f19_g16_r05_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a - 1.9x2.5_gx1v6_r05_ww3a f19_g16_r05_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a - 1.9x2.5_gx1v6_r05_ww3a f19_g16_r05_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + 0.9x1.25_gx1v6_r05_ww3a f09_g16_r05_ww3 a%0.9x1.25_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%null_w%ww3a - 0.9x1.25_gx1v6_r05_ww3a f09_g16_r05_ww3 a%0.9x1.25_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland5UM_w%ww3a - 0.9x1.25_gx1v6_r05_ww3a f09_g16_r05_ww3 a%0.9x1.25_l%1.9x2.5_oi%gx1v6_r%r05_m%gx1v6_g%gland4_w%ww3a + T31_gx3v7_r05_ww3a T31_g37_r05_ww3 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%null_w%ww3a - T31_gx3v7_r05_ww3a T31_g37_r05_ww3 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland5UM_w%ww3a - T31_gx3v7_r05_ww3a T31_g37_r05_ww3 a%T31_l%T31_oi%gx3v7_r%r05_m%gx3v7_g%gland4_w%ww3a + 1.9x2.5_gx1v6_rx1_ww3a f19_g16_rx1_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%null_w%ww3a - 1.9x2.5_gx1v6_rx1_ww3a f19_g16_rx1_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland5UM_w%ww3a - 1.9x2.5_gx1v6_rx1_ww3a f19_g16_rx1_ww3 a%1.9x2.5_l%1.9x2.5_oi%gx1v6_r%rx1_m%gx1v6_g%gland4_w%ww3a + T31_gx3v7_rx1_ww3a T31_g37_rx1_ww3 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%null_w%ww3a - T31_gx3v7_rx1_ww3a - T31_g37_rx1_ww3> + T31_g37_rx1_ww3 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland5UM_w%ww3a - T31_gx3v7_rx1_ww3a - T31_g37_rx1_ww3> + T31_g37_rx1_ww3 a%T31_l%T31_oi%gx3v7_r%rx1_m%gx3v7_g%gland4_w%ww3a + T62_gx1v6_rx1_ww3a T62_g16_rx1_ww3 @@ -1077,6 +1481,7 @@ domain.lnd.T62_tx1v1.090122.nc domain.lnd.T62_tx0.1v2_090623.nc domain.lnd.T62_mpas120.121116.nc + domain.lnd.T62_oQU120.160325.nc T62 is Gaussian grid: @@ -1163,7 +1568,7 @@ 28574 1 - domain.ocn.mpas120.121116.nc + domain.ocn.mpas120.121116.nc mpas120 is a MPAS ocean grid that is roughly 1 degree resolution: Experimental, under development @@ -1197,6 +1602,13 @@ Experimental, under development + + 28574 1 + domain.ocn.oQU120.160325.nc + oQU120 is a MPAS ocean grid that is roughly 1 degree resolution: + Experimental, under development + + @@ -1436,6 +1848,14 @@ cpl/gridmaps/mpas120/map_mpas120_TO_T62_aave.121116.nc + + cpl/gridmaps/T62/map_T62_TO_oQU120_aave.151209.nc + cpl/gridmaps/T62/map_T62_TO_oQU120_aave.151209.nc + cpl/gridmaps/T62/map_T62_TO_oQU120_aave.151209.nc + cpl/gridmaps/oQU120/map_oQU120_TO_T62_aave.151209.nc + cpl/gridmaps/oQU120/map_oQU120_TO_T62_aave.151209.nc + + cpl/cpl6/map_T31_to_gx3v7_aave_da_090903.nc @@ -1513,6 +1933,10 @@ cpl/gridmaps/fv1.9x2.5/map_fv1.9x2.5_TO_ww3a_bilin_140702.nc + + cpl/gridmaps/fv0.9x1.25/map_fv0.9x1.25_TO_ww3a_bilin.160324.nc + + @@ -1633,6 +2057,9 @@ cpl/cpl6/map_rx1_to_tx0.1v2_e1000r200_090624.nc + + cpl/gridmaps/rx1/map_rx1_to_oQU120_nn.160527.nc + cpl/cpl6/map_r05_to_gx3v7_e1000r500_090903.nc diff --git a/cime_config/cesm/machines/config_machines.xml b/cime_config/cesm/machines/config_machines.xml index 86392780da3c..2ce59cd1f9ae 100644 --- a/cime_config/cesm/machines/config_machines.xml +++ b/cime_config/cesm/machines/config_machines.xml @@ -356,7 +356,7 @@ PrgEnv-intel - intel intel/17.0.0.042 + intel intel/16.0.3.210 cray-libsci /global/project/projectdirs/ccsm1/modulefiles/cori diff --git a/driver_cpl/bld/build-namelist b/driver_cpl/bld/build-namelist index 223a87e1e006..5e1fff01010d 100755 --- a/driver_cpl/bld/build-namelist +++ b/driver_cpl/bld/build-namelist @@ -425,6 +425,12 @@ add_default($nl, 'cpl_decomp'); add_default($nl, 'wall_time_limit'); add_default($nl, 'force_stop_at'); +if ( $xmlvars{'FLDS_WISO'} eq "TRUE" ) { + add_default($nl, 'flds_wiso', 'val'=>".true.", 'xml'=>'FLDS_WISO'); +} else { + add_default($nl, 'flds_wiso', 'val'=>".false.", 'xml'=>'FLDS_WISO'); +} + add_default($nl, 'do_histinit'); add_default($nl, 'shr_map_dopole'); add_default($nl, 'cpl_cdf64'); diff --git a/driver_cpl/bld/namelist_files/namelist_definition_drv.xml b/driver_cpl/bld/namelist_files/namelist_definition_drv.xml index 51c11d278bff..afa439058850 100644 --- a/driver_cpl/bld/namelist_files/namelist_definition_drv.xml +++ b/driver_cpl/bld/namelist_files/namelist_definition_drv.xml @@ -119,7 +119,15 @@ This is a new master switch for turning ACME BGC off and on, just for testing. If ACME_BGC is set to 'TRUE', then flds_bgc will be set to .true. - +Pass water isotopes between components + + + 0.000001 0.000001 + + 284.7 368.9 0.000001 0.000001 @@ -3327,6 +3329,19 @@ introduced to coordinate this value among multiple components. + + logical + TRUE,FALSE + FALSE + + TRUE + TRUE + + run_flags + env_run.xml + Turn on the passing of water isotope fields through the coupler + + logical TRUE,FALSE diff --git a/driver_cpl/driver/mrg_mod.F90 b/driver_cpl/driver/mrg_mod.F90 new file mode 100644 index 000000000000..40bfd3daa5bd --- /dev/null +++ b/driver_cpl/driver/mrg_mod.F90 @@ -0,0 +1,946 @@ +module mrg_mod + + use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl + use mct_mod + use seq_cdata_mod + use seq_comm_mct + use seq_infodata_mod + implicit none + save + private ! except + +!-------------------------------------------------------------------------- +! TODO - write summary of naming convention here as well +!-------------------------------------------------------------------------- + + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public :: mrg_x2a_run_mct + public :: mrg_x2i_run_mct + public :: mrg_x2l_run_mct + public :: mrg_x2r_run_mct + public :: mrg_x2o_run_mct + public :: mrg_x2g_run_mct + public :: mrg_x2s_run_mct + public :: mrg_x2w_run_mct + +!-------------------------------------------------------------------------- +! Private interfaces +!-------------------------------------------------------------------------- + + private :: getfld + +!-------------------------------------------------------------------------- +! Private data +!-------------------------------------------------------------------------- + +!=========================================================================================== +contains +!=========================================================================================== + + subroutine mrg_x2a_run_mct( cdata_a, l2x_a, o2x_a, xao_a, i2x_a, fractions_a, x2a_a ) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(seq_cdata), intent(in) :: cdata_a + type(mct_aVect), intent(in) :: l2x_a + type(mct_aVect), intent(in) :: o2x_a + type(mct_aVect), intent(in) :: xao_a + type(mct_aVect), intent(in) :: i2x_a + type(mct_aVect), intent(in) :: fractions_a + type(mct_aVect), intent(inout) :: x2a_a + !----------------------------------------------------------------------- + ! + ! Local workspace + ! + real(r8) :: fracl, fraci, fraco + integer :: n,ka,ki,kl,ko,kx,kof,kif,klf + integer :: lsize + integer :: index_x2a_Sf_lfrac + integer :: index_x2a_Sf_ifrac + integer :: index_x2a_Sf_ofrac + character(CL) :: field_atm ! string converted to char + character(CL) :: field_lnd ! string converted to char + character(CL) :: field_ice ! string converted to char + character(CL) :: field_xao ! string converted to char + character(CL) :: field_ocn ! string converted to char + character(CL) :: itemc_atm ! string converted to char + character(CL) :: itemc_lnd ! string converted to char + character(CL) :: itemc_ice ! string converted to char + character(CL) :: itemc_xao ! string converted to char + character(CL) :: itemc_ocn ! string converted to char + logical :: iamroot + logical :: first_time = .true. + logical, pointer, save :: lmerge(:),imerge(:),xmerge(:),omerge(:) + integer, pointer, save :: lindx(:), iindx(:), oindx(:),xindx(:) + integer, save :: naflds, klflds,niflds,noflds,nxflds + !----------------------------------------------------------------------- + ! + call seq_comm_setptrs(CPLID, iamroot=iamroot) + + if (first_time) then + + naflds = mct_aVect_nRattr(x2a_a) + klflds = mct_aVect_nRattr(l2x_a) + niflds = mct_aVect_nRattr(i2x_a) + noflds = mct_aVect_nRattr(o2x_a) + nxflds = mct_aVect_nRattr(xao_a) + + allocate(lindx(naflds), lmerge(naflds)) + allocate(iindx(naflds), imerge(naflds)) + allocate(xindx(naflds), xmerge(naflds)) + allocate(oindx(naflds), omerge(naflds)) + + lindx(:) = 0 + iindx(:) = 0 + xindx(:) = 0 + oindx(:) = 0 + lmerge(:) = .true. + imerge(:) = .true. + xmerge(:) = .true. + omerge(:) = .true. + + ! Field naming rules + ! Only atm states that are Sx_... will be merged + ! Only fluxes that are F??x_... will be merged + ! All fluxes will be multiplied by corresponding component fraction + + do ka = 1,naflds + call getfld(ka, x2a_a, field_atm, itemc_atm) + if (field_atm(1:2) == 'PF') then + cycle ! if flux has first character as P, pass straight through + end if + if (field_atm(1:1) == 'S' .and. field_atm(2:2) /= 'x') then + cycle ! any state fields that are not Sx_ will just be copied + end if + + do kl = 1,klflds + call getfld(kl, l2x_a, field_lnd, itemc_lnd) + if (trim(itemc_atm) == trim(itemc_lnd)) then + if ((trim(field_atm) == trim(field_lnd))) then + if (field_lnd(1:1) == 'F') lmerge(ka) = .false. + end if + lindx(ka) = kl + exit + end if + end do + do ki = 1,niflds + call getfld(ki, i2x_a, field_ice, itemc_ice) + if (field_ice(1:1) == 'F' .and. field_ice(2:4) == 'ioi') then + cycle ! ignore all fluxes that are ice/ocn fluxes + end if + if (trim(itemc_atm) == trim(itemc_ice)) then + if ((trim(field_atm) == trim(field_ice))) then + if (field_ice(1:1) == 'F') imerge(ka) = .false. + end if + iindx(ka) = ki + exit + end if + end do + do kx = 1,nxflds + call getfld(kx, xao_a, field_xao, itemc_xao) + if (trim(itemc_atm) == trim(itemc_xao)) then + if ((trim(field_atm) == trim(field_xao))) then + if (field_xao(1:1) == 'F') xmerge(ka) = .false. + end if + xindx(ka) = kx + exit + end if + end do + do ko = 1,noflds + call getfld(ko, o2x_a, field_ocn, itemc_ocn) + if (trim(itemc_atm) == trim(itemc_ocn)) then + if ((trim(field_atm) == trim(field_ocn))) then + if (field_ocn(1:1) == 'F') omerge(ka) = .false. + end if + oindx(ka) = ko + exit + end if + end do + if (lindx(ka) == 0) itemc_lnd = 'unset' + if (iindx(ka) == 0) itemc_ice = 'unset' + if (xindx(ka) == 0) itemc_xao = 'unset' + if (oindx(ka) == 0) itemc_ocn = 'unset' + + if (iamroot) then + write(logunit,10)trim(itemc_atm),trim(itemc_lnd),& + trim(itemc_ice),trim(itemc_xao),trim(itemc_ocn) +10 format(' ',' atm field: ',a15,', lnd merge: ',a15, & + ', ice merge: ',a15,', xao merge: ',a15,', ocn merge: ',a15) + write(logunit, *)'field_atm,lmerge, imerge, xmerge, omerge= ',& + trim(field_atm),lmerge(ka),imerge(ka),xmerge(ka),omerge(ka) + end if + end do + first_time = .false. + end if + + ! Zero attribute vector + + call mct_avect_zero(x2a_a) + + ! Update surface fractions + + kif=mct_aVect_indexRA(fractions_a,"ifrac") + klf=mct_aVect_indexRA(fractions_a,"lfrac") + kof=mct_aVect_indexRA(fractions_a,"ofrac") + lsize = mct_avect_lsize(x2a_a) + + index_x2a_Sf_lfrac = mct_aVect_indexRA(x2a_a,'Sf_lfrac') + index_x2a_Sf_ifrac = mct_aVect_indexRA(x2a_a,'Sf_ifrac') + index_x2a_Sf_ofrac = mct_aVect_indexRA(x2a_a,'Sf_ofrac') + do n = 1,lsize + x2a_a%rAttr(index_x2a_Sf_lfrac,n) = fractions_a%Rattr(klf,n) + x2a_a%rAttr(index_x2a_Sf_ifrac,n) = fractions_a%Rattr(kif,n) + x2a_a%rAttr(index_x2a_Sf_ofrac,n) = fractions_a%Rattr(kof,n) + end do + + ! Copy attributes that do not need to be merged + ! These are assumed to have the same name in + ! (o2x_a and x2a_a) and in (l2x_a and x2a_a), etc. + + call mct_aVect_copy(aVin=l2x_a, aVout=x2a_a, vector=mct_usevector) + call mct_aVect_copy(aVin=o2x_a, aVout=x2a_a, vector=mct_usevector) + call mct_aVect_copy(aVin=i2x_a, aVout=x2a_a, vector=mct_usevector) + call mct_aVect_copy(aVin=xao_a, aVout=x2a_a, vector=mct_usevector) + + ! If flux to atm is coming only from the ocean (based on field being in o2x_a) - + ! -- then scale by both ocean and ice fraction + ! If flux to atm is coming only from the land or ice or coupler + ! -- then do scale by fraction above + + do ka = 1,naflds + do n = 1,lsize + fracl = fractions_a%Rattr(klf,n) + fraci = fractions_a%Rattr(kif,n) + fraco = fractions_a%Rattr(kof,n) + if (lindx(ka) > 0 .and. fracl > 0._r8) then + if (lmerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + l2x_a%rAttr(lindx(ka),n) * fracl + else + x2a_a%rAttr(ka,n) = l2x_a%rAttr(lindx(ka),n) * fracl + end if + end if + if (iindx(ka) > 0 .and. fraci > 0._r8) then + if (imerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + i2x_a%rAttr(iindx(ka),n) * fraci + else + x2a_a%rAttr(ka,n) = i2x_a%rAttr(iindx(ka),n) * fraci + end if + end if + if (xindx(ka) > 0 .and. fraco > 0._r8) then + if (xmerge(ka)) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + xao_a%rAttr(xindx(ka),n) * fraco + else + x2a_a%rAttr(ka,n) = xao_a%rAttr(xindx(ka),n) * fraco + end if + end if + if (oindx(ka) > 0) then + if (omerge(ka) .and. fraco > 0._r8) then + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco + end if + if (.not. omerge(ka)) then + !--- NOTE: This IS using the ocean fields and ice fraction !! --- + x2a_a%rAttr(ka,n) = o2x_a%rAttr(oindx(ka),n) * fraci + x2a_a%rAttr(ka,n) = x2a_a%rAttr(ka,n) + o2x_a%rAttr(oindx(ka),n) * fraco + end if + end if + end do + end do + + end subroutine mrg_x2a_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2i_run_mct( cdata_i, a2x_i, o2x_i, x2i_i ) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(seq_cdata),intent(in) :: cdata_i + type(mct_aVect),intent(in) :: a2x_i + type(mct_aVect),intent(in) :: o2x_i + type(mct_aVect),intent(inout):: x2i_i + ! + ! Local variables + ! + integer :: i + real(r8):: flux_epbalfact + character(len=cl) :: flux_epbal + type(seq_infodata_type),pointer :: infodata + integer, save :: index_a2x_Faxa_rainc + integer, save :: index_a2x_Faxa_rainl + integer, save :: index_a2x_Faxa_snowc + integer, save :: index_a2x_Faxa_snowl + integer, save :: index_x2i_Faxa_rain + integer, save :: index_x2i_Faxa_snow + logical, save :: first_time = .true. + logical, save :: flds_wiso = .false. + + !wiso fields: + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_x2i_Faxa_rain_16O + integer, save :: index_x2i_Faxa_snow_16O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_x2i_Faxa_rain_18O + integer, save :: index_x2i_Faxa_snow_18O + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_x2i_Faxa_rain_HDO + integer, save :: index_x2i_Faxa_snow_HDO + + !----------------------------------------------------------------------- + + if (first_time) then + index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_i,'Faxa_snowc') + index_a2x_Faxa_snowl = mct_aVect_indexRA(a2x_i,'Faxa_snowl') + index_a2x_Faxa_rainc = mct_aVect_indexRA(a2x_i,'Faxa_rainc') + index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_i,'Faxa_rainl') + index_x2i_Faxa_rain = mct_aVect_indexRA(x2i_i,'Faxa_rain' ) + index_x2i_Faxa_snow = mct_aVect_indexRA(x2i_i,'Faxa_snow' ) + + ! H2_16O + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_16O', perrWith='quiet') + index_x2i_Faxa_rain_16O = mct_aVect_indexRA(x2i_i,'Faxa_rain_16O' , perrWith='quiet') + index_x2i_Faxa_snow_16O = mct_aVect_indexRA(x2i_i,'Faxa_snow_16O' , perrWith='quiet') + if ( index_x2i_Faxa_rain_16O /= 0 ) flds_wiso = .true. + ! H2_18O + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_18O', perrWith='quiet') + index_x2i_Faxa_rain_18O = mct_aVect_indexRA(x2i_i,'Faxa_rain_18O' , perrWith='quiet') + index_x2i_Faxa_snow_18O = mct_aVect_indexRA(x2i_i,'Faxa_snow_18O' , perrWith='quiet') + if ( index_x2i_Faxa_rain_18O /= 0 ) flds_wiso = .true. + ! HDO + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainl_HDO', perrWith='quiet') + index_x2i_Faxa_rain_HDO = mct_aVect_indexRA(x2i_i,'Faxa_rain_HDO' , perrWith='quiet') + index_x2i_Faxa_snow_HDO = mct_aVect_indexRA(x2i_i,'Faxa_snow_HDO' , perrWith='quiet') + if ( index_x2i_Faxa_rain_HDO /= 0 ) flds_wiso = .true. + + first_time = .false. + end if + + ! Apply correction to precipitation of requested driver namelist + call seq_cdata_setptrs(cdata_i,infodata=infodata) + call seq_infodata_GetData(infodata, flux_epbalfact = flux_epbalfact) + + call mct_aVect_copy(aVin=o2x_i, aVout=x2i_i, vector=mct_usevector) + call mct_aVect_copy(aVin=a2x_i, aVout=x2i_i, vector=mct_usevector) + + ! Merge total snow and precip for ice input + ! Scale total precip and runoff by flux_epbalfact + + do i = 1,mct_aVect_lsize(x2i_i) + x2i_i%rAttr(index_x2i_Faxa_rain,i) = a2x_i%rAttr(index_a2x_Faxa_rainc,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl,i) + x2i_i%rAttr(index_x2i_Faxa_snow,i) = a2x_i%rAttr(index_a2x_Faxa_snowc,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl,i) + + x2i_i%rAttr(index_x2i_Faxa_rain,i) = x2i_i%rAttr(index_x2i_Faxa_rain,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow,i) = x2i_i%rAttr(index_x2i_Faxa_snow,i) * flux_epbalfact + + end do + if ( flds_wiso )then + do i = 1,mct_aVect_lsize(x2i_i) + !H2_16O + x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_16O,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_16O,i) + x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_16O,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_16O,i) + !H2_18O + x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_18O,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_18O,i) + x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_18O,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_18O,i) + !HDO + x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_HDO,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_HDO,i) + x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_HDO,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_HDO,i) + + x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) = x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) = x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) = x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) = x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) = x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) = x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) * flux_epbalfact + + end do + end if + + end subroutine mrg_x2i_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2r_run_mct( cdata_r, l2x_r, fractions_r, x2r_r) + + !----------------------------------------------------------------------- + ! + ! Arguments + ! + type(seq_cdata),intent(in) :: cdata_r + type(mct_aVect),intent(in) :: l2x_r + type(mct_aVect),intent(in) :: fractions_r + type(mct_aVect),intent(inout):: x2r_r + ! + ! Local variables + ! + integer :: i + type(seq_infodata_type),pointer :: infodata + integer, save :: index_l2x_Flrl_rofliq + integer, save :: index_l2x_Flrl_rofice + integer, save :: index_x2r_Flrl_rofliq + integer, save :: index_x2r_Flrl_rofice + integer, save :: index_l2x_Flrl_rofliq_16O + integer, save :: index_l2x_Flrl_rofice_16O + integer, save :: index_x2r_Flrl_rofliq_16O + integer, save :: index_x2r_Flrl_rofice_16O + integer, save :: index_l2x_Flrl_rofliq_18O + integer, save :: index_l2x_Flrl_rofice_18O + integer, save :: index_x2r_Flrl_rofliq_18O + integer, save :: index_x2r_Flrl_rofice_18O + integer, save :: index_l2x_Flrl_rofliq_HDO + integer, save :: index_l2x_Flrl_rofice_HDO + integer, save :: index_x2r_Flrl_rofliq_HDO + integer, save :: index_x2r_Flrl_rofice_HDO + integer, save :: index_lfrac + logical, save :: first_time = .true. + logical, save :: flds_wiso = .false. + real(r8) :: lfrac + !----------------------------------------------------------------------- + + if (first_time) then + index_l2x_Flrl_rofliq = mct_aVect_indexRA(l2x_r,'Flrl_rofliq' ) + index_l2x_Flrl_rofice = mct_aVect_indexRA(l2x_r,'Flrl_rofice' ) + index_x2r_Flrl_rofliq = mct_aVect_indexRA(x2r_r,'Flrl_rofliq' ) + index_x2r_Flrl_rofice = mct_aVect_indexRA(x2r_r,'Flrl_rofice' ) + index_l2x_Flrl_rofliq_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofliq_16O', perrWith='quiet' ) + index_l2x_Flrl_rofice_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofice_16O', perrWith='quiet' ) + index_x2r_Flrl_rofliq_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofliq_16O', perrWith='quiet' ) + index_x2r_Flrl_rofice_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofice_16O', perrWith='quiet' ) + if ( index_l2x_Flrl_rofliq_16O /= 0 ) flds_wiso = .true. + index_l2x_Flrl_rofliq_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofliq_18O', perrWith='quiet' ) + index_l2x_Flrl_rofice_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofice_18O', perrWith='quiet' ) + index_x2r_Flrl_rofliq_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofliq_18O', perrWith='quiet' ) + index_x2r_Flrl_rofice_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofice_18O', perrWith='quiet' ) + if ( index_l2x_Flrl_rofliq_18O /= 0 ) flds_wiso = .true. + index_l2x_Flrl_rofliq_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofliq_HDO', perrWith='quiet' ) + index_l2x_Flrl_rofice_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofice_HDO', perrWith='quiet' ) + index_x2r_Flrl_rofliq_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofliq_HDO', perrWith='quiet' ) + index_x2r_Flrl_rofice_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofice_HDO', perrWith='quiet' ) + if ( index_l2x_Flrl_rofliq_HDO /= 0 ) flds_wiso = .true. + index_lfrac = mct_aVect_indexRA(fractions_r,"lfrac") + first_time = .false. + end if + + ! Merge land rof and ice forcing for rof input + + do i = 1,mct_aVect_lsize(x2r_r) + lfrac = fractions_r%rAttr(index_lfrac,i) + x2r_r%rAttr(index_x2r_Flrl_rofliq,i) = l2x_r%rAttr(index_l2x_Flrl_rofliq,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofice,i) = l2x_r%rAttr(index_l2x_Flrl_rofice,i) * lfrac + end do + if ( flds_wiso ) then + do i = 1,mct_aVect_lsize(x2r_r) + lfrac = fractions_r%rAttr(index_lfrac,i) + x2r_r%rAttr(index_x2r_Flrl_rofliq_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofliq_16O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofice_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofice_16O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofliq_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofliq_18O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofice_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofice_18O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofliq_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofliq_HDO,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofice_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofice_HDO,i) * lfrac + end do + end if + + end subroutine mrg_x2r_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2l_run_mct( cdata_l, a2x_l, r2l_l, x2l_l ) + + !----------------------------------------------------------------------- + ! Arguments + ! + type(seq_cdata), intent(in) :: cdata_l + type(mct_aVect), intent(in) :: a2x_l ! input + type(mct_aVect), intent(in) :: r2l_l ! input + type(mct_aVect), intent(inout) :: x2l_l ! output + !----------------------------------------------------------------------- + + ! Create input land state directly from atm and runoff outputs + call mct_aVect_copy(aVin=a2x_l, aVout=x2l_l, vector=mct_usevector) + call mct_aVect_copy(aVin=r2l_l, aVout=x2l_l, vector=mct_usevector) + + end subroutine mrg_x2l_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2o_run_mct( cdata_o, a2x_o, i2x_o, w2x_o, xao_o, fractions_o, x2o_o ) + + !----------------------------------------------------------------------- + ! Arguments + type(seq_cdata), intent(in) :: cdata_o + type(mct_aVect), intent(in) :: a2x_o + type(mct_aVect), intent(in) :: i2x_o + type(mct_aVect), intent(in) :: w2x_o + type(mct_aVect), intent(in) :: xao_o + type(mct_aVect), intent(in) :: fractions_o + type(mct_aVect), intent(inout) :: x2o_o + ! + ! Local variables + ! + integer :: n,ka,ki,ko,kir,kor + integer :: lsize + real(r8) :: ifrac,ifracr + real(r8) :: afrac,afracr + real(r8) :: flux_epbalfact + real(r8) :: frac_sum + real(r8) :: avsdr, anidr, avsdf, anidf ! albedos + real(r8) :: fswabsv, fswabsi ! sw + integer :: noflds,naflds,niflds,nxflds + integer :: kof,kaf,kif,kxf + character(len=cl) :: flux_epbal + character(CL) :: field_ocn ! string converted to char + character(CL) :: field_atm ! string converted to char + character(CL) :: field_ice ! string converted to char + character(CL) :: field_xao ! string converted to char + character(CL) :: itemc_ocn ! string converted to char + character(CL) :: itemc_atm ! string converted to char + character(CL) :: itemc_ice ! string converted to char + character(CL) :: itemc_xao ! string converted to char + logical :: iamroot + type(seq_infodata_type),pointer :: infodata + integer, save :: index_a2x_Faxa_swvdr + integer, save :: index_a2x_Faxa_swvdf + integer, save :: index_a2x_Faxa_swndr + integer, save :: index_a2x_Faxa_swndf + integer, save :: index_i2x_Fioi_swpen + integer, save :: index_xao_So_avsdr + integer, save :: index_xao_So_anidr + integer, save :: index_xao_So_avsdf + integer, save :: index_xao_So_anidf + integer, save :: index_a2x_Faxa_snowc + integer, save :: index_a2x_Faxa_snowl + integer, save :: index_a2x_Faxa_rainc + integer, save :: index_a2x_Faxa_rainl + integer, save :: index_x2o_Foxx_swnet + integer, save :: index_x2o_Faxa_snow + integer, save :: index_x2o_Faxa_rain + integer, save :: index_x2o_Faxa_prec + + !wiso fields: + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_x2o_Faxa_rain_16O + integer, save :: index_x2o_Faxa_snow_16O + integer, save :: index_x2o_Faxa_prec_16O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_x2o_Faxa_rain_18O + integer, save :: index_x2o_Faxa_snow_18O + integer, save :: index_x2o_Faxa_prec_18O + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_x2o_Faxa_rain_HDO + integer, save :: index_x2o_Faxa_snow_HDO + integer, save :: index_x2o_Faxa_prec_HDO + + logical, save, pointer :: amerge(:),imerge(:),xmerge(:) + integer, save, pointer :: aindx(:), iindx(:), oindx(:), xindx(:) + logical, save :: first_time = .true. + logical, save :: flds_wiso = .false. + character(*),parameter :: subName = '(mrg_x2o_run_mct) ' + !----------------------------------------------------------------------- + + call seq_comm_setptrs(CPLID, iamroot=iamroot) + + noflds = mct_aVect_nRattr(x2o_o) + naflds = mct_aVect_nRattr(a2x_o) + niflds = mct_aVect_nRattr(i2x_o) + nxflds = mct_aVect_nRattr(xao_o) + + if (first_time) then + index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_o,'Faxa_swvdr') + index_a2x_Faxa_swvdf = mct_aVect_indexRA(a2x_o,'Faxa_swvdf') + index_a2x_Faxa_swndr = mct_aVect_indexRA(a2x_o,'Faxa_swndr') + index_a2x_Faxa_swndf = mct_aVect_indexRA(a2x_o,'Faxa_swndf') + index_i2x_Fioi_swpen = mct_aVect_indexRA(i2x_o,'Fioi_swpen') + index_xao_So_avsdr = mct_aVect_indexRA(xao_o,'So_avsdr') + index_xao_So_anidr = mct_aVect_indexRA(xao_o,'So_anidr') + index_xao_So_avsdf = mct_aVect_indexRA(xao_o,'So_avsdf') + index_xao_So_anidf = mct_aVect_indexRA(xao_o,'So_anidf') + index_x2o_Foxx_swnet = mct_aVect_indexRA(x2o_o,'Foxx_swnet') + + index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_o,'Faxa_snowc') + index_a2x_Faxa_snowl = mct_aVect_indexRA(a2x_o,'Faxa_snowl') + index_a2x_Faxa_rainc = mct_aVect_indexRA(a2x_o,'Faxa_rainc') + index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_o,'Faxa_rainl') + index_x2o_Faxa_snow = mct_aVect_indexRA(x2o_o,'Faxa_snow') + index_x2o_Faxa_rain = mct_aVect_indexRA(x2o_o,'Faxa_rain') + index_x2o_Faxa_prec = mct_aVect_indexRA(x2o_o,'Faxa_prec') + + !wiso: + ! H2_16O + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_16O', perrWith='quiet') + index_x2o_Faxa_rain_16O = mct_aVect_indexRA(x2o_o,'Faxa_rain_16O' , perrWith='quiet') + index_x2o_Faxa_snow_16O = mct_aVect_indexRA(x2o_o,'Faxa_snow_16O' , perrWith='quiet') + index_x2o_Faxa_prec_16O = mct_aVect_indexRA(x2o_o,'Faxa_prec_16O' , perrWith='quiet') + if ( index_x2o_Faxa_rain_16O /= 0 ) flds_wiso = .true. + ! H2_18O + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_18O', perrWith='quiet') + index_x2o_Faxa_rain_18O = mct_aVect_indexRA(x2o_o,'Faxa_rain_18O' , perrWith='quiet') + index_x2o_Faxa_snow_18O = mct_aVect_indexRA(x2o_o,'Faxa_snow_18O' , perrWith='quiet') + index_x2o_Faxa_prec_18O = mct_aVect_indexRA(x2o_o,'Faxa_prec_18O' , perrWith='quiet') + if ( index_x2o_Faxa_rain_18O /= 0 ) flds_wiso = .true. + ! HDO + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainl_HDO', perrWith='quiet') + index_x2o_Faxa_rain_HDO = mct_aVect_indexRA(x2o_o,'Faxa_rain_HDO' , perrWith='quiet') + index_x2o_Faxa_snow_HDO = mct_aVect_indexRA(x2o_o,'Faxa_snow_HDO' , perrWith='quiet') + index_x2o_Faxa_prec_HDO = mct_aVect_indexRA(x2o_o,'Faxa_prec_HDO' , perrWith='quiet') + if ( index_x2o_Faxa_rain_HDO /= 0 ) flds_wiso = .true. + + + + ! Compute all other quantities based on standardized naming convention (see below) + ! Only ocn field states that have the name-prefix Sx_ will be merged + ! Only field names have the same name-suffix (after the "_") will be merged + ! (e.g. Si_fldname, Sa_fldname => merged to => Sx_fldname) + ! All fluxes will be scaled by the corresponding afrac or ifrac + ! EXCEPT for + ! -- Faxa_snnet, Faxa_snow, Faxa_rain, Faxa_prec (derived) + ! -- Forr_* (treated in ccsm_comp_mod) + ! All i2x_o fluxes that have the name-suffix "Faii" (atm/ice fluxes) will be ignored + ! - only ice fluxes that are Fioi_... will be used in the ocean merges + + allocate(aindx(noflds), amerge(noflds)) + allocate(iindx(noflds), imerge(noflds)) + allocate(xindx(noflds), xmerge(noflds)) + aindx(:) = 0 + iindx(:) = 0 + xindx(:) = 0 + amerge(:) = .true. + imerge(:) = .true. + xmerge(:) = .true. + + do kof = 1,noflds + call getfld(kof, x2o_o, field_ocn, itemc_ocn) + if (field_ocn(1:2) == 'PF') then + cycle ! if flux has first character as P, pass straight through + end if + if (field_ocn(1:1) == 'S' .and. field_ocn(2:2) /= 'x') then + cycle ! ignore all ocn states that do not have a Sx_ prefix + end if + if (trim(field_ocn) == 'Foxx_swnet'.or. & + trim(field_ocn) == 'Faxa_snow' .or. & + trim(field_ocn) == 'Faxa_rain' .or. & + trim(field_ocn) == 'Faxa_prec') then + cycle ! ignore swnet, snow, rain, prec - treated explicitly above + end if + !wiso + if (trim(field_ocn) == 'Faxa_snow_16O' .or. & + trim(field_ocn) == 'Faxa_rain_16O' .or. & + trim(field_ocn) == 'Faxa_prec_16O' .or. & + trim(field_ocn) == 'Faxa_snow_18O' .or. & + trim(field_ocn) == 'Faxa_rain_18O' .or. & + trim(field_ocn) == 'Faxa_prec_18O' .or. & + trim(field_ocn) == 'Faxa_snow_HDO' .or. & + trim(field_ocn) == 'Faxa_rain_HDO' .or. & + trim(field_ocn) == 'Faxa_prec_HDO') then + cycle ! ignore iso snow, rain, prec - treated explicitly above + end if + if (trim(field_ocn(1:5)) == 'Forr_') then + cycle ! ignore runoff fields from land - treated in coupler + end if + + do kaf = 1,naflds + call getfld(kaf, a2x_o, field_atm, itemc_atm) + if (trim(itemc_ocn) == trim(itemc_atm)) then + if ((trim(field_ocn) == trim(field_atm))) then + if (field_atm(1:1) == 'F') amerge(kof) = .false. + end if + aindx(kof) = kaf + exit + end if + end do + do kif = 1,niflds + call getfld(kif, i2x_o, field_ice, itemc_ice) + if (field_ice(1:1) == 'F' .and. field_ice(2:4) == 'aii') then + cycle ! ignore all i2x_o fluxes that are ice/atm fluxes + end if + if (trim(itemc_ocn) == trim(itemc_ice)) then + if ((trim(field_ocn) == trim(field_ice))) then + if (field_ice(1:1) == 'F') imerge(kof) = .false. + end if + iindx(kof) = kif + exit + end if + end do + do kxf = 1,nxflds + call getfld(kxf, xao_o, field_xao, itemc_xao) + if (trim(itemc_ocn) == trim(itemc_xao)) then + if ((trim(field_ocn) == trim(field_xao))) then + if (field_xao(1:1) == 'F') xmerge(kof) = .false. + end if + xindx(kof) = kxf + exit + end if + end do + if (aindx(kof) == 0) itemc_atm = 'unset' + if (iindx(kof) == 0) itemc_ice = 'unset' + if (xindx(kof) == 0) itemc_xao = 'unset' + + if (iamroot) then + write(logunit,10)trim(itemc_ocn),& + trim(itemc_xao),trim(itemc_ice),trim(itemc_atm) +10 format(' ',' ocn field: ',a15,', xao merge: ',a15, & + ', ice merge: ',a15,', atm merge: ',a15) + write(logunit, *)'field_ocn,kof,imerge,amerge,xmerge= ',& + trim(field_ocn),kof,imerge(kof),xmerge(kof),amerge(kof) + end if + end do + + first_time = .false. + end if + + call seq_cdata_setptrs(cdata_o, infodata=infodata) + call seq_infodata_GetData(infodata, flux_epbalfact = flux_epbalfact) + + call mct_aVect_zero(x2o_o) + + call mct_aVect_copy(aVin=a2x_o, aVout=x2o_o, vector=mct_usevector) + call mct_aVect_copy(aVin=i2x_o, aVout=x2o_o, vector=mct_usevector) + call mct_aVect_copy(aVin=w2x_o, aVout=x2o_o, vector=mct_usevector) + call mct_aVect_copy(aVin=xao_o, aVout=x2o_o, vector=mct_usevector) + + ! Compute input ocn state (note that this only applies to non-land portion of gridcell) + + ki = mct_aVect_indexRa(fractions_o,"ifrac",perrWith=subName) + ko = mct_aVect_indexRa(fractions_o,"ofrac",perrWith=subName) + kir = mct_aVect_indexRa(fractions_o,"ifrad",perrWith=subName) + kor = mct_aVect_indexRa(fractions_o,"ofrad",perrWith=subName) + lsize = mct_aVect_lsize(x2o_o) + do n = 1,lsize + + ifrac = fractions_o%rAttr(ki,n) + afrac = fractions_o%rAttr(ko,n) + frac_sum = ifrac + afrac + if ((frac_sum) /= 0._r8) then + ifrac = ifrac / (frac_sum) + afrac = afrac / (frac_sum) + endif + + ifracr = fractions_o%rAttr(kir,n) + afracr = fractions_o%rAttr(kor,n) + frac_sum = ifracr + afracr + if ((frac_sum) /= 0._r8) then + ifracr = ifracr / (frac_sum) + afracr = afracr / (frac_sum) + endif + + ! Derived: compute net short-wave + avsdr = xao_o%rAttr(index_xao_So_avsdr,n) + anidr = xao_o%rAttr(index_xao_So_anidr,n) + avsdf = xao_o%rAttr(index_xao_So_avsdf,n) + anidf = xao_o%rAttr(index_xao_So_anidf,n) + fswabsv = a2x_o%rAttr(index_a2x_Faxa_swvdr,n) * (1.0_R8 - avsdr) & + + a2x_o%rAttr(index_a2x_Faxa_swvdf,n) * (1.0_R8 - avsdf) + fswabsi = a2x_o%rAttr(index_a2x_Faxa_swndr,n) * (1.0_R8 - anidr) & + + a2x_o%rAttr(index_a2x_Faxa_swndf,n) * (1.0_R8 - anidf) + x2o_o%rAttr(index_x2o_Foxx_swnet,n) = (fswabsv + fswabsi) * afracr + & + i2x_o%rAttr(index_i2x_Fioi_swpen,n) * ifrac + + ! Derived: compute total precipitation - scale total precip + ! Note that runoff is scaled by flux_epbalfact in ccsm_comp_mod + x2o_o%rAttr(index_x2o_Faxa_snow ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow ,n) = x2o_o%rAttr(index_x2o_Faxa_snow ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec ,n) = x2o_o%rAttr(index_x2o_Faxa_rain ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow ,n) + + !wiso + if ( flds_wiso )then + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) + x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) + x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) + end if + + end do + + do kof = 1,noflds + do n = 1,lsize + ifrac = fractions_o%rAttr(ki,n) + afrac = fractions_o%rAttr(ko,n) + frac_sum = ifrac + afrac + if ((frac_sum) /= 0._r8) then + ifrac = ifrac / (frac_sum) + afrac = afrac / (frac_sum) + endif + if (iindx(kof) > 0) then + if (imerge(kof)) then + x2o_o%rAttr(kof,n) = x2o_o%rAttr(kof,n) + i2x_o%rAttr(iindx(kof),n) * ifrac + else + x2o_o%rAttr(kof,n) = i2x_o%rAttr(iindx(kof),n) * ifrac + end if + end if + if (aindx(kof) > 0) then + if (amerge(kof)) then + x2o_o%rAttr(kof,n) = x2o_o%rAttr(kof,n) + a2x_o%rAttr(aindx(kof),n) * afrac + else + x2o_o%rAttr(kof,n) = a2x_o%rAttr(aindx(kof),n) * afrac + end if + end if + if (xindx(kof) > 0) then + if (xmerge(kof)) then + x2o_o%rAttr(kof,n) = x2o_o%rAttr(kof,n) + xao_o%rAttr(xindx(kof),n) * afrac + else + x2o_o%rAttr(kof,n) = xao_o%rAttr(xindx(kof),n) * afrac + end if + end if + end do + end do + + end subroutine mrg_x2o_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2g_run_mct( cdata_g, s2x_g, x2g_g ) + + !----------------------------------------------------------------------- + ! Arguments + ! + type(seq_cdata), intent(in) :: cdata_g + type(mct_aVect), intent(inout) :: s2x_g ! input + type(mct_aVect), intent(inout) :: x2g_g ! output + !----------------------------------------------------------------------- + + ! Create input glc state directly from land snow output state + call mct_aVect_copy(aVin=s2x_g, aVout=x2g_g, vector=mct_usevector) + + end subroutine mrg_x2g_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2s_run_mct( cdata_s, g2x_s, x2s_s ) + + !----------------------------------------------------------------------- + ! Arguments + ! + type(seq_cdata), intent(in) :: cdata_s + type(mct_aVect), intent(inout) :: g2x_s ! input + type(mct_aVect), intent(inout) :: x2s_s ! output + !----------------------------------------------------------------------- + + ! Create input land state directly from glc output state + call mct_aVect_copy(aVin=g2x_s, aVout=x2s_s, vector=mct_usevector) + + end subroutine mrg_x2s_run_mct + +!-------------------------------------------------------------------------- + + subroutine mrg_x2w_run_mct( cdata_w, a2x_w, o2x_w, i2x_w, frac_w, x2w_w) + + !----------------------------------------------------------------------- + ! Arguments + ! + type(seq_cdata), intent(in) :: cdata_w + type(mct_aVect), intent(inout) :: a2x_w ! input + type(mct_aVect), intent(inout) :: o2x_w ! input + type(mct_aVect), intent(inout) :: i2x_w ! input + type(mct_aVect), intent(inout) :: frac_w ! input + type(mct_aVect), intent(inout) :: x2w_w ! output + !----------------------------------------------------------------------- + + ! Create input wave state directly from atm, ocn, ice output state + + call mct_aVect_copy(aVin=a2x_w, aVout=x2w_w, vector=mct_usevector) + call mct_aVect_copy(aVin=o2x_w, aVout=x2w_w, vector=mct_usevector) + call mct_aVect_copy(aVin=i2x_w, aVout=x2w_w, vector=mct_usevector) + + end subroutine mrg_x2w_run_mct + +!-------------------------------------------------------------------------- + + subroutine getfld(n, av, field, suffix) + integer , intent(in) :: n + type(mct_aVect) , intent(in) :: av + character(len=*), intent(out) :: field + character(len=*), intent(out) :: suffix + + type(mct_string) :: mstring ! mct char type + + call mct_aVect_getRList(mstring,n,av) + field = mct_string_toChar(mstring) + suffix = trim(field(scan(field,'_'):)) + call mct_string_clean(mstring) + + if (field(1:1) /= 'S' .and. field(1:1) /= 'F' .and. field(1:2) /= 'PF') then + write(6,*)'field attribute',trim(field),' must start with S or F or PF' + call shr_sys_abort() + end if + end subroutine getfld + +end module mrg_mod + diff --git a/driver_cpl/driver/prep_ice_mod.F90 b/driver_cpl/driver/prep_ice_mod.F90 index 52c158dfd5eb..ea93e0136d68 100644 --- a/driver_cpl/driver/prep_ice_mod.F90 +++ b/driver_cpl/driver/prep_ice_mod.F90 @@ -245,6 +245,25 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) integer, save :: index_x2i_Faxa_rain integer, save :: index_x2i_Faxa_snow integer, save :: index_x2i_Fixx_rofi + !wiso fields: + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_x2i_Faxa_rain_16O + integer, save :: index_x2i_Faxa_snow_16O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_x2i_Faxa_rain_18O + integer, save :: index_x2i_Faxa_snow_18O + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_x2i_Faxa_rain_HDO + integer, save :: index_x2i_Faxa_snow_HDO logical, save :: first_time = .true. logical :: iamroot character(CL),allocatable :: mrgstr(:) ! temporary string @@ -272,6 +291,28 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) index_x2i_Faxa_snow = mct_aVect_indexRA(x2i_i,'Faxa_snow' ) index_x2i_Fixx_rofi = mct_aVect_indexRA(x2i_i,'Fixx_rofi') + ! Water isotope fields + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_16O', perrWith='quiet') + index_x2i_Faxa_rain_16O = mct_aVect_indexRA(x2i_i,'Faxa_rain_16O', perrWith='quiet' ) + index_x2i_Faxa_snow_16O = mct_aVect_indexRA(x2i_i,'Faxa_snow_16O', perrWith='quiet' ) + + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_i,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_i,'Faxa_rainl_18O', perrWith='quiet') + index_x2i_Faxa_rain_18O = mct_aVect_indexRA(x2i_i,'Faxa_rain_18O', perrWith='quiet' ) + index_x2i_Faxa_snow_18O = mct_aVect_indexRA(x2i_i,'Faxa_snow_18O', perrWith='quiet' ) + + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_i,'Faxa_rainl_HDO', perrWith='quiet') + index_x2i_Faxa_rain_HDO = mct_aVect_indexRA(x2i_i,'Faxa_rain_HDO', perrWith='quiet' ) + index_x2i_Faxa_snow_HDO = mct_aVect_indexRA(x2i_i,'Faxa_snow_HDO', perrWith='quiet' ) + do i = 1,niflds field = mct_aVect_getRList2c(i, x2i_i) mrgstr(i) = subname//'x2i%'//trim(field)//' =' @@ -309,6 +350,26 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) mrgstr(index_x2i_Fixx_rofi) = trim(mrgstr(index_x2i_Fixx_rofi))//' = '// & '(g2x%Figg_rofi + r2x%Firr_rofi)*flux_epbalfact' + !--- water isotope document manual merges --- + if ( index_x2i_Faxa_rain_16O /= 0 ) then + mrgstr(index_x2i_Faxa_rain_16O) = trim(mrgstr(index_x2i_Faxa_rain_16O))//' = '// & + '(a2x%Faxa_rainc_16O + a2x%Faxa_rainl_16O)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_16O) = trim(mrgstr(index_x2i_Faxa_snow_16O))//' = '// & + '(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O)*flux_epbalfact' + end if + if ( index_x2i_Faxa_rain_18O /= 0 ) then + mrgstr(index_x2i_Faxa_rain_18O) = trim(mrgstr(index_x2i_Faxa_rain_18O))//' = '// & + '(a2x%Faxa_rainc_18O + a2x%Faxa_rainl_18O)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_18O) = trim(mrgstr(index_x2i_Faxa_snow_18O))//' = '// & + '(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O)*flux_epbalfact' + end if + if ( index_x2i_Faxa_rain_HDO /= 0 ) then + mrgstr(index_x2i_Faxa_rain_HDO) = trim(mrgstr(index_x2i_Faxa_rain_HDO))//' = '// & + '(a2x%Faxa_rainc_HDO + a2x%Faxa_rainl_HDO)*flux_epbalfact' + mrgstr(index_x2i_Faxa_snow_HDO) = trim(mrgstr(index_x2i_Faxa_snow_HDO))//' = '// & + '(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO)*flux_epbalfact' + end if + endif ! call mct_aVect_copy(aVin=o2x_i, aVout=x2i_i, vector=mct_usevector) @@ -332,6 +393,36 @@ subroutine prep_ice_merge(flux_epbalfact, a2x_i, o2x_i, r2x_i, g2x_i, x2i_i ) x2i_i%rAttr(index_x2i_Faxa_rain,i) = x2i_i%rAttr(index_x2i_Faxa_rain,i) * flux_epbalfact x2i_i%rAttr(index_x2i_Faxa_snow,i) = x2i_i%rAttr(index_x2i_Faxa_snow,i) * flux_epbalfact x2i_i%rAttr(index_x2i_Fixx_rofi,i) = x2i_i%rAttr(index_x2i_Fixx_rofi,i) * flux_epbalfact + + ! For water isotopes + if ( index_x2i_Faxa_rain_16O /= 0 ) then + x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_16O,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_16O,i) + x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_16O,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_16O,i) + + x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) = x2i_i%rAttr(index_x2i_Faxa_rain_16O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) = x2i_i%rAttr(index_x2i_Faxa_snow_16O,i) * flux_epbalfact + end if + if ( index_x2i_Faxa_rain_18O /= 0 ) then + x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_18O,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_18O,i) + x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_18O,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_18O,i) + + x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) = x2i_i%rAttr(index_x2i_Faxa_rain_18O,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) = x2i_i%rAttr(index_x2i_Faxa_snow_18O,i) * flux_epbalfact + end if + if ( index_x2i_Faxa_rain_HDO /= 0 ) then + x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) = a2x_i%rAttr(index_a2x_Faxa_rainc_HDO,i) + & + a2x_i%rAttr(index_a2x_Faxa_rainl_HDO,i) + x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) = a2x_i%rAttr(index_a2x_Faxa_snowc_HDO,i) + & + a2x_i%rAttr(index_a2x_Faxa_snowl_HDO,i) + + x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) = x2i_i%rAttr(index_x2i_Faxa_rain_HDO,i) * flux_epbalfact + x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) = x2i_i%rAttr(index_x2i_Faxa_snow_HDO,i) * flux_epbalfact + end if + end do if (first_time) then diff --git a/driver_cpl/driver/prep_ocn_mod.F90 b/driver_cpl/driver/prep_ocn_mod.F90 index e3a5ba03a477..424bd91449f6 100644 --- a/driver_cpl/driver/prep_ocn_mod.F90 +++ b/driver_cpl/driver/prep_ocn_mod.F90 @@ -527,6 +527,12 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa integer, save :: index_a2x_Faxa_rainl integer, save :: index_r2x_Forr_rofl integer, save :: index_r2x_Forr_rofi + integer, save :: index_r2x_Forr_rofl_16O + integer, save :: index_r2x_Forr_rofi_16O + integer, save :: index_r2x_Forr_rofl_18O + integer, save :: index_r2x_Forr_rofi_18O + integer, save :: index_r2x_Forr_rofl_HDO + integer, save :: index_r2x_Forr_rofi_HDO integer, save :: index_r2x_Flrr_flood integer, save :: index_g2x_Fogg_rofl integer, save :: index_g2x_Fogg_rofi @@ -539,7 +545,34 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa integer, save :: index_x2o_Sf_afrac integer, save :: index_x2o_Sf_afracr integer, save :: index_x2o_Foxx_swnet_afracr - logical :: iamroot + integer, save :: index_x2o_Foxx_rofl_16O + integer, save :: index_x2o_Foxx_rofi_16O + integer, save :: index_x2o_Foxx_rofl_18O + integer, save :: index_x2o_Foxx_rofi_18O + integer, save :: index_x2o_Foxx_rofl_HDO + integer, save :: index_x2o_Foxx_rofi_HDO + integer, save :: index_a2x_Faxa_snowc_16O + integer, save :: index_a2x_Faxa_snowl_16O + integer, save :: index_a2x_Faxa_rainc_16O + integer, save :: index_a2x_Faxa_rainl_16O + integer, save :: index_x2o_Faxa_rain_16O + integer, save :: index_x2o_Faxa_snow_16O + integer, save :: index_x2o_Faxa_prec_16O + integer, save :: index_a2x_Faxa_snowc_18O + integer, save :: index_a2x_Faxa_snowl_18O + integer, save :: index_a2x_Faxa_rainc_18O + integer, save :: index_a2x_Faxa_rainl_18O + integer, save :: index_x2o_Faxa_rain_18O + integer, save :: index_x2o_Faxa_snow_18O + integer, save :: index_x2o_Faxa_prec_18O + integer, save :: index_a2x_Faxa_snowc_HDO + integer, save :: index_a2x_Faxa_snowl_HDO + integer, save :: index_a2x_Faxa_rainc_HDO + integer, save :: index_a2x_Faxa_rainl_HDO + integer, save :: index_x2o_Faxa_rain_HDO + integer, save :: index_x2o_Faxa_snow_HDO + integer, save :: index_x2o_Faxa_prec_HDO + logical :: iamroot logical, save, pointer :: amerge(:),imerge(:),xmerge(:) integer, save, pointer :: aindx(:), iindx(:), oindx(:), xindx(:) character(CL),allocatable :: mrgstr(:) ! temporary string @@ -594,6 +627,44 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa index_x2o_Foxx_swnet_afracr = mct_aVect_indexRA(x2o_o,'Foxx_swnet_afracr') endif + !wiso: + ! H2_16O + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_16O', perrWith='quiet') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_16O', perrWith='quiet') + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_16O', perrWith='quiet') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_16O', perrWith='quiet') + index_r2x_Forr_rofl_16O = mct_aVect_indexRA(r2x_o,'Forr_rofl_16O' , perrWith='quiet') + index_r2x_Forr_rofi_16O = mct_aVect_indexRA(r2x_o,'Forr_rofi_16O' , perrWith='quiet') + index_x2o_Faxa_rain_16O = mct_aVect_indexRA(x2o_o,'Faxa_rain_16O' , perrWith='quiet') + index_x2o_Faxa_snow_16O = mct_aVect_indexRA(x2o_o,'Faxa_snow_16O' , perrWith='quiet') + index_x2o_Faxa_prec_16O = mct_aVect_indexRA(x2o_o,'Faxa_prec_16O' , perrWith='quiet') + index_x2o_Foxx_rofl_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_16O' , perrWith='quiet') + index_x2o_Foxx_rofi_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_16O' , perrWith='quiet') + ! H2_18O + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowc_18O', perrWith='quiet') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_o,'Faxa_snowl_18O', perrWith='quiet') + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainc_18O', perrWith='quiet') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_o,'Faxa_rainl_18O', perrWith='quiet') + index_r2x_Forr_rofl_18O = mct_aVect_indexRA(r2x_o,'Forr_rofl_18O' , perrWith='quiet') + index_r2x_Forr_rofi_18O = mct_aVect_indexRA(r2x_o,'Forr_rofi_18O' , perrWith='quiet') + index_x2o_Faxa_rain_18O = mct_aVect_indexRA(x2o_o,'Faxa_rain_18O' , perrWith='quiet') + index_x2o_Faxa_snow_18O = mct_aVect_indexRA(x2o_o,'Faxa_snow_18O' , perrWith='quiet') + index_x2o_Faxa_prec_18O = mct_aVect_indexRA(x2o_o,'Faxa_prec_18O' , perrWith='quiet') + index_x2o_Foxx_rofl_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_18O' , perrWith='quiet') + index_x2o_Foxx_rofi_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_18O' , perrWith='quiet') + ! HDO + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowc_HDO', perrWith='quiet') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_snowl_HDO', perrWith='quiet') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainc_HDO', perrWith='quiet') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_o,'Faxa_rainl_HDO', perrWith='quiet') + index_r2x_Forr_rofl_HDO = mct_aVect_indexRA(r2x_o,'Forr_rofl_HDO' , perrWith='quiet') + index_r2x_Forr_rofi_HDO = mct_aVect_indexRA(r2x_o,'Forr_rofi_HDO' , perrWith='quiet') + index_x2o_Faxa_rain_HDO = mct_aVect_indexRA(x2o_o,'Faxa_rain_HDO' , perrWith='quiet') + index_x2o_Faxa_snow_HDO = mct_aVect_indexRA(x2o_o,'Faxa_snow_HDO' , perrWith='quiet') + index_x2o_Faxa_prec_HDO = mct_aVect_indexRA(x2o_o,'Faxa_prec_HDO' , perrWith='quiet') + index_x2o_Foxx_rofl_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofl_HDO' , perrWith='quiet') + index_x2o_Foxx_rofi_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofi_HDO' , perrWith='quiet') + ! Compute all other quantities based on standardized naming convention (see below) ! Only ocn field states that have the name-prefix Sx_ will be merged ! Only field names have the same name-suffix (after the "_") will be merged @@ -661,12 +732,17 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa if (field_ocn(ko)(1:1) == 'S' .and. field_ocn(ko)(2:2) /= 'x') then cycle ! ignore all ocn states that do not have a Sx_ prefix end if - if (trim(field_ocn(ko)) == 'Foxx_swnet'.or. & - trim(field_ocn(ko)) == 'Faxa_snow' .or. & - trim(field_ocn(ko)) == 'Faxa_rain' .or. & - trim(field_ocn(ko)) == 'Faxa_prec') then + if (trim(field_ocn(ko)) == 'Foxx_swnet' .or. & + trim(field_ocn(ko)) == 'Faxa_snow' .or. & + trim(field_ocn(ko)) == 'Faxa_rain' .or. & + trim(field_ocn(ko)) == 'Faxa_prec' )then cycle ! ignore swnet, snow, rain, prec - treated explicitly above end if + if (index(field_ocn(ko), 'Faxa_snow_' ) == 1 .or. & + index(field_ocn(ko), 'Faxa_rain_' ) == 1 .or. & + index(field_ocn(ko), 'Faxa_prec_' ) == 1 )then + cycle ! ignore isotope snow, rain, prec - treated explicitly above + end if ! if (trim(field_ocn(ko)(1:5)) == 'Foxx_') then ! cycle ! ignore runoff fields from land - treated in coupler ! end if @@ -808,6 +884,34 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa '(r2x%Forr_rofl + r2x%Flrr_flood + g2x%Fogg_rofl)*flux_epbalfact' mrgstr(index_x2o_Foxx_rofi) = trim(mrgstr(index_x2o_Foxx_rofi))//' = '// & '(r2x%Forr_rofi + g2x%Fogg_rofi)*flux_epbalfact' + ! water isotope snow, rain prec + if ( index_x2o_Faxa_snow_16O /= 0 )then + mrgstr(index_x2o_Faxa_snow_16O) = trim(mrgstr(index_x2o_Faxa_snow_16O))//' = '// & + 'afrac*(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_16O) = trim(mrgstr(index_x2o_Faxa_rain_16O))//' = '// & + 'afrac*(a2x%Faxa_rainc_16O + a2x%Faxa_rainl_16O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_16O) = trim(mrgstr(index_x2o_Faxa_prec_16O))//' = '// & + 'afrac*(a2x%Faxa_snowc_16O + a2x%Faxa_snowl_16O + a2x%Faxa_rainc_16O + '// & + 'a2x%Faxa_rainl_16O)*flux_epbalfact' + end if + if ( index_x2o_Faxa_snow_18O /= 0 )then + mrgstr(index_x2o_Faxa_snow_18O) = trim(mrgstr(index_x2o_Faxa_snow_18O))//' = '// & + 'afrac*(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_18O) = trim(mrgstr(index_x2o_Faxa_rain_18O))//' = '// & + 'afrac*(a2x%Faxa_rainc_18O + a2x%Faxa_rainl_18O)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_18O) = trim(mrgstr(index_x2o_Faxa_prec_18O))//' = '// & + 'afrac*(a2x%Faxa_snowc_18O + a2x%Faxa_snowl_18O + a2x%Faxa_rainc_18O + '// & + 'a2x%Faxa_rainl_18O)*flux_epbalfact' + end if + if ( index_x2o_Faxa_snow_HDO /= 0 )then + mrgstr(index_x2o_Faxa_snow_HDO) = trim(mrgstr(index_x2o_Faxa_snow_HDO))//' = '// & + 'afrac*(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO)*flux_epbalfact' + mrgstr(index_x2o_Faxa_rain_HDO) = trim(mrgstr(index_x2o_Faxa_rain_HDO))//' = '// & + 'afrac*(a2x%Faxa_rainc_HDO + a2x%Faxa_rainl_HDO)*flux_epbalfact' + mrgstr(index_x2o_Faxa_prec_HDO) = trim(mrgstr(index_x2o_Faxa_prec_HDO))//' = '// & + 'afrac*(a2x%Faxa_snowc_HDO + a2x%Faxa_snowl_HDO + a2x%Faxa_rainc_HDO + '// & + 'a2x%Faxa_rainl_HDO)*flux_epbalfact' + end if endif ! Compute input ocn state (note that this only applies to non-land portion of gridcell) @@ -871,6 +975,66 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact x2o_o%rAttr(index_x2o_Foxx_rofi, n) = (r2x_o%rAttr(index_r2x_Forr_rofi , n) + & g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + + + if ( index_x2o_Foxx_rofl_16O /= 0 ) then + x2o_o%rAttr(index_x2o_Foxx_rofl_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_16O, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) + & + g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_16O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_16O , n) + & + g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofl_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_18O, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) + & + g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_18O, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_18O , n) + & + g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofl_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofl_HDO, n) + & + r2x_o%rAttr(index_r2x_Flrr_flood, n) + & + g2x_o%rAttr(index_g2x_Fogg_rofl , n)) * flux_epbalfact + x2o_o%rAttr(index_x2o_Foxx_rofi_HDO, n) = (r2x_o%rAttr(index_r2x_Forr_rofi_HDO , n) + & + g2x_o%rAttr(index_g2x_Fogg_rofi , n)) * flux_epbalfact + end if + + ! Derived: water isotopes total preciptiation and scaling + + if ( index_x2o_Faxa_snow_16O /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_16O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_16O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_16O,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_16O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_16O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_16O ,n) + end if + + if ( index_x2o_Faxa_snow_18O /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_18O,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_18O,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_18O,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_18O ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_18O ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_18O ,n) + end if + + if ( index_x2o_Faxa_snow_HDO /= 0 )then + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_snowc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_snowl_HDO,n) * afrac + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = a2x_o%rAttr(index_a2x_Faxa_rainc_HDO,n) * afrac + & + a2x_o%rAttr(index_a2x_Faxa_rainl_HDO,n) * afrac + + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) * flux_epbalfact + x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) * flux_epbalfact + + x2o_o%rAttr(index_x2o_Faxa_prec_HDO ,n) = x2o_o%rAttr(index_x2o_Faxa_rain_HDO ,n) + & + x2o_o%rAttr(index_x2o_Faxa_snow_HDO ,n) + end if end do do ko = 1,noflds @@ -1026,7 +1190,9 @@ subroutine prep_ocn_calc_r2x_ox(timer) r2x_rx => component_get_c2x_cx(rof(eri)) call seq_map_map(mapper_Rr2o, r2x_rx, r2x_ox(eri), & - fldlist='Forr_rofl:Forr_rofi', norm=.false.) + fldlist='Forr_rofl:Forr_rofi: & + Forr_rofl_16O:Forr_rofi_16O:Forr_rofl_18O: & + Forr_rofi_18O:Forr_rofl_HDO:Forr_rofi_HDO', norm=.false.) if (flood_present) then call seq_map_map(mapper_Fr2o, r2x_rx, r2x_ox(eri), & fldlist='Flrr_flood', norm=.true.) diff --git a/driver_cpl/driver/prep_rof_mod.F90 b/driver_cpl/driver/prep_rof_mod.F90 index cbc079ffb5f7..4fcc7ee57c77 100644 --- a/driver_cpl/driver/prep_rof_mod.F90 +++ b/driver_cpl/driver/prep_rof_mod.F90 @@ -256,8 +256,21 @@ subroutine prep_rof_merge(l2x_r, fractions_r, x2r_r) integer, save :: index_x2r_Flrl_rofsub integer, save :: index_x2r_Flrl_rofdto integer, save :: index_x2r_Flrl_rofi + integer, save :: index_l2x_Flrl_rofl_16O + integer, save :: index_l2x_Flrl_rofi_16O + integer, save :: index_x2r_Flrl_rofl_16O + integer, save :: index_x2r_Flrl_rofi_16O + integer, save :: index_l2x_Flrl_rofl_18O + integer, save :: index_l2x_Flrl_rofi_18O + integer, save :: index_x2r_Flrl_rofl_18O + integer, save :: index_x2r_Flrl_rofi_18O + integer, save :: index_l2x_Flrl_rofl_HDO + integer, save :: index_l2x_Flrl_rofi_HDO + integer, save :: index_x2r_Flrl_rofl_HDO + integer, save :: index_x2r_Flrl_rofi_HDO integer, save :: index_lfrac logical, save :: first_time = .true. + logical, save :: flds_wiso_rof = .false. real(r8) :: lfrac integer :: nflds,lsize logical :: iamroot @@ -289,6 +302,26 @@ subroutine prep_rof_merge(l2x_r, fractions_r, x2r_r) index_x2r_Flrl_rofsub = mct_aVect_indexRA(x2r_r,'Flrl_rofsub' ) index_x2r_Flrl_rofdto = mct_aVect_indexRA(x2r_r,'Flrl_rofdto' ) index_x2r_Flrl_rofi = mct_aVect_indexRA(x2r_r,'Flrl_rofi' ) + index_l2x_Flrl_rofl_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofl_16O', perrWith='quiet' ) + + if ( index_l2x_Flrl_rofl_16O /= 0 ) flds_wiso_rof = .true. + if ( flds_wiso_rof ) then + index_l2x_Flrl_rofi_16O = mct_aVect_indexRA(l2x_r,'Flrl_rofi_16O' ) + index_x2r_Flrl_rofl_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_16O' ) + index_x2r_Flrl_rofi_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_16O' ) + + index_l2x_Flrl_rofl_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofl_18O' ) + index_l2x_Flrl_rofi_18O = mct_aVect_indexRA(l2x_r,'Flrl_rofi_18O' ) + index_x2r_Flrl_rofl_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_18O' ) + index_x2r_Flrl_rofi_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_18O' ) + + index_l2x_Flrl_rofl_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofl_HDO' ) + index_l2x_Flrl_rofi_HDO = mct_aVect_indexRA(l2x_r,'Flrl_rofi_HDO' ) + index_x2r_Flrl_rofl_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofl_HDO' ) + index_x2r_Flrl_rofi_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofi_HDO' ) + end if + index_lfrac = mct_aVect_indexRA(fractions_r,"lfrac") + index_lfrac = mct_aVect_indexRA(fractions_r,"lfrac") mrgstr(index_x2r_Flrl_rofsur) = trim(mrgstr(index_x2r_Flrl_rofsur))//' = '// & @@ -301,6 +334,20 @@ subroutine prep_rof_merge(l2x_r, fractions_r, x2r_r) 'lfrac*l2x%Flrl_rofdto' mrgstr(index_x2r_Flrl_rofi) = trim(mrgstr(index_x2r_Flrl_rofi))//' = '// & 'lfrac*l2x%Flrl_rofi' + if ( flds_wiso_rof ) then + mrgstr(index_x2r_Flrl_rofl_16O) = trim(mrgstr(index_x2r_Flrl_rofl_16O))//' = '// & + 'lfrac*l2x%Flrl_rofl_16O' + mrgstr(index_x2r_Flrl_rofi_16O) = trim(mrgstr(index_x2r_Flrl_rofi_16O))//' = '// & + 'lfrac*l2x%Flrl_rofi_16O' + mrgstr(index_x2r_Flrl_rofl_18O) = trim(mrgstr(index_x2r_Flrl_rofl_18O))//' = '// & + 'lfrac*l2x%Flrl_rofl_18O' + mrgstr(index_x2r_Flrl_rofi_18O) = trim(mrgstr(index_x2r_Flrl_rofi_18O))//' = '// & + 'lfrac*l2x%Flrl_rofi_18O' + mrgstr(index_x2r_Flrl_rofl_HDO) = trim(mrgstr(index_x2r_Flrl_rofl_HDO))//' = '// & + 'lfrac*l2x%Flrl_rofl_HDO' + mrgstr(index_x2r_Flrl_rofi_HDO) = trim(mrgstr(index_x2r_Flrl_rofi_HDO))//' = '// & + 'lfrac*l2x%Flrl_rofi_HDO' + end if end if do i = 1,lsize @@ -310,6 +357,14 @@ subroutine prep_rof_merge(l2x_r, fractions_r, x2r_r) x2r_r%rAttr(index_x2r_Flrl_rofsub,i) = l2x_r%rAttr(index_l2x_Flrl_rofsub,i) * lfrac x2r_r%rAttr(index_x2r_Flrl_rofdto,i) = l2x_r%rAttr(index_l2x_Flrl_rofdto,i) * lfrac x2r_r%rAttr(index_x2r_Flrl_rofi,i) = l2x_r%rAttr(index_l2x_Flrl_rofi,i) * lfrac + if ( flds_wiso_rof ) then + x2r_r%rAttr(index_x2r_Flrl_rofl_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_16O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofi_16O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_16O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofl_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_18O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofi_18O,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_18O,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofl_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofl_HDO,i) * lfrac + x2r_r%rAttr(index_x2r_Flrl_rofi_HDO,i) = l2x_r%rAttr(index_l2x_Flrl_rofi_HDO,i) * lfrac + end if end do if (first_time) then diff --git a/driver_cpl/driver/seq_diag_mct.F90 b/driver_cpl/driver/seq_diag_mct.F90 index 1415bef5b0a0..c0aafa3e665a 100644 --- a/driver_cpl/driver/seq_diag_mct.F90 +++ b/driver_cpl/driver/seq_diag_mct.F90 @@ -1,8 +1,4 @@ !=============================================================================== -! SVN $Id: seq_diag_mct.F90 61512 2014-06-26 21:59:35Z tcraig $ -! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_1_15/driver/seq_diag_mct.F90 $ -!=============================================================================== -!BOP =========================================================================== ! ! !MODULE: seq_diag_mod -- computes spatial \& time averages of fluxed quatities ! @@ -119,34 +115,71 @@ module seq_diag_mct !--- F for field --- - integer(in),parameter :: f_size = 17 - integer(in),parameter :: f_a = 1 ! index for area - integer(in),parameter :: f_h = 2 ! 1st index for heat - integer(in),parameter :: f_w = 11 ! 1st index for water - - integer(in),parameter :: f_area = 1 ! area (wrt to unit sphere) - integer(in),parameter :: f_hfrz = 2 ! heat : latent, freezing - integer(in),parameter :: f_hmelt = 3 ! heat : latent, melting - integer(in),parameter :: f_hswnet = 4 ! heat : short wave, net - integer(in),parameter :: f_hlwdn = 5 ! heat : longwave down - integer(in),parameter :: f_hlwup = 6 ! heat : longwave up - integer(in),parameter :: f_hlatv = 7 ! heat : latent, vaporization - integer(in),parameter :: f_hlatf = 8 ! heat : latent, fusion, snow - integer(in),parameter :: f_hioff = 9 ! heat : latent, fusion, frozen runoff - integer(in),parameter :: f_hsen =10 ! heat : sensible - integer(in),parameter :: f_wfrz =11 ! water: freezing - integer(in),parameter :: f_wmelt =12 ! water: melting - integer(in),parameter :: f_wrain =13 ! water: precip, liquid - integer(in),parameter :: f_wsnow =14 ! water: precip, frozen - integer(in),parameter :: f_wevap =15 ! water: evaporation - integer(in),parameter :: f_wroff =16 ! water: runoff/flood - integer(in),parameter :: f_wioff =17 ! water: frozen runoff - - character(len=8),parameter :: fname(f_size) = & - (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & - ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & - ' wfreeze',' wmelt',' wrain',' wsnow', & - ' wevap',' wrunoff',' wfrzrof' /) + integer(in),parameter :: f_area = 1 ! area (wrt to unit sphere) + integer(in),parameter :: f_hfrz = 2 ! heat : latent, freezing + integer(in),parameter :: f_hmelt = 3 ! heat : latent, melting + integer(in),parameter :: f_hswnet = 4 ! heat : short wave, net + integer(in),parameter :: f_hlwdn = 5 ! heat : longwave down + integer(in),parameter :: f_hlwup = 6 ! heat : longwave up + integer(in),parameter :: f_hlatv = 7 ! heat : latent, vaporization + integer(in),parameter :: f_hlatf = 8 ! heat : latent, fusion, snow + integer(in),parameter :: f_hioff = 9 ! heat : latent, fusion, frozen runoff + integer(in),parameter :: f_hsen =10 ! heat : sensible + integer(in),parameter :: f_wfrz =11 ! water: freezing + integer(in),parameter :: f_wmelt =12 ! water: melting + integer(in),parameter :: f_wrain =13 ! water: precip, liquid + integer(in),parameter :: f_wsnow =14 ! water: precip, frozen + integer(in),parameter :: f_wevap =15 ! water: evaporation + integer(in),parameter :: f_wroff =16 ! water: runoff/flood + integer(in),parameter :: f_wioff =17 ! water: frozen runoff + integer(in),parameter :: f_wfrz_16O =18 ! water: freezing + integer(in),parameter :: f_wmelt_16O =19 ! water: melting + integer(in),parameter :: f_wrain_16O =20 ! water: precip, liquid + integer(in),parameter :: f_wsnow_16O =21 ! water: precip, frozen + integer(in),parameter :: f_wevap_16O =22 ! water: evaporation + integer(in),parameter :: f_wroff_16O =23 ! water: runoff/flood + integer(in),parameter :: f_wioff_16O =24 ! water: frozen runoff + integer(in),parameter :: f_wfrz_18O =25 ! water: freezing + integer(in),parameter :: f_wmelt_18O =26 ! water: melting + integer(in),parameter :: f_wrain_18O =27 ! water: precip, liquid + integer(in),parameter :: f_wsnow_18O =28 ! water: precip, frozen + integer(in),parameter :: f_wevap_18O =29 ! water: evaporation + integer(in),parameter :: f_wroff_18O =30 ! water: runoff/flood + integer(in),parameter :: f_wioff_18O =31 ! water: frozen runoff + integer(in),parameter :: f_wfrz_HDO =32 ! water: freezing + integer(in),parameter :: f_wmelt_HDO =33 ! water: melting + integer(in),parameter :: f_wrain_HDO =34 ! water: precip, liquid + integer(in),parameter :: f_wsnow_HDO =35 ! water: precip, frozen + integer(in),parameter :: f_wevap_HDO =36 ! water: evaporation + integer(in),parameter :: f_wroff_HDO =37 ! water: runoff/flood + integer(in),parameter :: f_wioff_HDO =38 ! water: frozen runoff + + integer(in),parameter :: f_size = f_wioff_HDO ! Total array size of all elements + integer(in),parameter :: f_a = f_area ! 1st index for area + integer(in),parameter :: f_a_end = f_area ! last index for area + integer(in),parameter :: f_h = f_hfrz ! 1st index for heat + integer(in),parameter :: f_h_end = f_hsen ! Last index for heat + integer(in),parameter :: f_w = f_wfrz ! 1st index for water + integer(in),parameter :: f_w_end = f_wioff ! Last index for water + integer(in),parameter :: f_16O = f_wfrz_16O ! 1st index for 16O water isotope + integer(in),parameter :: f_18O = f_wfrz_18O ! 1st index for 18O water isotope + integer(in),parameter :: f_HDO = f_wfrz_HDO ! 1st index for HDO water isotope + integer(in),parameter :: f_16O_end = f_wioff_16O ! Last index for 16O water isotope + integer(in),parameter :: f_18O_end = f_wioff_18O ! Last index for 18O water isotope + integer(in),parameter :: f_HDO_end = f_wioff_HDO ! Last index for HDO water isotope + + character(len=12),parameter :: fname(f_size) = & + + (/' area',' hfreeze',' hmelt',' hnetsw',' hlwdn', & + ' hlwup',' hlatvap',' hlatfus',' hiroff',' hsen', & + ' wfreeze',' wmelt',' wrain',' wsnow', & + ' wevap',' wrunoff',' wfrzrof', & + ' wfreeze_16O',' wmelt_16O',' wrain_16O',' wsnow_16O', & + ' wevap_16O',' wrunoff_16O',' wfrzrof_16O', & + ' wfreeze_18O',' wmelt_18O',' wrain_18O',' wsnow_18O', & + ' wevap_18O',' wrunoff_18O',' wfrzrof_18O', & + ' wfreeze_HDO',' wmelt_HDO',' wrain_HDO',' wsnow_HDO', & + ' wevap_HDO',' wrunoff_HDO',' wfrzrof_HDO'/) !--- P for period --- @@ -161,6 +194,8 @@ module seq_diag_mct character(len=8),parameter :: pname(p_size) = & (/' inst',' daily',' monthly',' annual','all_time' /) + logical :: flds_wiso ! If water isotope fields are active + ! !PUBLIC DATA MEMBERS !--- time-averaged (annual?) global budge diagnostics --- @@ -223,7 +258,8 @@ module seq_diag_mct integer :: index_x2r_Flrl_rofdto integer :: index_x2r_Flrl_rofi - integer :: index_o2x_Fioo_frazil + integer :: index_o2x_Fioo_frazil ! currently used by acme + integer :: index_o2x_Fioo_q ! currently used by cesm integer :: index_xao_Faox_lwup integer :: index_xao_Faox_lat @@ -255,13 +291,110 @@ module seq_diag_mct integer :: index_x2i_Faxa_lwdn integer :: index_x2i_Faxa_rain integer :: index_x2i_Faxa_snow - integer :: index_x2i_Fioo_frazil + integer :: index_x2i_Fioo_frazil !currently used by acme + integer :: index_x2i_Fioo_q !currently used by cesm integer :: index_x2i_Fixx_rofi integer :: index_g2x_Fogg_rofl integer :: index_g2x_Fogg_rofi integer :: index_g2x_Figg_rofi + integer :: index_x2o_Foxx_rofl_16O + integer :: index_x2o_Foxx_rofi_16O + integer :: index_x2o_Foxx_rofl_18O + integer :: index_x2o_Foxx_rofi_18O + integer :: index_x2o_Foxx_rofl_HDO + integer :: index_x2o_Foxx_rofi_HDO + + integer :: index_a2x_Faxa_rainc_16O + integer :: index_a2x_Faxa_rainc_18O + integer :: index_a2x_Faxa_rainc_HDO + integer :: index_a2x_Faxa_rainl_16O + integer :: index_a2x_Faxa_rainl_18O + integer :: index_a2x_Faxa_rainl_HDO + integer :: index_a2x_Faxa_snowc_16O + integer :: index_a2x_Faxa_snowc_18O + integer :: index_a2x_Faxa_snowc_HDO + integer :: index_a2x_Faxa_snowl_16O + integer :: index_a2x_Faxa_snowl_18O + integer :: index_a2x_Faxa_snowl_HDO + + integer :: index_x2a_Faxx_evap_16O + integer :: index_x2a_Faxx_evap_18O + integer :: index_x2a_Faxx_evap_HDO + + integer :: index_l2x_Fall_evap_16O + integer :: index_l2x_Fall_evap_18O + integer :: index_l2x_Fall_evap_HDO + + integer :: index_l2x_Flrl_rofl_16O + integer :: index_l2x_Flrl_rofl_18O + integer :: index_l2x_Flrl_rofl_HDO + integer :: index_l2x_Flrl_rofi_16O + integer :: index_l2x_Flrl_rofi_18O + integer :: index_l2x_Flrl_rofi_HDO + + integer :: index_x2l_Faxa_rainc_16O + integer :: index_x2l_Faxa_rainc_18O + integer :: index_x2l_Faxa_rainc_HDO + integer :: index_x2l_Faxa_rainl_16O + integer :: index_x2l_Faxa_rainl_18O + integer :: index_x2l_Faxa_rainl_HDO + integer :: index_x2l_Faxa_snowc_16O + integer :: index_x2l_Faxa_snowc_18O + integer :: index_x2l_Faxa_snowc_HDO + integer :: index_x2l_Faxa_snowl_16O + integer :: index_x2l_Faxa_snowl_18O + integer :: index_x2l_Faxa_snowl_HDO + integer :: index_x2l_Flrr_flood_16O + integer :: index_x2l_Flrr_flood_18O + integer :: index_x2l_Flrr_flood_HDO + + integer :: index_r2x_Forr_rofl_16O + integer :: index_r2x_Forr_rofl_18O + integer :: index_r2x_Forr_rofl_HDO + integer :: index_r2x_Forr_rofi_16O + integer :: index_r2x_Forr_rofi_18O + integer :: index_r2x_Forr_rofi_HDO + integer :: index_r2x_Flrr_flood_16O + integer :: index_r2x_Flrr_flood_18O + integer :: index_r2x_Flrr_flood_HDO + + integer :: index_x2r_Flrl_rofl_16O + integer :: index_x2r_Flrl_rofl_18O + integer :: index_x2r_Flrl_rofl_HDO + integer :: index_x2r_Flrl_rofi_16O + integer :: index_x2r_Flrl_rofi_18O + integer :: index_x2r_Flrl_rofi_HDO + + integer :: index_xao_Faox_evap_16O + integer :: index_xao_Faox_evap_18O + integer :: index_xao_Faox_evap_HDO + + integer :: index_x2o_Fioi_meltw_16O + integer :: index_x2o_Fioi_meltw_18O + integer :: index_x2o_Fioi_meltw_HDO + integer :: index_x2o_Faxa_rain_16O + integer :: index_x2o_Faxa_rain_18O + integer :: index_x2o_Faxa_rain_HDO + integer :: index_x2o_Faxa_snow_16O + integer :: index_x2o_Faxa_snow_18O + integer :: index_x2o_Faxa_snow_HDO + + integer :: index_i2x_Fioi_meltw_16O + integer :: index_i2x_Fioi_meltw_18O + integer :: index_i2x_Fioi_meltw_HDO + integer :: index_i2x_Faii_evap_16O + integer :: index_i2x_Faii_evap_18O + integer :: index_i2x_Faii_evap_HDO + + integer :: index_x2i_Faxa_rain_16O + integer :: index_x2i_Faxa_rain_18O + integer :: index_x2i_Faxa_rain_HDO + integer :: index_x2i_Faxa_snow_16O + integer :: index_x2i_Faxa_snow_18O + integer :: index_x2i_Faxa_snow_HDO + !=============================================================================== contains !=============================================================================== @@ -465,7 +598,8 @@ subroutine seq_diag_atm_mct( atm, frac_a, do_a2x, do_x2a ) integer(in) :: kl,ka,ko,ki ! fraction indices integer(in) :: lSize ! size of aVect real(r8) :: da,di,do,dl ! area of a grid cell - logical,save :: first_time = .true. + logical,save :: first_time = .true. + logical,save :: flds_wiso_atm = .false. !----- formats ----- character(*),parameter :: subName = '(seq_diag_atm_mct) ' @@ -499,6 +633,24 @@ subroutine seq_diag_atm_mct( atm, frac_a, do_a2x, do_x2a ) index_a2x_Faxa_rainl = mct_aVect_indexRA(a2x_a,'Faxa_rainl') index_a2x_Faxa_snowc = mct_aVect_indexRA(a2x_a,'Faxa_snowc') index_a2x_Faxa_snowl = mct_aVect_indexRA(a2x_a,'Faxa_snowl') + + index_a2x_Faxa_rainc_16O = mct_aVect_indexRA(a2x_a,'Faxa_rainc_16O',perrWith='quiet') + if ( index_a2x_Faxa_rainc_16O /= 0 ) flds_wiso_atm = .true. + if ( flds_wiso_atm )then + flds_wiso = .true. + index_a2x_Faxa_rainc_18O = mct_aVect_indexRA(a2x_a,'Faxa_rainc_18O') + index_a2x_Faxa_rainc_HDO = mct_aVect_indexRA(a2x_a,'Faxa_rainc_HDO') + index_a2x_Faxa_rainl_16O = mct_aVect_indexRA(a2x_a,'Faxa_rainl_16O') + index_a2x_Faxa_rainl_18O = mct_aVect_indexRA(a2x_a,'Faxa_rainl_18O') + index_a2x_Faxa_rainl_HDO = mct_aVect_indexRA(a2x_a,'Faxa_rainl_HDO') + index_a2x_Faxa_snowc_16O = mct_aVect_indexRA(a2x_a,'Faxa_snowc_16O') + index_a2x_Faxa_snowc_18O = mct_aVect_indexRA(a2x_a,'Faxa_snowc_18O') + index_a2x_Faxa_snowc_HDO = mct_aVect_indexRA(a2x_a,'Faxa_snowc_HDO') + index_a2x_Faxa_snowl_16O = mct_aVect_indexRA(a2x_a,'Faxa_snowl_16O') + index_a2x_Faxa_snowl_18O = mct_aVect_indexRA(a2x_a,'Faxa_snowl_18O') + index_a2x_Faxa_snowl_HDO = mct_aVect_indexRA(a2x_a,'Faxa_snowl_HDO') + end if + end if lSize = mct_avect_lSize(a2x_a) @@ -530,6 +682,32 @@ subroutine seq_diag_atm_mct( atm, frac_a, do_a2x, do_x2a ) + da*a2x_a%rAttr(index_a2x_Faxa_rainl,n) if = f_wsnow ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + da*a2x_a%rAttr(index_a2x_Faxa_snowc,n) & + da*a2x_a%rAttr(index_a2x_Faxa_snowl,n) + if ( flds_wiso_atm )then + if = f_wrain_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainc_16O,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainl_16O,n) + if = f_wrain_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainc_18O,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainl_18O,n) + if = f_wrain_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainc_HDO,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_rainl_HDO,n) + if = f_wsnow_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowc_16O,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowl_16O,n) + if = f_wsnow_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowc_18O,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowl_18O,n) + if = f_wsnow_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowc_HDO,n) + & + da*a2x_a%rAttr(index_a2x_Faxa_snowl_HDO,n) + end if enddo enddo ! --- heat implied by snow flux --- @@ -546,6 +724,12 @@ subroutine seq_diag_atm_mct( atm, frac_a, do_a2x, do_x2a ) index_x2a_Faxx_lat = mct_aVect_indexRA(x2a_a,'Faxx_lat') index_x2a_Faxx_sen = mct_aVect_indexRA(x2a_a,'Faxx_sen') index_x2a_Faxx_evap = mct_aVect_indexRA(x2a_a,'Faxx_evap') + + if ( flds_wiso_atm )then + index_x2a_Faxx_evap_16O = mct_aVect_indexRA(x2a_a,'Faxx_evap_16O') + index_x2a_Faxx_evap_18O = mct_aVect_indexRA(x2a_a,'Faxx_evap_18O') + index_x2a_Faxx_evap_HDO = mct_aVect_indexRA(x2a_a,'Faxx_evap_HDO') + end if end if lSize = mct_avect_lSize(x2a_a) @@ -576,6 +760,18 @@ subroutine seq_diag_atm_mct( atm, frac_a, do_a2x, do_x2a ) if = f_hsen ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + da*x2a_a%rAttr(index_x2a_Faxx_sen,n) if = f_wevap; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + da*x2a_a%rAttr(index_x2a_Faxx_evap,n) + if ( flds_wiso_atm )then + if = f_wevap_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*x2a_a%rAttr(index_x2a_Faxx_evap_16O,n) + if = f_wevap_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*x2a_a%rAttr(index_x2a_Faxx_evap_18O,n) + if = f_wevap_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + da*x2a_a%rAttr(index_x2a_Faxx_evap_HDO,n) + end if + enddo enddo end if @@ -616,7 +812,8 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, do_l2x, do_x2l) integer(in) :: kl,ka,ko,ki ! fraction indices integer(in) :: lSize ! size of aVect real(r8) :: da,di,do,dl ! area of a grid cell - logical,save :: first_time = .true. + logical,save :: first_time = .true. + logical,save :: flds_wiso_lnd = .false. !----- formats ----- character(*),parameter :: subName = '(seq_diag_lnd_mct) ' @@ -650,6 +847,20 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, do_l2x, do_x2l) index_l2x_Flrl_rofsub = mct_aVect_indexRA(l2x_l,'Flrl_rofsub') index_l2x_Flrl_rofdto = mct_aVect_indexRA(l2x_l,'Flrl_rofdto') index_l2x_Flrl_rofi = mct_aVect_indexRA(l2x_l,'Flrl_rofi') + + index_l2x_Fall_evap_16O = mct_aVect_indexRA(l2x_l,'Fall_evap_16O',perrWith='quiet') + if ( index_l2x_Fall_evap_16O /= 0 ) flds_wiso_lnd = .true. + if ( flds_wiso_lnd )then + flds_wiso = .true. + index_l2x_Fall_evap_18O = mct_aVect_indexRA(l2x_l,'Fall_evap_18O') + index_l2x_Fall_evap_HDO = mct_aVect_indexRA(l2x_l,'Fall_evap_HDO') + index_l2x_Flrl_rofl_16O = mct_aVect_indexRA(l2x_l,'Flrl_rofl_16O') + index_l2x_Flrl_rofl_18O = mct_aVect_indexRA(l2x_l,'Flrl_rofl_18O') + index_l2x_Flrl_rofl_HDO = mct_aVect_indexRA(l2x_l,'Flrl_rofl_HDO') + index_l2x_Flrl_rofi_16O = mct_aVect_indexRA(l2x_l,'Flrl_rofi_16O') + index_l2x_Flrl_rofi_18O = mct_aVect_indexRA(l2x_l,'Flrl_rofi_18O') + index_l2x_Flrl_rofi_HDO = mct_aVect_indexRA(l2x_l,'Flrl_rofi_HDO') + end if end if lSize = mct_avect_lSize(l2x_l) @@ -667,6 +878,38 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, do_l2x, do_x2l) - dl*l2x_l%rAttr(index_l2x_Flrl_rofsub,n) & - dl*l2x_l%rAttr(index_l2x_Flrl_rofdto,n) if = f_wioff ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - dl*l2x_l%rAttr(index_l2x_Flrl_rofi,n) + + if ( flds_wiso_lnd )then + if = f_wevap_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*l2x_l%rAttr(index_l2x_Fall_evap_16O,n) + if = f_wevap_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*l2x_l%rAttr(index_l2x_Fall_evap_18O,n) + if = f_wevap_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*l2x_l%rAttr(index_l2x_Fall_evap_HDO,n) + + if = f_wroff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofl_16O,n) + if = f_wroff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofl_18O,n) + if = f_wroff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofl_HDO,n) + + if = f_wioff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofi_16O,n) + if = f_wioff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofi_18O,n) + if = f_wioff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*l2x_l%rAttr(index_l2x_Flrl_rofi_HDO,n) + end if end do budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice end if @@ -679,6 +922,24 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, do_l2x, do_x2l) index_x2l_Faxa_snowc = mct_aVect_indexRA(x2l_l,'Faxa_snowc') index_x2l_Faxa_snowl = mct_aVect_indexRA(x2l_l,'Faxa_snowl') index_x2l_Flrr_flood = mct_aVect_indexRA(x2l_l,'Flrr_flood') + + if ( flds_wiso_lnd )then + index_x2l_Faxa_rainc_16O = mct_aVect_indexRA(x2l_l,'Faxa_rainc_16O') + index_x2l_Faxa_rainc_18O = mct_aVect_indexRA(x2l_l,'Faxa_rainc_18O') + index_x2l_Faxa_rainc_HDO = mct_aVect_indexRA(x2l_l,'Faxa_rainc_HDO') + index_x2l_Faxa_rainl_16O = mct_aVect_indexRA(x2l_l,'Faxa_rainl_16O') + index_x2l_Faxa_rainl_18O = mct_aVect_indexRA(x2l_l,'Faxa_rainl_18O') + index_x2l_Faxa_rainl_HDO = mct_aVect_indexRA(x2l_l,'Faxa_rainl_HDO') + index_x2l_Faxa_snowc_16O = mct_aVect_indexRA(x2l_l,'Faxa_snowc_16O') + index_x2l_Faxa_snowc_18O = mct_aVect_indexRA(x2l_l,'Faxa_snowc_18O') + index_x2l_Faxa_snowc_HDO = mct_aVect_indexRA(x2l_l,'Faxa_snowc_HDO') + index_x2l_Faxa_snowl_16O = mct_aVect_indexRA(x2l_l,'Faxa_snowl_16O') + index_x2l_Faxa_snowl_18O = mct_aVect_indexRA(x2l_l,'Faxa_snowl_18O') + index_x2l_Faxa_snowl_HDO = mct_aVect_indexRA(x2l_l,'Faxa_snowl_HDO') + index_x2l_Flrr_flood_16O = mct_aVect_indexRA(x2l_l,'Flrr_flood_16O') + index_x2l_Flrr_flood_18O = mct_aVect_indexRA(x2l_l,'Flrr_flood_18O') + index_x2l_Flrr_flood_HDO = mct_aVect_indexRA(x2l_l,'Flrr_flood_HDO') + end if end if lSize = mct_avect_lSize(x2l_l) @@ -692,6 +953,44 @@ subroutine seq_diag_lnd_mct( lnd, frac_l, do_l2x, do_x2l) if = f_wsnow; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + dl*x2l_l%rAttr(index_x2l_Faxa_snowc,n) & + dl*x2l_l%rAttr(index_x2l_Faxa_snowl,n) if = f_wroff; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - dl*x2l_l%rAttr(index_x2l_Flrr_flood,n) + + if ( flds_wiso_lnd )then + if = f_wrain_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainc_16O,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainl_16O,n) + if = f_wrain_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainc_18O,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainl_18O,n) + if = f_wrain_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainc_HDO,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_rainl_HDO,n) + + if = f_wsnow_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowc_16O,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowl_16O,n) + if = f_wsnow_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowc_18O,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowl_18O,n) + if = f_wsnow_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowc_HDO,n) + & + dl*x2l_l%rAttr(index_x2l_Faxa_snowl_HDO,n) + + if = f_wroff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*x2l_l%rAttr(index_x2l_Flrr_flood_16O,n) + if = f_wroff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*x2l_l%rAttr(index_x2l_Flrr_flood_18O,n) + if = f_wroff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dl*x2l_l%rAttr(index_x2l_Flrr_flood_HDO,n) + end if end do budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice end if @@ -730,7 +1029,8 @@ subroutine seq_diag_rof_mct( rof, frac_r) integer(in) :: kl,ka,ko,ki,kr ! fraction indices integer(in) :: lSize ! size of aVect real(r8) :: da,di,do,dl,dr ! area of a grid cell - logical,save :: first_time = .true. + logical,save :: first_time = .true. + logical,save :: flds_wiso_rof = .false. !----- formats ----- character(*),parameter :: subName = '(seq_diag_rof_mct) ' @@ -753,6 +1053,17 @@ subroutine seq_diag_rof_mct( rof, frac_r) index_x2r_Flrl_rofsub = mct_aVect_indexRA(x2r_r,'Flrl_rofsub') index_x2r_Flrl_rofdto = mct_aVect_indexRA(x2r_r,'Flrl_rofdto') index_x2r_Flrl_rofi = mct_aVect_indexRA(x2r_r,'Flrl_rofi') + + index_x2r_Flrl_rofl_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_16O', perrWith='quiet') + if ( index_x2r_Flrl_rofl_16O /= 0 ) flds_wiso_rof = .true. + if ( flds_wiso_rof )then + flds_wiso = .true. + index_x2r_Flrl_rofl_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofl_18O') + index_x2r_Flrl_rofl_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofl_HDO') + index_x2r_Flrl_rofi_16O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_16O') + index_x2r_Flrl_rofi_18O = mct_aVect_indexRA(x2r_r,'Flrl_rofi_18O') + index_x2r_Flrl_rofi_HDO = mct_aVect_indexRA(x2r_r,'Flrl_rofi_HDO') + end if end if ip = p_inst @@ -766,6 +1077,28 @@ subroutine seq_diag_rof_mct( rof, frac_r) + dr*x2r_r%rAttr(index_x2r_Flrl_rofsub,n) & + dr*x2r_r%rAttr(index_x2r_Flrl_rofdto,n) if = f_wioff; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + dr*x2r_r%rAttr(index_x2r_Flrl_rofi,n) + + if ( flds_wiso_rof )then + if = f_wroff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofl_16O,n) + if = f_wroff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofl_18O,n) + if = f_wroff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofl_HDO,n) + + if = f_wioff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofi_16O,n) + if = f_wioff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofi_18O,n) + if = f_wioff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*x2r_r%rAttr(index_x2r_Flrl_rofi_HDO,n) + end if end do budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice @@ -774,6 +1107,18 @@ subroutine seq_diag_rof_mct( rof, frac_r) index_r2x_Forr_rofi = mct_aVect_indexRA(r2x_r,'Forr_rofi') index_r2x_Firr_rofi = mct_aVect_indexRA(r2x_r,'Firr_rofi') index_r2x_Flrr_flood = mct_aVect_indexRA(r2x_r,'Flrr_flood') + + if ( flds_wiso_rof )then + index_r2x_Forr_rofl_16O = mct_aVect_indexRA(r2x_r,'Forr_rofl_16O') + index_r2x_Forr_rofl_18O = mct_aVect_indexRA(r2x_r,'Forr_rofl_18O') + index_r2x_Forr_rofl_HDO = mct_aVect_indexRA(r2x_r,'Forr_rofl_HDO') + index_r2x_Forr_rofi_16O = mct_aVect_indexRA(r2x_r,'Forr_rofi_16O') + index_r2x_Forr_rofi_18O = mct_aVect_indexRA(r2x_r,'Forr_rofi_18O') + index_r2x_Forr_rofi_HDO = mct_aVect_indexRA(r2x_r,'Forr_rofi_HDO') + index_r2x_Flrr_flood_16O = mct_aVect_indexRA(r2x_r,'Flrr_flood_16O') + index_r2x_Flrr_flood_18O = mct_aVect_indexRA(r2x_r,'Flrr_flood_18O') + index_r2x_Flrr_flood_HDO = mct_aVect_indexRA(r2x_r,'Flrr_flood_HDO') + end if end if ip = p_inst @@ -786,6 +1131,38 @@ subroutine seq_diag_rof_mct( rof, frac_r) + dr*r2x_r%rAttr(index_r2x_Flrr_flood,n) if = f_wioff; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - dr*r2x_r%rAttr(index_r2x_Forr_rofi,n) & - dr*r2x_r%rAttr(index_r2x_Firr_rofi,n) + + if ( flds_wiso_rof )then + if = f_wroff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofl_16O,n) + if = f_wroff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofl_18O,n) + if = f_wroff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofl_HDO,n) + + if = f_wioff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofi_16O,n) + if = f_wioff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofi_18O,n) + if = f_wioff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + dr*r2x_r%rAttr(index_r2x_Forr_rofi_HDO,n) + + if = f_wroff_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*r2x_r%rAttr(index_r2x_Flrr_flood_16O,n) + if = f_wroff_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*r2x_r%rAttr(index_r2x_Flrr_flood_18O,n) + if = f_wroff_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + dr*r2x_r%rAttr(index_r2x_Flrr_flood_HDO,n) + end if end do budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice @@ -895,7 +1272,8 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) integer(in) :: kl,ka,ko,ki ! fraction indices integer(in) :: lSize ! size of aVect real(r8) :: da,di,do,dl ! area of a grid cell - logical,save :: first_time = .true. + logical,save :: first_time = .true. + logical,save :: flds_wiso_ocn = .false. !----- formats ----- character(*),parameter :: subName = '(seq_diag_ocn_mct) ' @@ -926,7 +1304,8 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) if (present(do_o2x)) then if (first_time) then - index_o2x_Fioo_frazil = mct_aVect_indexRA(o2x_o,'Fioo_frazil') + index_o2x_Fioo_frazil = mct_aVect_indexRA(o2x_o,'Fioo_frazil') !acme + index_o2x_Fioo_q = mct_aVect_indexRA(o2x_o,'Fioo_q') !cesm end if lSize = mct_avect_lSize(o2x_o) @@ -935,18 +1314,33 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) do = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ko,n) di = dom_o%data%rAttr(kArea,n) * frac_o%rAttr(ki,n) if = f_area; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + do - if = f_hfrz; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_frazil,n)) + if (index_o2x_Fioo_frazil /= 0) then + if = f_hfrz; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_frazil,n)) + else if (index_o2x_Fioo_q /= 0) then + if = f_hfrz; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*max(0.0_r8,o2x_o%rAttr(index_o2x_Fioo_q,n)) + end if end do - budg_dataL(f_wfrz,ic,ip) = budg_dataL(f_hfrz,ic,ip) * HFLXtoWFLX & - * shr_const_rhoice * shr_const_latice + if (index_o2x_Fioo_frazil /= 0) then + budg_dataL(f_wfrz,ic,ip) = budg_dataL(f_hfrz,ic,ip) * HFLXtoWFLX * shr_const_rhoice * shr_const_latice + else if (index_o2x_Fioo_q /= 0) then + budg_dataL(f_wfrz,ic,ip) = budg_dataL(f_hfrz,ic,ip) * HFLXtoWFLX + end if end if if (present(do_xao)) then if (first_time) then - index_xao_Faox_lwup = mct_aVect_indexRA(xao_o,'Faox_lwup') - index_xao_Faox_lat = mct_aVect_indexRA(xao_o,'Faox_lat') - index_xao_Faox_sen = mct_aVect_indexRA(xao_o,'Faox_sen') - index_xao_Faox_evap = mct_aVect_indexRA(xao_o,'Faox_evap') + index_xao_Faox_lwup = mct_aVect_indexRA(xao_o,'Faox_lwup') + index_xao_Faox_lat = mct_aVect_indexRA(xao_o,'Faox_lat') + index_xao_Faox_sen = mct_aVect_indexRA(xao_o,'Faox_sen') + index_xao_Faox_evap = mct_aVect_indexRA(xao_o,'Faox_evap') + + index_xao_Faox_evap_16O = mct_aVect_indexRA(xao_o,'Faox_evap_16O',perrWith='quiet') + if ( index_xao_Faox_evap_16O /= 0 ) flds_wiso_ocn = .true. + if ( flds_wiso_ocn )then + flds_wiso = .true. + index_xao_Faox_evap_18O = mct_aVect_indexRA(xao_o,'Faox_evap_18O') + index_xao_Faox_evap_HDO = mct_aVect_indexRA(xao_o,'Faox_evap_HDO') + end if end if lSize = mct_avect_lSize(xao_o) @@ -957,6 +1351,19 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) if = f_hlatv; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + do*xao_o%rAttr(index_xao_Faox_lat,n) if = f_hsen ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + do*xao_o%rAttr(index_xao_Faox_sen,n) if = f_wevap; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + do*xao_o%rAttr(index_xao_Faox_evap,n) + + if ( flds_wiso_ocn )then + if = f_wevap_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + do*xao_o%rAttr(index_xao_Faox_evap_16O,n) + if = f_wevap_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + do*xao_o%rAttr(index_xao_Faox_evap_18O,n) + if = f_wevap_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + do*xao_o%rAttr(index_xao_Faox_evap_HDO,n) + end if + end do end if @@ -974,6 +1381,25 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) index_x2o_Foxx_evap = mct_aVect_indexRA(x2o_o,'Foxx_evap') index_x2o_Foxx_rofl = mct_aVect_indexRA(x2o_o,'Foxx_rofl') index_x2o_Foxx_rofi = mct_aVect_indexRA(x2o_o,'Foxx_rofi') + + if ( flds_wiso_ocn )then + index_x2o_Fioi_meltw_16O = mct_aVect_indexRA(x2o_o,'Fioi_meltw_16O') + index_x2o_Fioi_meltw_18O = mct_aVect_indexRA(x2o_o,'Fioi_meltw_18O') + index_x2o_Fioi_meltw_HDO = mct_aVect_indexRA(x2o_o,'Fioi_meltw_HDO') + index_x2o_Faxa_rain_16O = mct_aVect_indexRA(x2o_o,'Faxa_rain_16O') + index_x2o_Faxa_rain_18O = mct_aVect_indexRA(x2o_o,'Faxa_rain_18O') + index_x2o_Faxa_rain_HDO = mct_aVect_indexRA(x2o_o,'Faxa_rain_HDO') + index_x2o_Faxa_snow_16O = mct_aVect_indexRA(x2o_o,'Faxa_snow_16O') + index_x2o_Faxa_snow_18O = mct_aVect_indexRA(x2o_o,'Faxa_snow_18O') + index_x2o_Faxa_snow_HDO = mct_aVect_indexRA(x2o_o,'Faxa_snow_HDO') + + index_x2o_Foxx_rofl_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_16O') + index_x2o_Foxx_rofi_16O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_16O') + index_x2o_Foxx_rofl_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofl_18O') + index_x2o_Foxx_rofi_18O = mct_aVect_indexRA(x2o_o,'Foxx_rofi_18O') + index_x2o_Foxx_rofl_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofl_HDO') + index_x2o_Foxx_rofi_HDO = mct_aVect_indexRA(x2o_o,'Foxx_rofi_HDO') + end if end if if (.not. present(do_xao)) then @@ -1005,11 +1431,57 @@ subroutine seq_diag_ocn_mct( ocn, xao_o, frac_o, do_o2x, do_x2o, do_xao) if = f_wsnow ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Faxa_snow,n) if = f_wroff ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofl,n) if = f_wioff ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofi,n) + + if ( flds_wiso_ocn )then + if = f_wmelt_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Fioi_meltw_16O,n) + if = f_wmelt_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Fioi_meltw_18O,n) + if = f_wmelt_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Fioi_meltw_HDO,n) + + if = f_wrain_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_rain_16O,n) + if = f_wrain_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_rain_18O,n) + if = f_wrain_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_rain_HDO,n) + + if = f_wsnow_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_snow_16O,n) + if = f_wsnow_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_snow_18O,n) + if = f_wsnow_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + (do+di)*x2o_o%rAttr(index_x2o_Faxa_snow_HDO,n) + if = f_wroff_16O ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofl_16O,n) + if = f_wioff_16O ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofi_16O,n) + if = f_wroff_18O ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofl_18O,n) + if = f_wioff_18O ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofi_18O,n) + if = f_wroff_HDO ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofl_HDO,n) + if = f_wioff_HDO ; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + (do+di)*x2o_o%rAttr(index_x2o_Foxx_rofi_HDO,n) + end if end do budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice end if + ! EBK -- isotope r2x_Forr_rofl/i? + first_time = .false. end subroutine seq_diag_ocn_mct @@ -1046,7 +1518,9 @@ subroutine seq_diag_ice_mct( ice, frac_i, do_i2x, do_x2i) integer(in) :: kl,ka,ko,ki ! fraction indices integer(in) :: lSize ! size of aVect real(r8) :: da,di,do,dl ! area of a grid cell - logical,save :: first_time = .true. + logical,save :: first_time = .true. + logical,save :: flds_wiso_ice = .false. + logical,save :: flds_wiso_ice_x2i = .false. !----- formats ----- character(*),parameter :: subName = '(seq_diag_ice_mct) ' @@ -1071,14 +1545,25 @@ subroutine seq_diag_ice_mct( ice, frac_i, do_i2x, do_x2i) ko = mct_aVect_indexRA(frac_i,ofracname) if (present(do_i2x)) then - index_i2x_Fioi_melth = mct_aVect_indexRA(i2x_i,'Fioi_melth') - index_i2x_Fioi_meltw = mct_aVect_indexRA(i2x_i,'Fioi_meltw') - index_i2x_Fioi_swpen = mct_aVect_indexRA(i2x_i,'Fioi_swpen') - index_i2x_Faii_swnet = mct_aVect_indexRA(i2x_i,'Faii_swnet') - index_i2x_Faii_lwup = mct_aVect_indexRA(i2x_i,'Faii_lwup') - index_i2x_Faii_lat = mct_aVect_indexRA(i2x_i,'Faii_lat') - index_i2x_Faii_sen = mct_aVect_indexRA(i2x_i,'Faii_sen') - index_i2x_Faii_evap = mct_aVect_indexRA(i2x_i,'Faii_evap') + index_i2x_Fioi_melth = mct_aVect_indexRA(i2x_i,'Fioi_melth') + index_i2x_Fioi_meltw = mct_aVect_indexRA(i2x_i,'Fioi_meltw') + index_i2x_Fioi_swpen = mct_aVect_indexRA(i2x_i,'Fioi_swpen') + index_i2x_Faii_swnet = mct_aVect_indexRA(i2x_i,'Faii_swnet') + index_i2x_Faii_lwup = mct_aVect_indexRA(i2x_i,'Faii_lwup') + index_i2x_Faii_lat = mct_aVect_indexRA(i2x_i,'Faii_lat') + index_i2x_Faii_sen = mct_aVect_indexRA(i2x_i,'Faii_sen') + index_i2x_Faii_evap = mct_aVect_indexRA(i2x_i,'Faii_evap') + + index_i2x_Fioi_meltw_16O = mct_aVect_indexRA(i2x_i,'Fioi_meltw_16O',perrWith='quiet') + if ( index_i2x_Fioi_meltw_16O /= 0 ) flds_wiso_ice = .true. + if ( flds_wiso_ice )then + flds_wiso = .true. + index_i2x_Fioi_meltw_18O = mct_aVect_indexRA(i2x_i,'Fioi_meltw_18O') + index_i2x_Fioi_meltw_HDO = mct_aVect_indexRA(i2x_i,'Fioi_meltw_HDO') + index_i2x_Faii_evap_16O = mct_aVect_indexRA(i2x_i,'Faii_evap_16O') + index_i2x_Faii_evap_18O = mct_aVect_indexRA(i2x_i,'Faii_evap_18O') + index_i2x_Faii_evap_HDO = mct_aVect_indexRA(i2x_i,'Faii_evap_HDO') + end if lSize = mct_avect_lSize(i2x_i) do n=1,lSize @@ -1098,6 +1583,28 @@ subroutine seq_diag_ice_mct( ice, frac_i, do_i2x, do_x2i) if = f_hlatv ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*i2x_i%rAttr(index_i2x_Faii_lat,n) if = f_hsen ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*i2x_i%rAttr(index_i2x_Faii_sen,n) if = f_wevap ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*i2x_i%rAttr(index_i2x_Faii_evap,n) + + if ( flds_wiso_ice )then + if = f_wmelt_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + di*i2x_i%rAttr(index_i2x_Fioi_meltw_16O,n) + if = f_wmelt_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + di*i2x_i%rAttr(index_i2x_Fioi_meltw_18O,n) + if = f_wmelt_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - & + di*i2x_i%rAttr(index_i2x_Fioi_meltw_HDO,n) + + if = f_wevap_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*i2x_i%rAttr(index_i2x_Faii_evap_16O,n) + if = f_wevap_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*i2x_i%rAttr(index_i2x_Faii_evap_18O,n) + if = f_wevap_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*i2x_i%rAttr(index_i2x_Faii_evap_HDO,n) + end if end do end if @@ -1106,8 +1613,20 @@ subroutine seq_diag_ice_mct( ice, frac_i, do_i2x, do_x2i) index_x2i_Faxa_lwdn = mct_aVect_indexRA(x2i_i,'Faxa_lwdn') index_x2i_Faxa_rain = mct_aVect_indexRA(x2i_i,'Faxa_rain') index_x2i_Faxa_snow = mct_aVect_indexRA(x2i_i,'Faxa_snow') - index_x2i_Fioo_frazil = mct_aVect_indexRA(x2i_i,'Fioo_frazil') + index_x2i_Fioo_frazil = mct_aVect_indexRA(x2i_i,'Fioo_frazil') !acme + index_x2i_Fioo_q = mct_aVect_indexRA(x2i_i,'Fioo_q') !cesm index_x2i_Fixx_rofi = mct_aVect_indexRA(x2i_i,'Fixx_rofi') + + index_x2i_Faxa_rain_16O = mct_aVect_indexRA(x2i_i,'Faxa_rain_16O', perrWith='quiet') + if ( index_x2i_Faxa_rain_16O /= 0 ) flds_wiso_ice_x2i = .true. + if ( flds_wiso_ice_x2i )then + flds_wiso = .true. + index_x2i_Faxa_rain_18O = mct_aVect_indexRA(x2i_i,'Faxa_rain_18O') + index_x2i_Faxa_rain_HDO = mct_aVect_indexRA(x2i_i,'Faxa_rain_HDO') + index_x2i_Faxa_snow_16O = mct_aVect_indexRA(x2i_i,'Faxa_snow_16O') + index_x2i_Faxa_snow_18O = mct_aVect_indexRA(x2i_i,'Faxa_snow_18O') + index_x2i_Faxa_snow_HDO = mct_aVect_indexRA(x2i_i,'Faxa_snow_HDO') + end if end if lSize = mct_avect_lSize(x2i_i) @@ -1124,18 +1643,51 @@ subroutine seq_diag_ice_mct( ice, frac_i, do_i2x, do_x2i) if = f_wrain; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*x2i_i%rAttr(index_x2i_Faxa_rain,n) if = f_wsnow; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*x2i_i%rAttr(index_x2i_Faxa_snow,n) if = f_wioff; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + di*x2i_i%rAttr(index_x2i_Fixx_rofi,n) - if = f_hfrz ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - (do+di)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_frazil,n)) + + if (index_o2x_Fioo_frazil /= 0) then + if = f_hfrz ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - (do+di)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_frazil,n)) + else if (index_o2x_Fioo_q /= 0) then + if = f_hfrz ; budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) - (do+di)*max(0.0_r8,x2i_i%rAttr(index_x2i_Fioo_q,n)) + end if + if ( flds_wiso_ice_x2i )then + if = f_wrain_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_rain_16O,n) + if = f_wrain_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_rain_18O,n) + if = f_wrain_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_rain_HDO,n) + + if = f_wsnow_16O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_snow_16O,n) + if = f_wsnow_18O; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_snow_18O,n) + if = f_wsnow_HDO; + budg_dataL(if,ic,ip) = budg_dataL(if,ic,ip) + & + di*x2i_i%rAttr(index_x2i_Faxa_snow_HDO,n) + end if end do ic = c_inh_is budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX & - * shr_const_rhoice * shr_const_latice + if (index_o2x_Fioo_frazil /= 0) then + budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX * shr_const_rhoice * shr_const_latice + else if (index_o2x_Fioo_q /= 0) then + budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX + end if + ic = c_ish_is budg_dataL(f_hlatf,ic,ip) = -budg_dataL(f_wsnow,ic,ip)*shr_const_latice budg_dataL(f_hioff,ic,ip) = -budg_dataL(f_wioff,ic,ip)*shr_const_latice - budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX & - * shr_const_rhoice * shr_const_latice + if (index_o2x_Fioo_frazil /= 0) then + budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX * shr_const_rhoice * shr_const_latice + else if (index_o2x_Fioo_q /= 0) then + budg_dataL(f_wfrz ,ic,ip) = budg_dataL(f_hfrz ,ic,ip)*HFLXtoWFLX + end if end if first_time = .false. @@ -1174,7 +1726,7 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & !EOP !--- local --- - integer(in) :: ic,if,ip ! data array indicies + integer(in) :: ic,if,ip,is ! data array indicies integer(in) :: ica,icl,icn,ics,ico integer(in) :: icar,icxs,icxr,icas integer(in) :: n ! loop counter @@ -1186,6 +1738,10 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & logical :: sumdone ! has a sum been computed yet character(len=40):: str ! string real(r8) :: dataGpr (f_size,c_size,p_size) ! values to print, scaled and such + integer, parameter :: nisotopes = 3 + character(len=5), parameter :: isoname(nisotopes) = (/ 'H216O', 'H218O', ' HDO' /) + integer, parameter :: iso0(nisotopes) = (/ f_16O, f_18O, f_hdO /) + integer, parameter :: isof(nisotopes) = (/ f_16O_end, f_18O_end, f_hdO_end /) !----- formats ----- character(*),parameter :: subName = '(seq_diag_print_mct) ' @@ -1193,10 +1749,10 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & !----- formats ----- character(*),parameter :: FAH="(4a,i9,i6)" - character(*),parameter :: FA0= "(' ',8x,6(6x,a8,1x))" - character(*),parameter :: FA1= "(' ',a8,6f15.8)" - character(*),parameter :: FA0r="(' ',8x,8(6x,a8,1x))" - character(*),parameter :: FA1r="(' ',a8,8f15.8)" + character(*),parameter :: FA0= "(' ',12x,6(6x,a8,1x))" + character(*),parameter :: FA1= "(' ',a12,6f15.8)" + character(*),parameter :: FA0r="(' ',12x,8(6x,a8,1x))" + character(*),parameter :: FA1r="(' ',a12,8f15.8)" !------------------------------------------------------------------------------- ! print instantaneous budget data @@ -1239,7 +1795,10 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & ! old budget normalizations (global area and 1e6 for water) dataGpr = dataGpr/(4.0_r8*shr_const_pi) - dataGpr(f_w:f_size,:,:) = dataGpr(f_w:f_size,:,:) * 1.0e6_r8 + dataGpr(f_w:f_w_end,:,:) = dataGpr(f_w:f_w_end,:,:) * 1.0e6_r8 + if ( flds_wiso )then + dataGpr(iso0(1):isof(nisotopes),:,:) = dataGpr(iso0(1):isof(nisotopes),:,:) * 1.0e6_r8 + end if dataGpr = dataGpr/budg_ns if (iam /= 0) return @@ -1272,40 +1831,62 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,*) ' ' write(logunit,FAH) subname,trim(str)//' AREA BUDGET (m2/m2): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' - do if = f_a, f_h-1 + do if = f_a, f_a_end write(logunit,FA1) fname(if),dataGpr(if,ica,ip),dataGpr(if,icl,ip), & dataGpr(if,icn,ip),dataGpr(if,ics,ip),dataGpr(if,ico,ip), & - dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & + dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & dataGpr(if,icn,ip)+dataGpr(if,ics,ip)+dataGpr(if,ico,ip) enddo write(logunit,*) ' ' write(logunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' - do if = f_h, f_w-1 + do if = f_h, f_h_end write(logunit,FA1) fname(if),dataGpr(if,ica,ip),dataGpr(if,icl,ip), & dataGpr(if,icn,ip),dataGpr(if,ics,ip),dataGpr(if,ico,ip), & - dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & - dataGpr(if,icn,ip)+dataGpr(if,ics,ip)+dataGpr(if,ico,ip) + dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & + dataGpr(if,icn,ip)+dataGpr(if,ics,ip)+dataGpr(if,ico,ip) enddo - write(logunit,FA1) ' *SUM*',sum(dataGpr(f_h:f_w-1,ica,ip)),sum(dataGpr(f_h:f_w-1,icl,ip)), & - sum(dataGpr(f_h:f_w-1,icn,ip)),sum(dataGpr(f_h:f_w-1,ics,ip)),sum(dataGpr(f_h:f_w-1,ico,ip)), & - sum(dataGpr(f_h:f_w-1,ica,ip))+sum(dataGpr(f_h:f_w-1,icl,ip))+ & - sum(dataGpr(f_h:f_w-1,icn,ip))+sum(dataGpr(f_h:f_w-1,ics,ip))+sum(dataGpr(f_h:f_w-1,ico,ip)) + write(logunit,FA1) ' *SUM*' ,sum(dataGpr(f_h:f_h_end,ica,ip)),sum(dataGpr(f_h:f_h_end,icl,ip)), & + sum(dataGpr(f_h:f_h_end,icn,ip)),sum(dataGpr(f_h:f_h_end,ics,ip)),sum(dataGpr(f_h:f_h_end,ico,ip)), & + sum(dataGpr(f_h:f_h_end,ica,ip))+sum(dataGpr(f_h:f_h_end,icl,ip))+ & + sum(dataGpr(f_h:f_h_end,icn,ip))+sum(dataGpr(f_h:f_h_end,ics,ip))+sum(dataGpr(f_h:f_h_end,ico,ip)) write(logunit,*) ' ' write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' - do if = f_w, f_size + do if = f_w, f_w_end write(logunit,FA1) fname(if),dataGpr(if,ica,ip),dataGpr(if,icl,ip), & dataGpr(if,icn,ip),dataGpr(if,ics,ip),dataGpr(if,ico,ip), & - dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & + dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & dataGpr(if,icn,ip)+dataGpr(if,ics,ip)+dataGpr(if,ico,ip) enddo - write(logunit,FA1) ' *SUM*',sum(dataGpr(f_w:f_size,ica,ip)),sum(dataGpr(f_w:f_size,icl,ip)), & - sum(dataGpr(f_w:f_size,icn,ip)),sum(dataGpr(f_w:f_size,ics,ip)),sum(dataGpr(f_w:f_size,ico,ip)), & - sum(dataGpr(f_w:f_size,ica,ip))+sum(dataGpr(f_w:f_size,icl,ip))+ & - sum(dataGpr(f_w:f_size,icn,ip))+sum(dataGpr(f_w:f_size,ics,ip))+sum(dataGpr(f_w:f_size,ico,ip)) + write(logunit,FA1) ' *SUM*' ,sum(dataGpr(f_w:f_w_end,ica,ip)),sum(dataGpr(f_w:f_w_end,icl,ip)), & + sum(dataGpr(f_w:f_w_end,icn,ip)),sum(dataGpr(f_w:f_w_end,ics,ip)),sum(dataGpr(f_w:f_w_end,ico,ip)), & + sum(dataGpr(f_w:f_w_end,ica,ip))+sum(dataGpr(f_w:f_w_end,icl,ip))+ & + sum(dataGpr(f_w:f_w_end,icn,ip))+sum(dataGpr(f_w:f_w_end,ics,ip))+sum(dataGpr(f_w:f_w_end,ico,ip)) + + if ( flds_wiso )then + do is = 1, nisotopes + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & + trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0) cname(ica),cname(icl),cname(icn),cname(ics),cname(ico),' *SUM* ' + do if = iso0(is), isof(is) + write(logunit,FA1) fname(if),dataGpr(if,ica,ip),dataGpr(if,icl,ip), & + dataGpr(if,icn,ip),dataGpr(if,ics,ip),dataGpr(if,ico,ip), & + dataGpr(if,ica,ip)+dataGpr(if,icl,ip)+ & + dataGpr(if,icn,ip)+dataGpr(if,ics,ip)+dataGpr(if,ico,ip) + enddo + write(logunit,FA1) ' *SUM*', sum(dataGpr(iso0(is):isof(is),ica,ip)),sum(dataGpr(iso0(is):isof(is),icl,ip)), & + sum(dataGpr(iso0(is):isof(is),icn,ip)),sum(dataGpr(iso0(is):isof(is),ics,ip)), & + sum(dataGpr(iso0(is):isof(is),ico,ip)), & + sum(dataGpr(iso0(is):isof(is),ica,ip))+sum(dataGpr(iso0(is):isof(is),icl,ip))+ & + sum(dataGpr(iso0(is):isof(is),icn,ip))+sum(dataGpr(iso0(is):isof(is),ics,ip))+ & + sum(dataGpr(iso0(is):isof(is),ico,ip)) + end do + end if + enddo endif ! plev @@ -1346,31 +1927,76 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,*) ' ' write(logunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' - do if = f_h, f_w-1 + do if = f_h, f_h_end write(logunit,FA1) fname(if),-dataGpr(if,icar,ip),dataGpr(if,icxs,ip), & dataGpr(if,icxr,ip),-dataGpr(if,icas,ip), & -dataGpr(if,icar,ip)+dataGpr(if,icxs,ip)+ & dataGpr(if,icxr,ip)-dataGpr(if,icas,ip) enddo - write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_h:f_w-1,icar,ip)),sum(dataGpr(f_h:f_w-1,icxs,ip)), & - sum(dataGpr(f_h:f_w-1,icxr,ip)),-sum(dataGpr(f_h:f_w-1,icas,ip)), & - -sum(dataGpr(f_h:f_w-1,icar,ip))+sum(dataGpr(f_h:f_w-1,icxs,ip))+ & - sum(dataGpr(f_h:f_w-1,icxr,ip))-sum(dataGpr(f_h:f_w-1,icas,ip)) + write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_h:f_h_end,icar,ip)),sum(dataGpr(f_h:f_h_end,icxs,ip)), & + sum(dataGpr(f_h:f_h_end,icxr,ip)),-sum(dataGpr(f_h:f_h_end,icas,ip)), & + -sum(dataGpr(f_h:f_h_end,icar,ip))+sum(dataGpr(f_h:f_h_end,icxs,ip))+ & + sum(dataGpr(f_h:f_h_end,icxr,ip))-sum(dataGpr(f_h:f_h_end,icas,ip)) write(logunit,*) ' ' write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' - do if = f_w, f_size + do if = f_w, f_w_end write(logunit,FA1) fname(if),-dataGpr(if,icar,ip),dataGpr(if,icxs,ip), & dataGpr(if,icxr,ip),-dataGpr(if,icas,ip), & -dataGpr(if,icar,ip)+dataGpr(if,icxs,ip)+ & dataGpr(if,icxr,ip)-dataGpr(if,icas,ip) enddo - write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_w:f_size,icar,ip)),sum(dataGpr(f_w:f_size,icxs,ip)), & - sum(dataGpr(f_w:f_size,icxr,ip)),-sum(dataGpr(f_w:f_size,icas,ip)), & - -sum(dataGpr(f_w:f_size,icar,ip))+sum(dataGpr(f_w:f_size,icxs,ip))+ & - sum(dataGpr(f_w:f_size,icxr,ip))-sum(dataGpr(f_w:f_size,icas,ip)) - + write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_w:f_w_end,icar,ip)),sum(dataGpr(f_w:f_w_end,icxs,ip)), & + sum(dataGpr(f_w:f_w_end,icxr,ip)),-sum(dataGpr(f_w:f_w_end,icas,ip)), & + -sum(dataGpr(f_w:f_w_end,icar,ip))+sum(dataGpr(f_w:f_w_end,icxs,ip))+ & + sum(dataGpr(f_w:f_w_end,icxr,ip))-sum(dataGpr(f_w:f_w_end,icas,ip)) + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' + do if = f_w, f_w_end + write(logunit,FA1) fname(if),-dataGpr(if,icar,ip),dataGpr(if,icxs,ip), & + dataGpr(if,icxr,ip),-dataGpr(if,icas,ip), & + -dataGpr(if,icar,ip)+dataGpr(if,icxs,ip)+ & + dataGpr(if,icxr,ip)-dataGpr(if,icas,ip) + enddo + write(logunit,FA1) ' *SUM*',-sum(dataGpr(f_w:f_w_end,icar,ip)),sum(dataGpr(f_w:f_w_end,icxs,ip)), & + sum(dataGpr(f_w:f_w_end,icxr,ip)),-sum(dataGpr(f_w:f_w_end,icas,ip)), & + -sum(dataGpr(f_w:f_w_end,icar,ip))+sum(dataGpr(f_w:f_w_end,icxs,ip))+ & + sum(dataGpr(f_w:f_w_end,icxr,ip))-sum(dataGpr(f_w:f_w_end,icas,ip)) + + if ( flds_wiso ) then + do is = 1, nisotopes + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)), & + ': date = ',cdate,sec + write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' + do if = iso0(is), isof(is) + write(logunit,FA1) fname(if),-dataGpr(if,icar,ip),dataGpr(if,icxs,ip), & + dataGpr(if,icxr,ip),-dataGpr(if,icas,ip), & + -dataGpr(if,icar,ip)+dataGpr(if,icxs,ip)+ & + dataGpr(if,icxr,ip)-dataGpr(if,icas,ip) + enddo + write(logunit,FA1) ' *SUM*',-sum(dataGpr(iso0(is):isof(is),icar,ip)),sum(dataGpr(iso0(is):isof(is),icxs,ip)), & + sum(dataGpr(iso0(is):isof(is),icxr,ip)),-sum(dataGpr(iso0(is):isof(is),icas,ip)), & + -sum(dataGpr(iso0(is):isof(is),icar,ip))+sum(dataGpr(iso0(is):isof(is),icxs,ip))+ & + sum(dataGpr(iso0(is):isof(is),icxr,ip))-sum(dataGpr(iso0(is):isof(is),icas,ip)) + write(logunit,*) ' ' + write(logunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),& + ': date = ',cdate,sec + write(logunit,FA0) cname(icar),cname(icxs),cname(icxr),cname(icas),' *SUM* ' + do if = iso0(is), isof(is) + write(logunit,FA1) fname(if),-dataGpr(if,icar,ip),dataGpr(if,icxs,ip), & + dataGpr(if,icxr,ip),-dataGpr(if,icas,ip), & + -dataGpr(if,icar,ip)+dataGpr(if,icxs,ip)+ & + dataGpr(if,icxr,ip)-dataGpr(if,icas,ip) + enddo + write(logunit,FA1) ' *SUM*',-sum(dataGpr(iso0(is):isof(is),icar,ip)),sum(dataGpr(iso0(is):isof(is),icxs,ip)), & + sum(dataGpr(iso0(is):isof(is),icxr,ip)),-sum(dataGpr(iso0(is):isof(is),icas,ip)), & + -sum(dataGpr(iso0(is):isof(is),icar,ip))+sum(dataGpr(iso0(is):isof(is),icxs,ip))+ & + sum(dataGpr(iso0(is):isof(is),icxr,ip))-sum(dataGpr(iso0(is):isof(is),icas,ip)) + end do + end if enddo endif ! plev @@ -1383,7 +2009,7 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,*) ' ' write(logunit,FAH) subname,'NET AREA BUDGET (m2/m2): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0) ' atm',' lnd',' ocn',' ice nh',' ice sh',' *SUM* ' - do if = 1,f_h-1 + do if = f_a,f_a_end write(logunit,FA1) fname(if),dataGpr(if,c_atm_ar,ip), & dataGpr(if,c_lnd_lr,ip), & dataGpr(if,c_ocn_or,ip), & @@ -1399,7 +2025,7 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & write(logunit,*) ' ' write(logunit,FAH) subname,'NET HEAT BUDGET (W/m2): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' - do if = f_h, f_w-1 + do if = f_h, f_h_end write(logunit,FA1r) fname(if),dataGpr(if,c_atm_ar,ip)+dataGpr(if,c_atm_as,ip), & dataGpr(if,c_lnd_lr,ip)+dataGpr(if,c_lnd_ls,ip), & dataGpr(if,c_rof_rr,ip)+dataGpr(if,c_rof_rs,ip), & @@ -1415,25 +2041,25 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & dataGpr(if,c_ish_ir,ip)+dataGpr(if,c_ish_is,ip)+ & dataGpr(if,c_glc_gr,ip)+dataGpr(if,c_glc_gs,ip) enddo - write(logunit,FA1r)' *SUM*',sum(dataGpr(f_h:f_w-1,c_atm_ar,ip))+sum(dataGpr(f_h:f_w-1,c_atm_as,ip)), & - sum(dataGpr(f_h:f_w-1,c_lnd_lr,ip))+sum(dataGpr(f_h:f_w-1,c_lnd_ls,ip)), & - sum(dataGpr(f_h:f_w-1,c_rof_rr,ip))+sum(dataGpr(f_h:f_w-1,c_rof_rs,ip)), & - sum(dataGpr(f_h:f_w-1,c_ocn_or,ip))+sum(dataGpr(f_h:f_w-1,c_ocn_os,ip)), & - sum(dataGpr(f_h:f_w-1,c_inh_ir,ip))+sum(dataGpr(f_h:f_w-1,c_inh_is,ip)), & - sum(dataGpr(f_h:f_w-1,c_ish_ir,ip))+sum(dataGpr(f_h:f_w-1,c_ish_is,ip)), & - sum(dataGpr(f_h:f_w-1,c_glc_gr,ip))+sum(dataGpr(f_h:f_w-1,c_glc_gs,ip)), & - sum(dataGpr(f_h:f_w-1,c_atm_ar,ip))+sum(dataGpr(f_h:f_w-1,c_atm_as,ip))+ & - sum(dataGpr(f_h:f_w-1,c_lnd_lr,ip))+sum(dataGpr(f_h:f_w-1,c_lnd_ls,ip))+ & - sum(dataGpr(f_h:f_w-1,c_rof_rr,ip))+sum(dataGpr(f_h:f_w-1,c_rof_rs,ip))+ & - sum(dataGpr(f_h:f_w-1,c_ocn_or,ip))+sum(dataGpr(f_h:f_w-1,c_ocn_os,ip))+ & - sum(dataGpr(f_h:f_w-1,c_inh_ir,ip))+sum(dataGpr(f_h:f_w-1,c_inh_is,ip))+ & - sum(dataGpr(f_h:f_w-1,c_ish_ir,ip))+sum(dataGpr(f_h:f_w-1,c_ish_is,ip))+ & - sum(dataGpr(f_h:f_w-1,c_glc_gr,ip))+sum(dataGpr(f_h:f_w-1,c_glc_gs,ip)) + write(logunit,FA1r)' *SUM*',sum(dataGpr(f_h:f_h_end,c_atm_ar,ip))+sum(dataGpr(f_h:f_h_end,c_atm_as,ip)), & + sum(dataGpr(f_h:f_h_end,c_lnd_lr,ip))+sum(dataGpr(f_h:f_h_end,c_lnd_ls,ip)), & + sum(dataGpr(f_h:f_h_end,c_rof_rr,ip))+sum(dataGpr(f_h:f_h_end,c_rof_rs,ip)), & + sum(dataGpr(f_h:f_h_end,c_ocn_or,ip))+sum(dataGpr(f_h:f_h_end,c_ocn_os,ip)), & + sum(dataGpr(f_h:f_h_end,c_inh_ir,ip))+sum(dataGpr(f_h:f_h_end,c_inh_is,ip)), & + sum(dataGpr(f_h:f_h_end,c_ish_ir,ip))+sum(dataGpr(f_h:f_h_end,c_ish_is,ip)), & + sum(dataGpr(f_h:f_h_end,c_glc_gr,ip))+sum(dataGpr(f_h:f_h_end,c_glc_gs,ip)), & + sum(dataGpr(f_h:f_h_end,c_atm_ar,ip))+sum(dataGpr(f_h:f_h_end,c_atm_as,ip))+ & + sum(dataGpr(f_h:f_h_end,c_lnd_lr,ip))+sum(dataGpr(f_h:f_h_end,c_lnd_ls,ip))+ & + sum(dataGpr(f_h:f_h_end,c_rof_rr,ip))+sum(dataGpr(f_h:f_h_end,c_rof_rs,ip))+ & + sum(dataGpr(f_h:f_h_end,c_ocn_or,ip))+sum(dataGpr(f_h:f_h_end,c_ocn_os,ip))+ & + sum(dataGpr(f_h:f_h_end,c_inh_ir,ip))+sum(dataGpr(f_h:f_h_end,c_inh_is,ip))+ & + sum(dataGpr(f_h:f_h_end,c_ish_ir,ip))+sum(dataGpr(f_h:f_h_end,c_ish_is,ip))+ & + sum(dataGpr(f_h:f_h_end,c_glc_gr,ip))+sum(dataGpr(f_h:f_h_end,c_glc_gs,ip)) write(logunit,*) ' ' write(logunit,FAH) subname,'NET WATER BUDGET (kg/m2s*1e6): period = ',trim(pname(ip)),': date = ',cdate,sec write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' - do if = f_w, f_size + do if = f_w, f_w_end write(logunit,FA1r) fname(if),dataGpr(if,c_atm_ar,ip)+dataGpr(if,c_atm_as,ip), & dataGpr(if,c_lnd_lr,ip)+dataGpr(if,c_lnd_ls,ip), & dataGpr(if,c_rof_rr,ip)+dataGpr(if,c_rof_rs,ip), & @@ -1449,20 +2075,60 @@ SUBROUTINE seq_diag_print_mct(EClock, stop_alarm, & dataGpr(if,c_ish_ir,ip)+dataGpr(if,c_ish_is,ip)+ & dataGpr(if,c_glc_gr,ip)+dataGpr(if,c_glc_gs,ip) enddo - write(logunit,FA1r)' *SUM*',sum(dataGpr(f_w:f_size,c_atm_ar,ip))+sum(dataGpr(f_w:f_size,c_atm_as,ip)), & - sum(dataGpr(f_w:f_size,c_lnd_lr,ip))+sum(dataGpr(f_w:f_size,c_lnd_ls,ip)), & - sum(dataGpr(f_w:f_size,c_rof_rr,ip))+sum(dataGpr(f_w:f_size,c_rof_rs,ip)), & - sum(dataGpr(f_w:f_size,c_ocn_or,ip))+sum(dataGpr(f_w:f_size,c_ocn_os,ip)), & - sum(dataGpr(f_w:f_size,c_inh_ir,ip))+sum(dataGpr(f_w:f_size,c_inh_is,ip)), & - sum(dataGpr(f_w:f_size,c_ish_ir,ip))+sum(dataGpr(f_w:f_size,c_ish_is,ip)), & - sum(dataGpr(f_w:f_size,c_glc_gr,ip))+sum(dataGpr(f_w:f_size,c_glc_gs,ip)), & - sum(dataGpr(f_w:f_size,c_atm_ar,ip))+sum(dataGpr(f_w:f_size,c_atm_as,ip))+ & - sum(dataGpr(f_w:f_size,c_lnd_lr,ip))+sum(dataGpr(f_w:f_size,c_lnd_ls,ip))+ & - sum(dataGpr(f_w:f_size,c_rof_rr,ip))+sum(dataGpr(f_w:f_size,c_rof_rs,ip))+ & - sum(dataGpr(f_w:f_size,c_ocn_or,ip))+sum(dataGpr(f_w:f_size,c_ocn_os,ip))+ & - sum(dataGpr(f_w:f_size,c_inh_ir,ip))+sum(dataGpr(f_w:f_size,c_inh_is,ip))+ & - sum(dataGpr(f_w:f_size,c_ish_ir,ip))+sum(dataGpr(f_w:f_size,c_ish_is,ip))+ & - sum(dataGpr(f_w:f_size,c_glc_gr,ip))+sum(dataGpr(f_w:f_size,c_glc_gs,ip)) + write(logunit,FA1r)' *SUM*',sum(dataGpr(f_w:f_w_end,c_atm_ar,ip))+sum(dataGpr(f_w:f_w_end,c_atm_as,ip)), & + sum(dataGpr(f_w:f_w_end,c_lnd_lr,ip))+sum(dataGpr(f_w:f_w_end,c_lnd_ls,ip)), & + sum(dataGpr(f_w:f_w_end,c_rof_rr,ip))+sum(dataGpr(f_w:f_w_end,c_rof_rs,ip)), & + sum(dataGpr(f_w:f_w_end,c_ocn_or,ip))+sum(dataGpr(f_w:f_w_end,c_ocn_os,ip)), & + sum(dataGpr(f_w:f_w_end,c_inh_ir,ip))+sum(dataGpr(f_w:f_w_end,c_inh_is,ip)), & + sum(dataGpr(f_w:f_w_end,c_ish_ir,ip))+sum(dataGpr(f_w:f_w_end,c_ish_is,ip)), & + sum(dataGpr(f_w:f_w_end,c_glc_gr,ip))+sum(dataGpr(f_w:f_w_end,c_glc_gs,ip)), & + sum(dataGpr(f_w:f_w_end,c_atm_ar,ip))+sum(dataGpr(f_w:f_w_end,c_atm_as,ip))+ & + sum(dataGpr(f_w:f_w_end,c_lnd_lr,ip))+sum(dataGpr(f_w:f_w_end,c_lnd_ls,ip))+ & + sum(dataGpr(f_w:f_w_end,c_rof_rr,ip))+sum(dataGpr(f_w:f_w_end,c_rof_rs,ip))+ & + sum(dataGpr(f_w:f_w_end,c_ocn_or,ip))+sum(dataGpr(f_w:f_w_end,c_ocn_os,ip))+ & + sum(dataGpr(f_w:f_w_end,c_inh_ir,ip))+sum(dataGpr(f_w:f_w_end,c_inh_is,ip))+ & + sum(dataGpr(f_w:f_w_end,c_ish_ir,ip))+sum(dataGpr(f_w:f_w_end,c_ish_is,ip))+ & + sum(dataGpr(f_w:f_w_end,c_glc_gr,ip))+sum(dataGpr(f_w:f_w_end,c_glc_gs,ip)) + + if ( flds_wiso ) then + + do is = 1, nisotopes + write(logunit,*) ' ' + write(logunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & + trim(pname(ip)),': date = ',cdate,sec + write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + do if = iso0(is), isof(is) + write(logunit,FA1r) fname(if),dataGpr(if,c_atm_ar,ip)+dataGpr(if,c_atm_as,ip), & + dataGpr(if,c_lnd_lr,ip)+dataGpr(if,c_lnd_ls,ip), & + dataGpr(if,c_rof_rr,ip)+dataGpr(if,c_rof_rs,ip), & + dataGpr(if,c_ocn_or,ip)+dataGpr(if,c_ocn_os,ip), & + dataGpr(if,c_inh_ir,ip)+dataGpr(if,c_inh_is,ip), & + dataGpr(if,c_ish_ir,ip)+dataGpr(if,c_ish_is,ip), & + dataGpr(if,c_glc_gr,ip)+dataGpr(if,c_glc_gs,ip), & + dataGpr(if,c_atm_ar,ip)+dataGpr(if,c_atm_as,ip)+ & + dataGpr(if,c_lnd_lr,ip)+dataGpr(if,c_lnd_ls,ip)+ & + dataGpr(if,c_rof_rr,ip)+dataGpr(if,c_rof_rs,ip)+ & + dataGpr(if,c_ocn_or,ip)+dataGpr(if,c_ocn_os,ip)+ & + dataGpr(if,c_inh_ir,ip)+dataGpr(if,c_inh_is,ip)+ & + dataGpr(if,c_ish_ir,ip)+dataGpr(if,c_ish_is,ip)+ & + dataGpr(if,c_glc_gr,ip)+dataGpr(if,c_glc_gs,ip) + enddo + write(logunit,FA1r)' *SUM*',sum(dataGpr(iso0(is):isof(is),c_atm_ar,ip))+sum(dataGpr(iso0(is):isof(is),c_atm_as,ip)),& + sum(dataGpr(iso0(is):isof(is),c_lnd_lr,ip))+sum(dataGpr(iso0(is):isof(is),c_lnd_ls,ip)),& + sum(dataGpr(iso0(is):isof(is),c_rof_rr,ip))+sum(dataGpr(iso0(is):isof(is),c_rof_rs,ip)),& + sum(dataGpr(iso0(is):isof(is),c_ocn_or,ip))+sum(dataGpr(iso0(is):isof(is),c_ocn_os,ip)),& + sum(dataGpr(iso0(is):isof(is),c_inh_ir,ip))+sum(dataGpr(iso0(is):isof(is),c_inh_is,ip)),& + sum(dataGpr(iso0(is):isof(is),c_ish_ir,ip))+sum(dataGpr(iso0(is):isof(is),c_ish_is,ip)),& + sum(dataGpr(iso0(is):isof(is),c_glc_gr,ip))+sum(dataGpr(iso0(is):isof(is),c_glc_gs,ip)),& + sum(dataGpr(iso0(is):isof(is),c_atm_ar,ip))+sum(dataGpr(iso0(is):isof(is),c_atm_as,ip))+& + sum(dataGpr(iso0(is):isof(is),c_lnd_lr,ip))+sum(dataGpr(iso0(is):isof(is),c_lnd_ls,ip))+& + sum(dataGpr(iso0(is):isof(is),c_rof_rr,ip))+sum(dataGpr(iso0(is):isof(is),c_rof_rs,ip))+& + sum(dataGpr(iso0(is):isof(is),c_ocn_or,ip))+sum(dataGpr(iso0(is):isof(is),c_ocn_os,ip))+& + sum(dataGpr(iso0(is):isof(is),c_inh_ir,ip))+sum(dataGpr(iso0(is):isof(is),c_inh_is,ip))+& + sum(dataGpr(iso0(is):isof(is),c_ish_ir,ip))+sum(dataGpr(iso0(is):isof(is),c_ish_is,ip))+& + sum(dataGpr(iso0(is):isof(is),c_glc_gr,ip))+sum(dataGpr(iso0(is):isof(is),c_glc_gs,ip)) + end do + end if endif diff --git a/driver_cpl/driver/seq_flux_mct.F90 b/driver_cpl/driver/seq_flux_mct.F90 index 091c38a57040..220ef3ac4456 100644 --- a/driver_cpl/driver/seq_flux_mct.F90 +++ b/driver_cpl/driver/seq_flux_mct.F90 @@ -46,12 +46,21 @@ module seq_flux_mct real(r8), allocatable :: vbot (:) ! atm velocity, meridional real(r8), allocatable :: thbot(:) ! atm potential T real(r8), allocatable :: shum (:) ! atm specific humidity + real(r8), allocatable :: shum_16O (:) ! atm H2O tracer + real(r8), allocatable :: shum_HDO (:) ! atm HDO tracer + real(r8), allocatable :: shum_18O (:) ! atm H218O tracer + real(r8), allocatable :: roce_16O (:) ! ocn H2O ratio + real(r8), allocatable :: roce_HDO (:) ! ocn HDO ratio + real(r8), allocatable :: roce_18O (:) ! ocn H218O ratio real(r8), allocatable :: dens (:) ! atm density real(r8), allocatable :: tbot (:) ! atm bottom surface T real(r8), allocatable :: sen (:) ! heat flux: sensible real(r8), allocatable :: lat (:) ! heat flux: latent real(r8), allocatable :: lwup (:) ! lwup over ocean real(r8), allocatable :: evap (:) ! water flux: evaporation + real(r8), allocatable :: evap_16O (:) !H2O flux: evaporation + real(r8), allocatable :: evap_HDO (:) !HDO flux: evaporation + real(r8), allocatable :: evap_18O (:) !H218O flux: evaporation real(r8), allocatable :: taux (:) ! wind stress, zonal real(r8), allocatable :: tauy (:) ! wind stress, meridional real(r8), allocatable :: tref (:) ! diagnostic: 2m ref T @@ -105,6 +114,9 @@ module seq_flux_mct integer :: index_a2x_Sa_tbot integer :: index_a2x_Sa_ptem integer :: index_a2x_Sa_shum + integer :: index_a2x_Sa_shum_16O + integer :: index_a2x_Sa_shum_HDO + integer :: index_a2x_Sa_shum_18O integer :: index_a2x_Sa_dens integer :: index_a2x_Faxa_swndr integer :: index_a2x_Faxa_swndf @@ -120,6 +132,9 @@ module seq_flux_mct integer :: index_o2x_So_v integer :: index_o2x_So_fswpen integer :: index_o2x_So_s + integer :: index_o2x_So_roce_16O + integer :: index_o2x_So_roce_HDO + integer :: index_o2x_So_roce_18O integer :: index_xao_So_tref integer :: index_xao_So_qref integer :: index_xao_So_avsdr @@ -130,7 +145,10 @@ module seq_flux_mct integer :: index_xao_Faox_tauy integer :: index_xao_Faox_lat integer :: index_xao_Faox_sen - integer :: index_xao_Faox_evap + integer :: index_xao_Faox_evap + integer :: index_xao_Faox_evap_16O + integer :: index_xao_Faox_evap_HDO + integer :: index_xao_Faox_evap_18O integer :: index_xao_Faox_lwup integer :: index_xao_Faox_swdn integer :: index_xao_Faox_swup @@ -215,6 +233,15 @@ subroutine seq_flux_init_mct(comp, fractions) allocate(shum(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate shum',ier) shum = 0.0_r8 + allocate(shum_16O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_16O',ier) + shum_16O = 0.0_r8 + allocate(shum_HDO(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_HDO',ier) + shum_HDO = 0.0_r8 + allocate(shum_18O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_18O',ier) + shum_18O = 0.0_r8 allocate(dens(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate dens',ier) dens = 0.0_r8 @@ -239,6 +266,15 @@ subroutine seq_flux_init_mct(comp, fractions) allocate( tocn(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate tocn',ier) tocn = 0.0_r8 + allocate(roce_16O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate roce_16O',ier) + roce_16O = 0.0_r8 + allocate(roce_HDO(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate roce_HDO',ier) + roce_HDO = 0.0_r8 + allocate(roce_18O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate roce_18O',ier) + roce_18O = 0.0_r8 ! Output fields allocate(sen (nloc),stat=ier) @@ -250,6 +286,15 @@ subroutine seq_flux_init_mct(comp, fractions) allocate(evap(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate evap',ier) evap = 0.0_r8 + allocate(evap_16O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_16O',ier) + evap_16O = 0.0_r8 + allocate(evap_HDO(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_HDO',ier) + evap_HDO = 0.0_r8 + allocate(evap_18O(nloc),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_18O',ier) + evap_18O = 0.0_r8 allocate(lwup(nloc),stat=ier) if(ier/=0) call mct_die(subName,'allocate lwup',ier) lwup = 0.0_r8 @@ -551,6 +596,12 @@ subroutine seq_flux_initexch_mct(atm, ocn, mpicom_cplid, cplid) if(ier/=0) call mct_die(subName,'allocate thbot',ier) allocate(shum(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate shum',ier) + allocate(shum_16O(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_16O',ier) + allocate(shum_HDO(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_HDO',ier) + allocate(shum_18O(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate shum_18O',ier) allocate(dens(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate dens',ier) allocate(tbot(nloc_a2o),stat=ier) @@ -575,6 +626,12 @@ subroutine seq_flux_initexch_mct(atm, ocn, mpicom_cplid, cplid) if(ier/=0) call mct_die(subName,'allocate lat',ier) allocate(evap(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate evap',ier) + allocate(evap_16O(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_16O',ier) + allocate(evap_HDO(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_HDO',ier) + allocate(evap_18O(nloc_a2o),stat=ier) + if(ier/=0) call mct_die(subName,'allocate evap_18O',ier) allocate(lwup(nloc_a2o),stat=ier) if(ier/=0) call mct_die(subName,'allocate lwup',ier) allocate(taux(nloc_a2o),stat=ier) @@ -839,6 +896,9 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o integer(in) :: index_lat integer(in) :: index_sen integer(in) :: index_evap + integer(in) :: index_evap_16O + integer(in) :: index_evap_HDO + integer(in) :: index_evap_18O integer(in) :: index_lwup integer(in) :: index_sumwt integer(in) :: atm_nx,atm_ny,ocn_nx,ocn_ny @@ -892,6 +952,12 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o vbot(n) = 2.0_r8 ! atm velocity, meridional ~ m/s thbot(n)= 301.0_r8 ! atm potential temperature ~ Kelvin shum(n) = 1.e-2_r8 ! atm specific humidity ~ kg/kg + shum_16O(n) = 1.e-2_r8 ! H216O specific humidity ~ kg/kg + shum_HDO(n) = 1.e-2_r8 ! HD16O specificy humidity ~ kg/kg + shum_18O(n) = 1.e-2_r8 ! H218O specific humidity ~ kg/kg + roce_16O(n) = 1.0_r8 ! H216O ratio ~ mol/mol + roce_HDO(n) = 1.0_r8 ! HD16O ratio ~ mol/mol + roce_18O(n) = 1.0_r8 ! H218O ratio ~ mol/mol dens(n) = 1.0_r8 ! atm density ~ kg/m^3 tbot(n) = 300.0_r8 ! atm temperature ~ Kelvin enddo @@ -921,11 +987,17 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o vbot(n) = a2x_e%rAttr(index_a2x_Sa_v ,ia) thbot(n)= a2x_e%rAttr(index_a2x_Sa_ptem,ia) shum(n) = a2x_e%rAttr(index_a2x_Sa_shum,ia) + shum_16O(n) = a2x_e%rAttr(index_a2x_Sa_shum_16O,ia) + shum_HDO(n) = a2x_e%rAttr(index_a2x_Sa_shum_HDO,ia) + shum_18O(n) = a2x_e%rAttr(index_a2x_Sa_shum_18O,ia) dens(n) = a2x_e%rAttr(index_a2x_Sa_dens,ia) tbot(n) = a2x_e%rAttr(index_a2x_Sa_tbot,ia) tocn(n) = o2x_e%rAttr(index_o2x_So_t ,io) uocn(n) = o2x_e%rAttr(index_o2x_So_u ,io) vocn(n) = o2x_e%rAttr(index_o2x_So_v ,io) + roce_16O(n) = o2x_e%rAttr(index_o2x_So_roce_16O, io) + roce_HDO(n) = o2x_e%rAttr(index_o2x_So_roce_HDO, io) + roce_18O(n) = o2x_e%rAttr(index_o2x_So_roce_18O, io) enddo call mct_aVect_clean(a2x_e) call mct_aVect_clean(o2x_e) @@ -933,9 +1005,10 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o if (flux_diurnal) then call shr_flux_atmocn_diurnal (nloc_a2o , zbot , ubot, vbot, thbot, & - shum , dens , tbot, uocn, vocn , & + shum , shum_16O , shum_HDO, shum_18O, dens , tbot, uocn, vocn , & tocn , emask, sen , lat , lwup , & - evap , taux , tauy, tref, qref , & + roce_16O, roce_HDO, roce_18O, & + evap , evap_16O, evap_HDO, evap_18O, taux , tauy, tref, qref , & uGust, lwdn , swdn , swup, prec, & fswpen, ocnsal, ocn_prognostic, flux_diurnal, & lats , lons , warm , salt , speed, regime, & @@ -947,9 +1020,10 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o cold_start=cold_start) else call shr_flux_atmocn (nloc_a2o , zbot , ubot, vbot, thbot, & - shum , dens , tbot, uocn, vocn , & + shum , shum_16O , shum_HDO, shum_18O, dens , tbot, uocn, vocn , & tocn , emask, sen , lat , lwup , & - evap , taux , tauy, tref, qref , & + roce_16O, roce_HDO, roce_18O, & + evap , evap_16O, evap_HDO, evap_18O, taux, tauy, tref, qref , & duu10n,ustar, re , ssq , missval = 0.0_r8 ) endif @@ -977,6 +1051,9 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o index_lat = mct_aVect_indexRA(xaop_ae,"Faox_lat") index_sen = mct_aVect_indexRA(xaop_ae,"Faox_sen") index_evap = mct_aVect_indexRA(xaop_ae,"Faox_evap") + index_evap_16O = mct_aVect_indexRA(xaop_ae,"Faox_evap_16O", perrWith='quiet') + index_evap_HDO = mct_aVect_indexRA(xaop_ae,"Faox_evap_HDO", perrWith='quiet') + index_evap_18O = mct_aVect_indexRA(xaop_ae,"Faox_evap_18O", perrWith='quiet') index_lwup = mct_aVect_indexRA(xaop_ae,"Faox_lwup") index_sumwt = mct_aVect_indexRA(xaop_ae,"sumwt") @@ -995,6 +1072,9 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o xaop_oe%rAttr(index_taux ,io) = xaop_oe%rAttr(index_taux ,io) + taux(n)* wt xaop_oe%rAttr(index_tauy ,io) = xaop_oe%rAttr(index_tauy ,io) + tauy(n)* wt xaop_oe%rAttr(index_evap ,io) = xaop_oe%rAttr(index_evap ,io) + evap(n)* wt + if ( index_evap_16O /= 0 ) xaop_oe%rAttr(index_evap_16O ,io) = xaop_oe%rAttr(index_evap_16O ,io) + evap_16O(n)* wt + if ( index_evap_HDO /= 0 ) xaop_oe%rAttr(index_evap_HDO ,io) = xaop_oe%rAttr(index_evap_HDO ,io) + evap_HDO(n)* wt + if ( index_evap_18O /= 0 ) xaop_oe%rAttr(index_evap_18O ,io) = xaop_oe%rAttr(index_evap_18O ,io) + evap_18O(n)* wt xaop_oe%rAttr(index_tref ,io) = xaop_oe%rAttr(index_tref ,io) + tref(n)* wt xaop_oe%rAttr(index_qref ,io) = xaop_oe%rAttr(index_qref ,io) + qref(n)* wt xaop_oe%rAttr(index_ustar ,io) = xaop_oe%rAttr(index_ustar ,io) + ustar(n)*wt ! friction velocity @@ -1026,6 +1106,9 @@ subroutine seq_flux_atmocnexch_mct( infodata, atm, ocn, fractions_a, fractions_o xaop_ae%rAttr(index_taux ,ia) = xaop_ae%rAttr(index_taux ,ia) + taux(n)* wt xaop_ae%rAttr(index_tauy ,ia) = xaop_ae%rAttr(index_tauy ,ia) + tauy(n)* wt xaop_ae%rAttr(index_evap ,ia) = xaop_ae%rAttr(index_evap ,ia) + evap(n)* wt + if ( index_evap_16O /= 0 ) xaop_ae%rAttr(index_evap_16O ,ia) = xaop_ae%rAttr(index_evap_16O ,ia) + evap_16O(n)* wt + if ( index_evap_HDO /= 0 ) xaop_ae%rAttr(index_evap_HDO ,ia) = xaop_ae%rAttr(index_evap_HDO ,ia) + evap_HDO(n)* wt + if ( index_evap_18O /= 0 ) xaop_ae%rAttr(index_evap_18O ,ia) = xaop_ae%rAttr(index_evap_18O ,ia) + evap_18O(n)* wt xaop_ae%rAttr(index_tref ,ia) = xaop_ae%rAttr(index_tref ,ia) + tref(n)* wt xaop_ae%rAttr(index_qref ,ia) = xaop_ae%rAttr(index_qref ,ia) + qref(n)* wt xaop_ae%rAttr(index_ustar ,ia) = xaop_ae%rAttr(index_ustar ,ia) + ustar(n)*wt ! friction velocity @@ -1152,6 +1235,9 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) index_xao_Faox_lat = mct_aVect_indexRA(xao,'Faox_lat') index_xao_Faox_sen = mct_aVect_indexRA(xao,'Faox_sen') index_xao_Faox_evap = mct_aVect_indexRA(xao,'Faox_evap') + index_xao_Faox_evap_16O = mct_aVect_indexRA(xao,'Faox_evap_16O', perrWith='quiet') + index_xao_Faox_evap_HDO = mct_aVect_indexRA(xao,'Faox_evap_HDO', perrWith='quiet') + index_xao_Faox_evap_18O = mct_aVect_indexRA(xao,'Faox_evap_18O', perrWith='quiet') index_xao_Faox_lwup = mct_aVect_indexRA(xao,'Faox_lwup') index_xao_Faox_swdn = mct_aVect_indexRA(xao,'Faox_swdn') index_xao_Faox_swup = mct_aVect_indexRA(xao,'Faox_swup') @@ -1182,6 +1268,9 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) index_a2x_Sa_tbot = mct_aVect_indexRA(a2x,'Sa_tbot') index_a2x_Sa_ptem = mct_aVect_indexRA(a2x,'Sa_ptem') index_a2x_Sa_shum = mct_aVect_indexRA(a2x,'Sa_shum') + index_a2x_Sa_shum_16O = mct_aVect_indexRA(a2x,'Sa_shum_16O', perrWith='quiet') + index_a2x_Sa_shum_HDO = mct_aVect_indexRA(a2x,'Sa_shum_HDO', perrWith='quiet') + index_a2x_Sa_shum_18O = mct_aVect_indexRA(a2x,'Sa_shum_18O', perrWith='quiet') index_a2x_Sa_dens = mct_aVect_indexRA(a2x,'Sa_dens') index_a2x_Faxa_lwdn = mct_aVect_indexRA(a2x,'Faxa_lwdn') index_a2x_Faxa_rainc= mct_aVect_indexRA(a2x,'Faxa_rainc') @@ -1194,6 +1283,9 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) index_o2x_So_v = mct_aVect_indexRA(o2x,'So_v') index_o2x_So_fswpen = mct_aVect_indexRA(o2x,'So_fswpen') index_o2x_So_s = mct_aVect_indexRA(o2x,'So_s') + index_o2x_So_roce_16O = mct_aVect_indexRA(o2x,'So_roce_16O', perrWith='quiet') + index_o2x_So_roce_HDO = mct_aVect_indexRA(o2x,'So_roce_HDO', perrWith='quiet') + index_o2x_So_roce_18O = mct_aVect_indexRA(o2x,'So_roce_18O', perrWith='quiet') first_call = .false. end if @@ -1224,6 +1316,13 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) vbot(n) = 2.0_r8 ! atm velocity, meridional ~ m/s thbot(n)= 301.0_r8 ! atm potential temperature ~ Kelvin shum(n) = 1.e-2_r8 ! atm specific humidity ~ kg/kg +!wiso note: shum_* should be multiplied by Rstd_* here? + shum_16O(n) = 1.e-2_r8 ! H216O specific humidity ~ kg/kg + shum_HDO(n) = 1.e-2_r8 ! HD16O specific humidity ~ kg/kg + shum_18O(n) = 1.e-2_r8 ! H218O specific humidity ~ kg/kg + roce_16O(n) = 1.0_r8 ! H216O surface ratio ~ mol/mol + roce_HDO(n) = 1.0_r8 ! HDO surface ratio ~ mol/mol + roce_18O(n) = 1.0_r8 ! H218O surface ratio ~ mol/mol dens(n) = 1.0_r8 ! atm density ~ kg/m^3 tbot(n) = 300.0_r8 ! atm temperature ~ Kelvin uGust(n)= 0.0_r8 @@ -1263,11 +1362,17 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) vbot(n) = a2x%rAttr(index_a2x_Sa_v ,n) thbot(n)= a2x%rAttr(index_a2x_Sa_ptem,n) shum(n) = a2x%rAttr(index_a2x_Sa_shum,n) + if ( index_a2x_Sa_shum_16O /= 0 ) shum_16O(n) = a2x%rAttr(index_a2x_Sa_shum_16O,n) + if ( index_a2x_Sa_shum_HDO /= 0 ) shum_HDO(n) = a2x%rAttr(index_a2x_Sa_shum_HDO,n) + if ( index_a2x_Sa_shum_18O /= 0 ) shum_18O(n) = a2x%rAttr(index_a2x_Sa_shum_18O,n) dens(n) = a2x%rAttr(index_a2x_Sa_dens,n) tbot(n) = a2x%rAttr(index_a2x_Sa_tbot,n) tocn(n) = o2x%rAttr(index_o2x_So_t ,n) uocn(n) = o2x%rAttr(index_o2x_So_u ,n) vocn(n) = o2x%rAttr(index_o2x_So_v ,n) + if ( index_o2x_So_roce_16O /= 0 ) roce_16O(n) = o2x%rAttr(index_o2x_So_roce_16O, n) + if ( index_o2x_So_roce_HDO /= 0 ) roce_HDO(n) = o2x%rAttr(index_o2x_So_roce_HDO, n) + if ( index_o2x_So_roce_18O /= 0 ) roce_18O(n) = o2x%rAttr(index_o2x_So_roce_18O, n) !--- mask missing atm or ocn data if found if (dens(n) < 1.0e-12 .or. tocn(n) < 1.0) then emask(n) = 0 @@ -1311,9 +1416,10 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) if (flux_diurnal) then call shr_flux_atmocn_diurnal (nloc , zbot , ubot, vbot, thbot, & - shum , dens , tbot, uocn, vocn , & + shum , shum_16O , shum_HDO, shum_18O, dens , tbot, uocn, vocn , & tocn , emask, sen , lat , lwup , & - evap , taux , tauy, tref, qref , & + roce_16O, roce_HDO, roce_18O, & + evap , evap_16O, evap_HDO, evap_18O, taux , tauy, tref, qref , & uGust, lwdn , swdn , swup, prec, & fswpen, ocnsal, ocn_prognostic, flux_diurnal, & lats, lons , warm , salt , speed, regime, & @@ -1328,9 +1434,10 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) cold_start=cold_start) else call shr_flux_atmocn (nloc , zbot , ubot, vbot, thbot, & - shum , dens , tbot, uocn, vocn , & + shum , shum_16O , shum_HDO, shum_18O, dens , tbot, uocn, vocn , & tocn , emask, sen , lat , lwup , & - evap , taux , tauy, tref, qref , & + roce_16O, roce_HDO, roce_18O, & + evap , evap_16O, evap_HDO, evap_18O, taux , tauy, tref, qref , & duu10n,ustar, re , ssq) !missval should not be needed if flux calc !consistent with mrgx2a fraction @@ -1344,6 +1451,9 @@ subroutine seq_flux_atmocn_mct(infodata, tod, dt, a2x, o2x, xao) xao%rAttr(index_xao_Faox_taux,n) = taux(n) xao%rAttr(index_xao_Faox_tauy,n) = tauy(n) xao%rAttr(index_xao_Faox_evap,n) = evap(n) + if ( index_xao_Faox_evap_16O /= 0 ) xao%rAttr(index_xao_Faox_evap_16O,n) = evap_16O(n) + if ( index_xao_Faox_evap_HDO /= 0 ) xao%rAttr(index_xao_Faox_evap_HDO,n) = evap_HDO(n) + if ( index_xao_Faox_evap_18O /= 0 ) xao%rAttr(index_xao_Faox_evap_18O,n) = evap_18O(n) xao%rAttr(index_xao_So_tref ,n) = tref(n) xao%rAttr(index_xao_So_qref ,n) = qref(n) xao%rAttr(index_xao_So_ustar ,n) = ustar(n) ! friction velocity diff --git a/driver_cpl/shr/seq_flds_mod.F90 b/driver_cpl/shr/seq_flds_mod.F90 index f22d0b860ce2..c225b2b16ff1 100644 --- a/driver_cpl/shr/seq_flds_mod.F90 +++ b/driver_cpl/shr/seq_flds_mod.F90 @@ -332,14 +332,12 @@ subroutine seq_flds_set(nmlfile, ID) logical :: flds_co2c logical :: flds_co2_dmsa logical :: flds_bgc + logical :: flds_wiso integer :: glc_nec namelist /seq_cplflds_inparm/ & - flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, glc_nec, & + flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_wiso, glc_nec, & ice_ncat, seq_flds_i2o_per_cat, flds_bgc -! ======= -! flds_co2a, flds_co2b, flds_co2c, flds_co2_dmsa, flds_bgc, glc_nec -! >>>>>>> acme_master ! user specified new fields integer, parameter :: nfldmax = 200 @@ -367,6 +365,7 @@ subroutine seq_flds_set(nmlfile, ID) flds_co2c = .false. flds_co2_dmsa = .false. flds_bgc = .false. + flds_wiso = .false. glc_nec = 0 ice_ncat = 1 seq_flds_i2o_per_cat = .false. @@ -391,6 +390,7 @@ subroutine seq_flds_set(nmlfile, ID) call shr_mpi_bcast(flds_co2c , mpicom) call shr_mpi_bcast(flds_co2_dmsa, mpicom) call shr_mpi_bcast(flds_bgc , mpicom) + call shr_mpi_bcast(flds_wiso , mpicom) call shr_mpi_bcast(glc_nec , mpicom) call shr_mpi_bcast(ice_ncat , mpicom) call shr_mpi_bcast(seq_flds_i2o_per_cat, mpicom) @@ -614,7 +614,7 @@ subroutine seq_flds_set(nmlfile, ID) attname = 'Sa_ptem' call metadata_set(attname, longname, stdname, units) - ! ppecific humidity at the lowest model level (kg/kg) + ! specific humidity at the lowest model level (kg/kg) call seq_flds_add(a2x_states,"Sa_shum") call seq_flds_add(x2l_states,"Sa_shum") call seq_flds_add(x2i_states,"Sa_shum") @@ -1093,6 +1093,7 @@ subroutine seq_flds_set(nmlfile, ID) attname = 'Sl_snowh' call metadata_set(attname, longname, stdname, units) + ! Surface snow depth (ice/atm only) call seq_flds_add(i2x_states,"Si_snowh") call seq_flds_add(x2a_states,"Si_snowh") @@ -1399,6 +1400,33 @@ subroutine seq_flds_set(nmlfile, ID) attname = 'Fioi_salt' call metadata_set(attname, longname, stdname, units) + ! Black Carbon hydrophilic deposition + call seq_flds_add(i2x_fluxes,"Fioi_bcphi" ) + call seq_flds_add(x2o_fluxes,"Fioi_bcphi" ) + longname = 'Hydrophylic black carbon deposition flux' + stdname = 'deposition_flux_of_hydrophylic_black_carbon' + units = 'kg m-2 s-1' + attname = 'Fioi_bcphi' + call metadata_set(attname, longname, stdname, units) + + ! Black Carbon hydrophobic deposition + call seq_flds_add(i2x_fluxes,"Fioi_bcpho" ) + call seq_flds_add(x2o_fluxes,"Fioi_bcpho" ) + longname = 'Hydrophobic black carbon deposition flux' + stdname = 'deposition_flux_of_hydrophobic_black_carbon' + units = 'kg m-2 s-1' + attname = 'Fioi_bcpho' + call metadata_set(attname, longname, stdname, units) + + ! Dust flux + call seq_flds_add(i2x_fluxes,"Fioi_flxdst") + call seq_flds_add(x2o_fluxes,"Fioi_flxdst") + longname = 'Dust flux' + stdname = 'dust_flux' + units = 'kg m-2 s-1' + attname = 'Fioi_flxdst' + call metadata_set(attname, longname, stdname, units) + ! Sea surface temperature call seq_flds_add(o2x_states,"So_t") call seq_flds_add(x2i_states,"So_t") @@ -2423,6 +2451,520 @@ subroutine seq_flds_set(nmlfile, ID) endif + if (flds_wiso) then + call seq_flds_add(o2x_states, "So_roce_16O") + call seq_flds_add(x2i_states, "So_roce_16O") + longname = 'Ratio of ocean surface level abund. H2_16O/H2O/Rstd' + stdname = '' + units = ' ' + attname = 'So_roce_16O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(o2x_states, "So_roce_18O") + call seq_flds_add(x2i_states, "So_roce_18O") + longname = 'Ratio of ocean surface level abund. H2_18O/H2O/Rstd' + attname = 'So_roce_18O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(o2x_states, "So_roce_HDO") + call seq_flds_add(x2i_states, "So_roce_HDO") + longname = 'Ratio of ocean surface level abund. HDO/H2O/Rstd' + attname = 'So_roce_HDO' + call metadata_set(attname, longname, stdname, units) + + !-------------------------------------------- + !Atmospheric specific humidty at lowest level: + !-------------------------------------------- + + ! specific humidity of H216O at the lowest model level (kg/kg) + call seq_flds_add(a2x_states,"Sa_shum_16O") + call seq_flds_add(x2l_states,"Sa_shum_16O") + call seq_flds_add(x2i_states,"Sa_shum_16O") + longname = 'Specific humidty of H216O at the lowest model level' + stdname = 'H216OV' + units = 'kg kg-1' + attname = 'Sa_shum_16O' + call metadata_set(attname, longname, stdname, units) + + ! specific humidity of HD16O at the lowest model level (kg/kg) + call seq_flds_add(a2x_states,"Sa_shum_HDO") + call seq_flds_add(x2l_states,"Sa_shum_HDO") + call seq_flds_add(x2i_states,"Sa_shum_HDO") + longname = 'Specific humidty of HD16O at the lowest model level' + stdname = 'HD16OV' + attname = 'Sa_shum_HDO' + call metadata_set(attname, longname, stdname, units) + + ! specific humidity of H218O at the lowest model level (kg/kg) + call seq_flds_add(a2x_states,"Sa_shum_18O") + call seq_flds_add(x2l_states,"Sa_shum_18O") + call seq_flds_add(x2i_states,"Sa_shum_18O") + longname = 'Specific humidty of H218O at the lowest model level' + stdname = 'H218OV' + attname = 'Sa_shum_18O' + call metadata_set(attname, longname, stdname, units) + + ! Surface snow water equivalent (land/atm only) + call seq_flds_add(l2x_states,"Sl_snowh_16O") + call seq_flds_add(l2x_states,"Sl_snowh_18O") + call seq_flds_add(l2x_states,"Sl_snowh_HDO") + call seq_flds_add(x2a_states,"Sl_snowh_16O") + call seq_flds_add(x2a_states,"Sl_snowh_18O") + call seq_flds_add(x2a_states,"Sl_snowh_HDO") + longname = 'Isotopic surface snow water equivalent' + stdname = 'surface_snow_water_equivalent' + units = 'm' + attname = 'Sl_snowh_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_snowh_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_snowh_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_snowh_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_snowh_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_snowh_HDO' + call metadata_set(attname, longname, stdname, units) + + !-------------- + !Isotopic Rain: + !-------------- + + !Isotopic Precipitation Fluxes: + units = 'kg m-2 s-1' + call seq_flds_add(a2x_fluxes,"Faxa_rainc_16O") + call seq_flds_add(a2x_fluxes,"Faxa_rainl_16O") + call seq_flds_add(x2o_fluxes, "Faxa_rain_16O") + call seq_flds_add(x2l_fluxes,"Faxa_rainc_16O") + call seq_flds_add(x2l_fluxes,"Faxa_rainl_16O") + call seq_flds_add(x2i_fluxes, "Faxa_rain_16O") + longname = 'Water flux due to H216O rain' !equiv. to bulk + stdname = 'H2_16O_rainfall_flux' + attname = 'Faxa_rain_16O' + call metadata_set(attname, longname, stdname, units) + longname = 'H216O Convective precipitation rate' + stdname = 'H2_16O_convective_precipitation_flux' + attname = 'Faxa_rainc_16O' + call metadata_set(attname, longname, stdname, units) + longname = 'H216O Large-scale (stable) precipitation rate' + stdname = 'H2_16O_large_scale_precipitation_flux' + attname = 'Faxa_rainl_16O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(a2x_fluxes,"Faxa_rainc_18O") + call seq_flds_add(a2x_fluxes,"Faxa_rainl_18O") + call seq_flds_add(x2o_fluxes, "Faxa_rain_18O") + call seq_flds_add(x2l_fluxes,"Faxa_rainc_18O") + call seq_flds_add(x2l_fluxes,"Faxa_rainl_18O") + call seq_flds_add(x2i_fluxes, "Faxa_rain_18O") + longname = 'Water flux due to H218O rain' + stdname = 'h2_18o_rainfall_flux' + attname = 'Faxa_rain_18O' + call metadata_set(attname, longname, stdname, units) + longname = 'H218O Convective precipitation rate' + stdname = 'H2_18O_convective_precipitation_flux' + attname = 'Faxa_rainc_18O' + call metadata_set(attname, longname, stdname, units) + longname = 'H218O Large-scale (stable) precipitation rate' + stdname = 'H2_18O_large_scale_precipitation_flux' + attname = 'Faxa_rainl_18O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(a2x_fluxes,"Faxa_rainc_HDO") + call seq_flds_add(a2x_fluxes,"Faxa_rainl_HDO") + call seq_flds_add(x2o_fluxes, "Faxa_rain_HDO") + call seq_flds_add(x2l_fluxes,"Faxa_rainc_HDO") + call seq_flds_add(x2l_fluxes,"Faxa_rainl_HDO") + call seq_flds_add(x2i_fluxes, "Faxa_rain_HDO") + longname = 'Water flux due to HDO rain' + stdname = 'hdo_rainfall_flux' + attname = 'Faxa_rain_HDO' + call metadata_set(attname, longname, stdname, units) + longname = 'HDO Convective precipitation rate' + stdname = 'HDO_convective_precipitation_flux' + attname = 'Faxa_rainc_HDO' + call metadata_set(attname, longname, stdname, units) + longname = 'HDO Large-scale (stable) precipitation rate' + stdname = 'HDO_large_scale_precipitation_flux' + attname = 'Faxa_rainl_HDO' + call metadata_set(attname, longname, stdname, units) + + !------------- + !Isotopic snow: + !------------- + + call seq_flds_add(a2x_fluxes,"Faxa_snowc_16O") + call seq_flds_add(a2x_fluxes,"Faxa_snowl_16O") + call seq_flds_add(x2o_fluxes, "Faxa_snow_16O") + call seq_flds_add(x2l_fluxes,"Faxa_snowc_16O") + call seq_flds_add(x2l_fluxes,"Faxa_snowl_16O") + call seq_flds_add(x2i_fluxes, "Faxa_snow_16O") + longname = 'Water equiv. H216O snow flux' + stdname = 'h2_16o_snowfall_flux' + attname = 'Faxa_snow_16O' + call metadata_set(attname, longname, stdname, units) + longname = 'H2_16O Convective snow rate (water equivalent)' + stdname = 'H2_16O_convective_snowfall_flux' + attname = 'Faxa_snowc_16O' + call metadata_set(attname, longname, stdname, units) + longname = 'H2_16O Large-scale (stable) snow rate (water equivalent)' + stdname = 'H2_16O_large_scale_snowfall_flux' + attname = 'Faxa_snowl_16O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(a2x_fluxes,"Faxa_snowc_18O") + call seq_flds_add(a2x_fluxes,"Faxa_snowl_18O") + call seq_flds_add(x2o_fluxes, "Faxa_snow_18O") + call seq_flds_add(x2l_fluxes,"Faxa_snowc_18O") + call seq_flds_add(x2l_fluxes,"Faxa_snowl_18O") + call seq_flds_add(x2i_fluxes, "Faxa_snow_18O") + longname = 'Isotopic water equiv. snow flux of H218O' + stdname = 'h2_18o_snowfall_flux' + attname = 'Faxa_snow_18O' + call metadata_set(attname, longname, stdname, units) + longname = 'H2_18O Convective snow rate (water equivalent)' + stdname = 'H2_18O_convective_snowfall_flux' + attname = 'Faxa_snowc_18O' + call metadata_set(attname, longname, stdname, units) + longname = 'H2_18O Large-scale (stable) snow rate (water equivalent)' + stdname = 'H2_18O_large_scale_snowfall_flux' + attname = 'Faxa_snowl_18O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(a2x_fluxes,"Faxa_snowc_HDO") + call seq_flds_add(a2x_fluxes,"Faxa_snowl_HDO") + call seq_flds_add(x2o_fluxes, "Faxa_snow_HDO") + call seq_flds_add(x2l_fluxes,"Faxa_snowc_HDO") + call seq_flds_add(x2l_fluxes,"Faxa_snowl_HDO") + call seq_flds_add(x2i_fluxes, "Faxa_snow_HDO") + longname = 'Isotopic water equiv. snow flux of HDO' + stdname = 'hdo_snowfall_flux' + attname = 'Faxa_snow_HDO' + call metadata_set(attname, longname, stdname, units) + longname = 'HDO Convective snow rate (water equivalent)' + stdname = 'HDO_convective_snowfall_flux' + attname = 'Faxa_snowc_HDO' + call metadata_set(attname, longname, stdname, units) + longname = 'HDO Large-scale (stable) snow rate (water equivalent)' + stdname = 'HDO_large_scale_snowfall_flux' + attname = 'Faxa_snowl_HDO' + call metadata_set(attname, longname, stdname, units) + + !---------------------------------- + !Isotopic precipitation (rain+snow): + !---------------------------------- + + call seq_flds_add(x2o_fluxes,"Faxa_prec_16O") ! derived rain+snow + longname = 'Isotopic Water flux (rain+snow) for H2_16O' + stdname = 'h2_18o_precipitation_flux' + attname = 'Faxa_prec_16O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(x2o_fluxes,"Faxa_prec_18O") ! derived rain+snow + longname = 'Isotopic Water flux (rain+snow) for H2_18O' + stdname = 'h2_18o_precipitation_flux' + units = 'kg m-2 s-1' + attname = 'Faxa_prec_18O' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(x2o_fluxes,"Faxa_prec_HDO") ! derived rain+snow + longname = 'Isotopic Water flux (rain+snow) for HD_O' + stdname = 'hdo_precipitation_flux' + units = 'kg m-2 s-1' + attname = 'Faxa_prec_HDO' + call metadata_set(attname, longname, stdname, units) + + !------------------------------------- + !Isotopic two meter reference humidity: + !------------------------------------- + + ! H216O Reference specific humidity at 2 meters + call seq_flds_add(l2x_states,"Sl_qref_16O") + call seq_flds_add(i2x_states,"Si_qref_16O") + call seq_flds_add(xao_states,"So_qref_16O") + call seq_flds_add(x2a_states,"Sx_qref_16O") + longname = 'Reference H216O specific humidity at 2 meters' + stdname = 'H216O_specific_humidity' + units = 'kg kg-1' + attname = 'Si_qref_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_qref_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'So_qref_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sx_qref_16O' + call metadata_set(attname, longname, stdname, units) + + ! HD16O Reference specific humidity at 2 meters + call seq_flds_add(l2x_states,"Sl_qref_HDO") + call seq_flds_add(i2x_states,"Si_qref_HDO") + call seq_flds_add(xao_states,"So_qref_HDO") + call seq_flds_add(x2a_states,"Sx_qref_HDO") + longname = 'Reference HD16O specific humidity at 2 meters' + stdname = 'HD16O_specific_humidity' + units = 'kg kg-1' + attname = 'Si_qref_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_qref_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'So_qref_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Sx_qref_HDO' + call metadata_set(attname, longname, stdname, units) + + ! H218O Reference specific humidity at 2 meters + call seq_flds_add(l2x_states,"Sl_qref_18O") + call seq_flds_add(i2x_states,"Si_qref_18O") + call seq_flds_add(xao_states,"So_qref_18O") + call seq_flds_add(x2a_states,"Sx_qref_18O") + longname = 'Reference H218O specific humidity at 2 meters' + stdname = 'H218O_specific_humidity' + units = 'kg kg-1' + attname = 'Si_qref_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sl_qref_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'So_qref_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Sx_qref_18O' + call metadata_set(attname, longname, stdname, units) + + !------------------------- + !Isotopic Evaporation flux: + !------------------------- + + ! H216O Evaporation water flux + call seq_flds_add(l2x_fluxes,"Fall_evap_16O") + call seq_flds_add(i2x_fluxes,"Faii_evap_16O") + call seq_flds_add(xao_fluxes,"Faox_evap_16O") + call seq_flds_add(x2a_fluxes,"Faxx_evap_16O") + call seq_flds_add(x2o_fluxes,"Foxx_evap_16O") + longname = 'Evaporation H216O flux' + stdname = 'H216O_evaporation_flux' + units = 'kg m-2 s-1' + attname = 'Fall_evap_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faii_evap_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faox_evap_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faxx_evap_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_evap_16O' + call metadata_set(attname, longname, stdname, units) + + ! HD16O Evaporation water flux + call seq_flds_add(l2x_fluxes,"Fall_evap_HDO") + call seq_flds_add(i2x_fluxes,"Faii_evap_HDO") + call seq_flds_add(xao_fluxes,"Faox_evap_HDO") + call seq_flds_add(x2a_fluxes,"Faxx_evap_HDO") + call seq_flds_add(x2o_fluxes,"Foxx_evap_HDO") + longname = 'Evaporation HD16O flux' + stdname = 'HD16O_evaporation_flux' + units = 'kg m-2 s-1' + attname = 'Fall_evap_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Faii_evap_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Faox_evap_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_evap_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Faxx_evap_HDO' + call metadata_set(attname, longname, stdname, units) + + ! H218O Evaporation water flux + call seq_flds_add(l2x_fluxes,"Fall_evap_18O") + call seq_flds_add(i2x_fluxes,"Faii_evap_18O") + call seq_flds_add(xao_fluxes,"Faox_evap_18O") + call seq_flds_add(x2a_fluxes,"Faxx_evap_18O") + call seq_flds_add(x2o_fluxes,"Foxx_evap_18O") + longname = 'Evaporation H218O flux' + stdname = 'H218O_evaporation_flux' + units = 'kg m-2 s-1' + attname = 'Fall_evap_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faii_evap_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faox_evap_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Faxx_evap_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_evap_18O' + call metadata_set(attname, longname, stdname, units) + + !----------------------------- + !Isotopic sea ice melting flux: + !----------------------------- + + ! H216O Water flux from melting + units = 'kg m-2 s-1' + call seq_flds_add(i2x_fluxes,"Fioi_meltw_16O") + call seq_flds_add(x2o_fluxes,"Fioi_meltw_16O") + longname = 'H2_16O flux due to melting' + stdname = 'h2_16o_surface_snow_melt_flux' + attname = 'Fioi_meltw_16O' + call metadata_set(attname, longname, stdname, units) + + ! H218O Water flux from melting + call seq_flds_add(i2x_fluxes,"Fioi_meltw_18O") + call seq_flds_add(x2o_fluxes,"Fioi_meltw_18O") + longname = 'H2_18O flux due to melting' + stdname = 'h2_18o_surface_snow_melt_flux' + attname = 'Fioi_meltw_18O' + call metadata_set(attname, longname, stdname, units) + + ! HDO Water flux from melting + units = 'kg m-2 s-1' + call seq_flds_add(i2x_fluxes,"Fioi_meltw_HDO") + call seq_flds_add(x2o_fluxes,"Fioi_meltw_HDO") + longname = 'HDO flux due to melting' + stdname = 'hdo_surface_snow_melt_flux' + attname = 'Fioi_meltw_HDO' + call metadata_set(attname, longname, stdname, units) + + !Iso-Runoff + ! l2x, x2r + units = 'kg m-2 s-1' + call seq_flds_add(l2x_fluxes,'Flrl_rofi_16O') + call seq_flds_add(x2r_fluxes,'Flrl_rofi_16O') + longname = 'H2_16O Water flux from land (frozen)' + stdname = 'H2_16O_frozen_water_flux_into_runoff' + attname = 'Flrl_rofi_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_fluxes,'Flrl_rofi_18O') + call seq_flds_add(x2r_fluxes,'Flrl_rofi_18O') + longname = 'H2_18O Water flux from land (frozen)' + stdname = 'H2_18O_frozen_water_flux_into_runoff' + attname = 'Flrl_rofi_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_fluxes,'Flrl_rofi_HDO') + call seq_flds_add(x2r_fluxes,'Flrl_rofi_HDO') + longname = 'HDO Water flux from land (frozen)' + stdname = 'HDO_frozen_water_flux_into_runoff' + attname = 'Flrl_rofi_HDO' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(l2x_fluxes,'Flrl_rofl_16O') + call seq_flds_add(x2r_fluxes,'Flrl_rofl_16O') + longname = 'H2_16O Water flux from land (liquid)' + stdname = 'H2_16O_liquid_water_flux_into_runoff' + attname = 'Flrl_rofl_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_fluxes,'Flrl_rofl_18O') + call seq_flds_add(x2r_fluxes,'Flrl_rofl_18O') + longname = 'H2_18O Water flux from land (liquid)' + stdname = 'H2_18O_liquid_water_flux_into_runoff' + attname = 'Flrl_rofl_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(l2x_fluxes,'Flrl_rofl_HDO') + call seq_flds_add(x2r_fluxes,'Flrl_rofl_HDO') + longname = 'HDO Water flux from land (liquid)' + stdname = 'HDO_liquid_water_flux_into_runoff' + attname = 'Flrl_rofl_HDO' + call metadata_set(attname, longname, stdname, units) + + ! r2x, x2o + call seq_flds_add(r2x_fluxes,'Forr_rofl_16O') + call seq_flds_add(x2o_fluxes,'Foxx_rofl_16O') + longname = 'H2_16O Water flux due to liq runoff ' + stdname = 'H2_16O_water_flux_into_sea_water' + attname = 'Forr_rofl_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofl_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Forr_rofl_18O') + call seq_flds_add(x2o_fluxes,'Foxx_rofl_18O') + longname = 'H2_18O Water flux due to liq runoff ' + stdname = 'H2_18O_water_flux_into_sea_water' + attname = 'Forr_rofl_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofl_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Forr_rofl_HDO') + call seq_flds_add(x2o_fluxes,'Foxx_rofl_HDO') + longname = 'HDO Water flux due to liq runoff ' + stdname = 'HDO_water_flux_into_sea_water' + attname = 'Forr_rofl_HDO' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofl_HDO' + call metadata_set(attname, longname, stdname, units) + + call seq_flds_add(r2x_fluxes,'Forr_rofi_16O') + call seq_flds_add(x2o_fluxes,'Foxx_rofi_16O') + longname = 'H2_16O Water flux due to ice runoff ' + stdname = 'H2_16O_water_flux_into_sea_water' + attname = 'Forr_rofi_16O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofi_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Forr_rofi_18O') + call seq_flds_add(x2o_fluxes,'Foxx_rofi_18O') + longname = 'H2_18O Water flux due to ice runoff ' + stdname = 'H2_18O_water_flux_into_sea_water' + attname = 'Forr_rofi_18O' + call metadata_set(attname, longname, stdname, units) + attname = 'Foxx_rofi_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Forr_rofi_HDO') + call seq_flds_add(x2o_fluxes,'Foxx_rofi_HDO') + longname = 'HDO Water flux due to ice runoff ' + stdname = 'HDO_water_flux_into_sea_water' + attname = 'Forr_rofi_HDO' + call metadata_set(attname, longname, stdname, units) + + ! r2x, x2l + call seq_flds_add(r2x_fluxes,'Flrr_flood_16O') + call seq_flds_add(x2l_fluxes,'Flrr_flood_16O') + longname = 'H2_16O waterrflux due to flooding' + stdname = 'H2_16O_flodding_water_flux_back_to_land' + attname = 'Flrr_flood_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Flrr_flood_18O') + call seq_flds_add(x2l_fluxes,'Flrr_flood_18O') + longname = 'H2_18O waterrflux due to flooding' + stdname = 'H2_18O_flodding_water_flux_back_to_land' + attname = 'Flrr_flood_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_fluxes,'Flrr_flood_HDO') + call seq_flds_add(x2l_fluxes,'Flrr_flood_HDO') + longname = 'HDO Waterrflux due to flooding' + stdname = 'HDO_flodding_water_flux_back_to_land' + attname = 'Flrr_flood_HDO' + call metadata_set(attname, longname, stdname, units) + + units = 'm3' + call seq_flds_add(r2x_states,'Flrr_volr_16O') + call seq_flds_add(x2l_states,'Flrr_volr_16O') + longname = 'H2_16O river channel water volume ' + stdname = 'H2_16O_rtm_volr' + attname = 'Flrr_volr_16O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_states,'Flrr_volr_18O') + call seq_flds_add(x2l_states,'Flrr_volr_18O') + longname = 'H2_18O river channel water volume ' + stdname = 'H2_18O_rtm_volr' + attname = 'Flrr_volr_18O' + call metadata_set(attname, longname, stdname, units) + call seq_flds_add(r2x_states,'Flrr_volr_HDO') + call seq_flds_add(x2l_states,'Flrr_volr_HDO') + longname = 'HDO river channel water volume ' + stdname = 'HDO_rtm_volr' + attname = 'Flrr_volr_HDO' + call metadata_set(attname, longname, stdname, units) + + ! call seq_flds_add(r2x_fluxes,'Flrr_flood_HDO') + ! call seq_flds_add(x2l_fluxes,'Flrr_flood_HDO') + ! longname = 'H2_18O Waterrflux due to flooding' + ! stdname = 'H2_18O_flodding_water_flux_back_to_land' + ! attname = 'Flrr_flood_18O' + ! call metadata_set(attname, longname, stdname, units) + + !----------------------------- + + endif !Water isotopes + !----------------------------------------------------------------------------- ! optional per thickness category fields !----------------------------------------------------------------------------- diff --git a/share/csm_share/shr/shr_const_mod.F90 b/share/csm_share/shr/shr_const_mod.F90 index ef0a472deb81..8d031c406143 100644 --- a/share/csm_share/shr/shr_const_mod.F90 +++ b/share/csm_share/shr/shr_const_mod.F90 @@ -61,6 +61,16 @@ MODULE shr_const_mod real(R8),parameter :: SHR_CONST_SPVAL_TOLMIN = 0.99_R8 * SHR_CONST_SPVAL ! min spval tolerance real(R8),parameter :: SHR_CONST_SPVAL_TOLMAX = 1.01_R8 * SHR_CONST_SPVAL ! max spval tolerance + !Water Isotope Ratios in Vienna Standard Mean Ocean Water (VSMOW): + real(R8),parameter :: SHR_CONST_VSMOW_18O = 2005.2e-6_R8 ! 18O/16O in VMSOW + real(R8),parameter :: SHR_CONST_VSMOW_17O = 379.e-6_R8 ! 18O/16O in VMSOW + real(R8),parameter :: SHR_CONST_VSMOW_16O = 0.997628_R8 ! 16O/Tot in VMSOW + real(R8),parameter :: SHR_CONST_VSMOW_D = 155.76e-6_R8 ! 2H/1H in VMSOW + real(R8),parameter :: SHR_CONST_VSMOW_T = 1.85e-6_R8 ! 3H/1H in VMSOW + real(R8),parameter :: SHR_CONST_VSMOW_H = 0.99984426_R8 ! 1H/Tot in VMSOW + ! For best numerics in CAM5 + real(R8),parameter :: SHR_CONST_RSTD_H2ODEV = 1.0_R8 ! Rstd Dev Use + contains !----------------------------------------------------------------------------- diff --git a/share/csm_share/shr/shr_flux_mod.F90 b/share/csm_share/shr/shr_flux_mod.F90 index 67762f517b32..b20c7739f6a0 100644 --- a/share/csm_share/shr/shr_flux_mod.F90 +++ b/share/csm_share/shr/shr_flux_mod.F90 @@ -115,17 +115,24 @@ end subroutine shr_flux_adjust_constants ! 2003-Apr-02 - B. Kauffman - tref,qref,duu10n mods as per Bill Large ! 2006-Nov-07 - B. Kauffman - code migrated from cpl6 to share ! +! 2011-Mar-13 - J. Nusbaumer - Water Isotope ocean flux added. +! ! !INTERFACE: ------------------------------------------------------------------ SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,rbot ,tbot ,us ,vs , & + & qbot ,s16O ,sHDO ,s18O ,rbot , & + & tbot ,us ,vs , & & ts ,mask ,sen ,lat ,lwup , & - & evap ,taux ,tauy ,tref ,qref , & + & r16O, rhdo, r18O, & + & evap ,evap_16O, evap_HDO, evap_18O, & + & taux ,tauy ,tref ,qref , & & duu10n, ustar_sv ,re_sv ,ssq_sv, & & missval ) ! !USES: + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + implicit none ! !INPUT/OUTPUT PARAMETERS: @@ -138,6 +145,12 @@ SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) @@ -149,6 +162,9 @@ SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -354,6 +370,15 @@ SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & !--- water flux --- evap(n) = lat(n)/loc_latvap + !---water isotope flux --- + + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & + qbot(n),evap(n)) + !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared !------------------------------------------------------------ @@ -384,6 +409,9 @@ SUBROUTINE shr_flux_atmOcn(nMax ,zbot ,ubot ,vbot ,thbot , & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval !water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) @@ -417,9 +445,12 @@ END subroutine shr_flux_atmOcn SUBROUTINE shr_flux_atmOcn_diurnal & (nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,rbot ,tbot ,us ,vs , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot ,us ,vs , & ts ,mask ,sen ,lat ,lwup , & - evap ,taux ,tauy ,tref ,qref , & + r16O ,rhdo ,r18O ,evap ,evap_16O, & + evap_HDO ,evap_18O, & + taux ,tauy ,tref ,qref , & uGust, lwdn , swdn , swup, prec , & swpen, ocnsal, ocn_prognostic, flux_diurnal, & latt, long , warm , salt , speed, regime, & @@ -431,6 +462,8 @@ SUBROUTINE shr_flux_atmOcn_diurnal & missval, cold_start ) ! !USES: + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + implicit none ! !INPUT/OUTPUT PARAMETERS: @@ -443,6 +476,12 @@ SUBROUTINE shr_flux_atmOcn_diurnal & real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) @@ -493,6 +532,9 @@ SUBROUTINE shr_flux_atmOcn_diurnal & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -937,6 +979,15 @@ SUBROUTINE shr_flux_atmOcn_diurnal & !--- water flux --- evap(n) = lat(n)/shr_const_latvap + + !---water isotope flux --- + + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& + qbot(n),evap(n)) !------------------------------------------------------------ ! compute diagnostics: 2m ref T & Q, 10m wind speed squared @@ -1048,15 +1099,18 @@ SUBROUTINE shr_flux_atmOcn_diurnal & windInc (n) = spval ! NEW nInc (n) = 0.0_R8 ! NEW - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval diff --git a/share/csm_share/shr/water_isotopes.F90 b/share/csm_share/shr/water_isotopes.F90 new file mode 100644 index 000000000000..a19c8065d364 --- /dev/null +++ b/share/csm_share/shr/water_isotopes.F90 @@ -0,0 +1,729 @@ + +module water_isotopes +!----------------------------------------------------------------------- +! +! Provides the functions and constants needed to calculate the isotopc flux from +! water on the ocean surface into the atmosphere. +! +! All interface routine are identified by wiso_*, etc. +! +! This code works over species indices, rather than the constituent indices +! used in the water_tracers module. As such, MAKE SURE you call these +! routines with species indicies! The tracer variable names do not need to +! match the species names, which are privided just for diagnostic output. +! +! * This module MUST be includable by CAM and CLM * (be careful with uses) +! +! +! This routine has a bunch of "qtiny" - which could be standardized. +! +! Original Code Author: David Noone - March 2003 +! +! Module added to CESM's csm_share by: Jesse Nusbaumer - March 2011 +! +!----------------------------------------------------------------------- +#undef NOFRAC /* all fractionation factors = 1 */ +#undef NOKIN /* all kinetic effects off */ +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 +! use abortutils, only: endrun + use shr_const_mod, only: SHR_CONST_TKTRIP, & + SHR_CONST_RSTD_H2ODEV, & + SHR_CONST_VSMOW_16O, & + SHR_CONST_VSMOW_18O, & + SHR_CONST_VSMOW_D , & + SHR_CONST_VSMOW_H + + implicit none + + private + save + +! Public interfaces + + !Initialization routines: + + public :: wiso_init ! initilize water isotopes/tracers. + public :: wiso_get_ispec ! lookup a species index by name + + !Fractionation routines: + + public :: wiso_alpl ! look-up liquid/vapor equil. fractn. + public :: wiso_alpi ! look-up ice/vapor equil. fractn. + public :: wiso_kmol ! kinetic effects for ocean evap (Brutsaert) + public :: wiso_kmolv10 ! kmol (as above) from 10 meter wind (M&J) + public :: wiso_akel ! kinetic fractionation at liq. evaporation + public :: wiso_akci ! kinetic fractnation at ice condensation + + !Calculation routines: + + public :: wiso_get_roce ! retrive ocean isotope ratio. + public :: wiso_flxoce ! calculate isotopic ocean evaporation. + public :: wiso_ssatf ! supersaturation function + public :: wiso_heff ! effective humidity function + + !Data checking routines: + + public :: wiso_get_rstd !retrive standard isotope ratio + public :: wiso_get_fisub !retrive isotope subsitutions + !aka number of iso. atoms per molec. + public :: wiso_ratio !calculate mass ratio of isotope . + public :: wiso_delta !calculate the delta value for isotopes. + + +!configuration pointers/indices (Added from water_tracers - JN) +! integer, public :: iwspec(pcnst+pnats) ! flag for water (isotope) species +! integer, public :: ixwti, ixwtx ! lowest and highest index to search + +! Species indicies - public so thay can be seen by water_tracers + integer, parameter, public :: ispundef = 0 ! Undefined + integer, parameter, public :: isph2o = 1 ! H2O ! "regular" water + integer, parameter, public :: isph216o = 2 ! H216O ! H216O, nearly the same as "regular" water + integer, parameter, public :: isphdo = 3 ! HDO + integer, parameter, public :: isph218o = 4 ! H218O + +! Module parameters + integer , parameter, public :: pwtspec = 4 ! number of water species (h2o,hdo,h218o,h216o) + +! Tunable prameters for fractionation scheme + real(r8), parameter :: dkfac = 0.58_r8 ! diffusive evap. kinetic power law +! real(r8), parameter :: tkini = SHR_CONST_TKTRIP ! min temp. for kinetic effects as ice appears +! real(r8), parameter :: tkini = 258.15_r8 !From Bony et. al., 2008 + real(r8), parameter :: tkini = 253.15_r8 !From Jouzel and Merlivat, 1984 + + real(r8), parameter :: recrit = 1.0_r8 ! critical raynolds number for kmol + + real(r8), parameter :: fsata = 1.000_r8 ! supersaturation peramater s = a + +!bTdegC (Hoffman) +! real(r8), parameter :: fsatb = -0.003_r8 ! supersaturation parameter s = a + + real(r8), parameter :: fsatb = -0.002_r8 !tuned to match Antarctic d-excess in precip. - JN +!bTdegC (Hoffman) + real(r8), parameter :: ssatmx = 2.00_r8 ! maximum supersaturation + real(r8), parameter :: fkhum = 0.25_r8 ! effective humidity factor + real(r8), parameter :: tzero = SHR_CONST_TKTRIP ! supercooled water in stratiform + + character(len=8), dimension(pwtspec), parameter, public :: & ! species names + spnam = (/ 'H2O ', 'H216O ', 'HD16O ', 'H218O ' /) + +! Private isotopic constants +! + +! +! Physical constants for isotopic molecules +! + real(r8), dimension(pwtspec), parameter :: & ! isotopic subs. + fisub = (/ 1._r8, 1._r8, 2._r8, 1._r8 /) + + real(r8), dimension(pwtspec), parameter :: & ! molecular weights + mwisp = (/ 18._r8, 18._r8, 19._r8, 20._r8 /) + + real(r8), dimension(pwtspec), parameter :: & ! mol. weight ratio + epsmw = (/ 1._r8, 1._r8, 19._r8/18._r8, 20._r8/18._r8 /) + + ! TBD: Ideally this should be controlled by something like a namelist parameter, + ! but it needs to be something that can be made consistent between models. + real(r8), dimension(pwtspec), parameter :: & ! diffusivity ratio (note D/H, not HDO/H2O) +! difrm = (/ 1._r8, 1._r8, 0.9836504_r8, 0.9686999_r8 /) ! kinetic theory +! difrm = (/ 1._r8, 1._r8, 1._r8, 1._r8 /) ! no kinetic fractination +! difrm = (/ 1._r8, 1._r8, 0.9836504_r8, 0.9686999_r8 /) ! this with expk +! difrm = (/ 1._r8, 1._r8, 0.9755_r8, 0.9723_r8 /) ! Merlivat 1978 (tuned for isoCAM3) + difrm = (/ 1._r8, 1._r8, 0.9757_r8, 0.9727_r8 /) ! Merlivat 1978 (direct from paper) +! difrm = (/ 1._r8, 1._r8, 0.9839_r8, 0.9691_r8 /) ! Cappa etal 2003 + +! Isotopic ratios in natural abundance (SMOW) + real(r8), dimension(pwtspec), parameter :: & ! SMOW isotope ratios + rnat = (/ 1._r8, 0.9976_r8, 155.76e-6_r8, 2005.20e-6_r8 /) + +! Prescribed isotopic ratios (largely arbitrary and tunable) + real(r8), dimension(pwtspec), parameter :: & ! model standard isotope ratio +!suggested by D. Noone: + rstd = (/ 1._r8, 1._r8, 1._r8, 1._r8 /) ! best numerics +! rstd = (/ 1._r8, 0.5_r8, 0.25_r8, 0.2_r8, 0.1_r8 /) ! test numerics +! rstd = (/ 1._r8, 0.9976_r8, 155.76e-6_r8, 2005.20e-6_r8 /) ! natural abundance +! rstd = (/ SHR_CONST_RSTD_H2ODEV, SHR_CONST_VSMOW_16O, SHR_CONST_VSMOW_D, SHR_CONST_VSMOW_18O /) ! natural abundance +! rstd = (/ SHR_CONST_RSTD_H2ODEV, SHR_CONST_RSTD_H2ODEV, SHR_CONST_RSTD_H2ODEV, SHR_CONST_RSTD_H2ODEV /) !all 1.0 + +! Isotope enrichment at ocean surface (better to be computed or read from file) + real(r8), dimension(pwtspec), parameter :: & ! mean ocean surface enrichent +! boce = (/ 1._r8, 1._r8, 1.004_r8, 1.0005_r8 /) +! boce = (/ 1._r8, 1._r8, 1.0128_r8, 1.0016_r8, 1.0008_r8, 1.00671_r8 /) ! LGM + boce = (/ 1._r8, 1._r8, 1._r8, 1._r8 /) + +! Ocean surface kinetic fractionation parameters for M&J method: +! TBD: Check to make sure that the entries for h216o are correct. + real(r8), parameter, dimension(pwtspec) :: & ! surface kinetic exchange + aksmc = (/ 0._r8, 0._r8, 0.00528_r8, 0.006_r8 /), & + akrfa = (/ 0._r8, 0._r8, 0.2508e-3_r8, 0.285e-3_r8 /), & + akrfb = (/ 0._r8, 0._r8, 0.7216e-3_r8, 0.82e-3_r8 /) + +! Coefficients for fractionation +! TBD: Check to make sure that the entries for h216o are correct. +!From Majoube, 1971a: +! real(r8), parameter, dimension(pwtspec) :: & ! liquid/vapour +! alpal = (/ 0._r8, 0._r8, 24.844e+3_r8, 1.137e+3_r8 /) , & +! alpbl = (/ 0._r8, 0._r8, -76.248_r8, -0.4156_r8 /) , & +! alpcl = (/ 0._r8, 0._r8, 52.612e-3_r8, -2.0667e-3_r8 /) + +!From Horita and Wesolowski, 1994: + real(r8), parameter, dimension(pwtspec) :: & ! liquid/vapour + alpal = (/ 0._r8, 0._r8, 1158.8e-12_r8, 0.35041e+6_r8 /), & + alpbl = (/ 0._r8, 0._r8, -1620.1e-9_r8, -1.6664e+3_r8 /), & + alpcl = (/ 0._r8, 0._r8, 794.84e-6_r8, 6.7123_r8 /), & + alpdl = (/ 0._r8, 0._r8, -161.04e-3_r8, -7.685e-3_r8 /), & + alpel = (/ 0._r8, 0._r8, 2.9992e+6_r8, 0._r8 /) + +!isoCAM3 values: +! real(r8), parameter, dimension(pwtspec) :: & ! ice/vapour +! alpai = (/ 0._r8, 0._r8, 16288._r8, 0._r8 /), & +! alpbi = (/ 0._r8, 0._r8, 0._r8, 11.839_r8 /), & +! alpci = (/ 0._r8, 0._r8, -9.34e-2_r8, -28.224e-3_r8 /) + +!From Merlivat & Nief,1967 for HDO, and Majoube, 1971b for H218O: + real(r8), parameter, dimension(pwtspec) :: & ! ice/vapour + alpai = (/ 0._r8, 0._r8, 16289._r8, 0._r8 /), & + alpbi = (/ 0._r8, 0._r8, 0._r8, 11.839_r8 /), & + alpci = (/ 0._r8, 0._r8, -9.45e-2_r8, -28.224e-3_r8 /) + +contains + +!----------------------- +!Initialization routines: +!----------------------- + +!======================================================================= + subroutine wiso_init +!----------------------------------------------------------------------- +! Purpose: Initialize module internal data arrays +! Author: David Noone - Sun Jun 29 20:29:26 MDT 2003 +!----------------------------------------------------------------------- + write(6,*) 'WISO_INIT: Initializing water isotopes.' + return + end subroutine wiso_init + +!---------------------- +!Fractionation routines: +!---------------------- + +!======================================================================= + subroutine wiso_kmol(isp,rbot,zbot,ustar,alpkn) +!----------------------------------------------------------------------- +! +! Purpose: compute kinetic modifier for drag coefficient (Merlivat & Jouzel) +! +! Method: +! Code solves Brutsaert equations for theturbulent layer using GCM computed +! quantities. Operates on a vector of points. +! +! Author: David Noone - Mon Jun 30 14:05:38 MDT 2003 +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: shr_const_g, shr_const_karman + + implicit none + + real(r8), parameter :: difair = 2.36e-5_r8 ! molecular diffusivity of air + real(r8), parameter :: muair = 1.7e-5_r8 ! dynamic viscosity of air + ! about 17 degC, 1.73 at STP (Salby) + real(r8), parameter :: gravit = shr_const_g ! gravity + real(r8), parameter :: karman = shr_const_karman ! Von Karman constant + +!---------------------------- Arguments -------------------------------- + integer , intent(in) :: isp ! species flag + real(r8), intent(in) :: rbot ! density of lowest layer (kg/m3) + real(r8), intent(in) :: zbot ! height of lowest level (m) + real(r8), intent(in) :: ustar ! Friction velocity (m/s) +! + real(r8), intent(out) :: alpkn ! kinetic fractionation factor (1-kmol) + +!------------------------- Local Variables ----------------------------- + real(r8) z0 ! roughness length (constant in cam 9.5e-5) + real(r8) reno ! surface reynolds number + real(r8) tmr ! ratio of turbulen to molecular resistance + real(r8) enn ! diffusive power + real(r8) sc ! Schmidt number (Prandtl number) + real(r8) vmu ! kinematic viscocity of air + real(r8) difn ! ratio of difusivities to the power of n + real(r8) difrmj ! isotopic diffusion with substitutions + + real(r8) kmol ! Merlivals k_mol +!----------------------------------------------------------------------- +! +!! difrmj = difrm(isp)/fisub(isp) + difrmj = difrm(isp) +! + z0 = (ustar**2._r8)/(81.1_r8*gravit) ! Charnock's equation + vmu = muair / rbot ! kinematic viscosity + Sc = vmu/difair + reno = ustar*z0 / vmu ! reynolds number +! + if (reno < recrit) then ! Smooth (Re < 0.13) + enn = 2._r8/3._r8 + tmr = ( (1._r8/karman)*log(ustar*zbot / (30._r8 * vmu)) ) / (13.6_r8 * Sc**(2._r8/3._r8)) + else ! Rough (Re > 2) + enn = 1._r8/2._r8 + tmr = ( (1._r8/karman)*log(zbot/z0) - 5._r8) / (7.3_r8 * reno**(1._r8/4._r8) * Sc**(1._r8/2._r8)) + end if + + difn = (1._r8/difrmj)**enn ! use D/Di, not Di/D + kmol = (difn - 1._r8) / (difn + tmr) + + alpkn = 1._r8 - kmol + +#ifdef NOKIN +! alpkn = 1._r8 +#endif +! + return + end subroutine wiso_kmol + +!======================================================================= + subroutine wiso_kmolv10(isp,ustar,alpkn) +!----------------------------------------------------------------------- +! +! Purpose: compute kinetic modifier for drag coefficient (Merlivat & +! Jouzel, 1979) +! +! Method: +! Uses everyones favorite empirical relation to 10 meter windspeed +! +! Author: David Noone - Mon Jun 30 14:05:38 MDT 2003 +! +! Modified U(z=10 m) calculation: Jesse Nusbaumer - Sept. +! 2011 +! +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: shr_const_g, shr_const_karman + + implicit none + + real(r8), parameter :: gravit = shr_const_g ! gravity + real(r8), parameter :: karman = shr_const_karman ! Von Karman constant + +!---------------------------- Arguments -------------------------------- + integer , intent(in) :: isp ! species flag + real(r8), intent(in) :: ustar !friction velocity +! + real(r8), intent(out) :: alpkn ! kinetic fractionation fatcor + +!------------------------- Local Variables ----------------------------- + real(r8) z0 ! roughness length + real(r8) v10 ! 10 meter winds + real(r8) kmol ! Merlivat's K_mol +!----------------------------------------------------------------------- +! + z0 = (ustar**2._r8)/(81.1_r8*gravit) ! Charnock's equation +! + v10 = ustar*log(10._r8/z0)/karman !calculate U(z=10 m) wind speed. +! +! Compute the kinetic fractionation: +! + if (v10 < 7.0_r8) then ! smooth regime + kmol = aksmc(isp) + else ! rough regime + kmol = akrfa(isp)*v10 + akrfb(isp) + end if +! + alpkn = 1._r8 - kmol +! +!#ifdef NOKIN +! alpkn = 1.0_r8 +!#endif +! + return + end subroutine wiso_kmolv10 + +!======================================================================= + function wiso_alpl(isp,tk) +!----------------------------------------------------------------------- +! Purpose: return liquid/vapour fractionation from look-up tables +! Author: David Noone - Mon Jun 30 10:59:13 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species indes + real(r8), intent(in) :: tk ! temperature (k) + real(r8) :: wiso_alpl ! return fractionation +!----------------------------------------------------------------------- +! + if (isp == isph2o) then + wiso_alpl = 1._r8 + return + end if +!Majoube, 1971: +! wiso_alpl = exp(alpal(isp)/tk**2 + alpbl(isp)/tk + alpcl(isp)) + +!Horita and Wesolowski, 1994: + if(isp == isphdo) then !HDO has different formulation: + wiso_alpl = exp(alpal(isp)*tk**3 + alpbl(isp)*tk**2 + alpcl(isp)*tk + alpdl(isp) + alpel(isp)/tk**3) + else + wiso_alpl = exp(alpal(isp)/tk**3 + alpbl(isp)/tk**2 + alpcl(isp)/tk + alpdl(isp)) + end if + +#ifdef NOFRAC + wiso_alpl = 1._r8 +#endif +! + return + end function wiso_alpl + +!======================================================================= + function wiso_alpi(isp,tk) +!----------------------------------------------------------------------- +! Purpose: return ice/vapour fractionation from loop-up tables +! Author: David Noone - Tue Jul 1 12:02:24 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species indes + real(r8), intent(in) :: tk ! temperature (k) + real(r8) :: wiso_alpi ! return fractionation +!----------------------------------------------------------------------- + if (isp == isph2o) then + wiso_alpi = 1._r8 + return + end if + + wiso_alpi = exp(alpai(isp)/tk**2 + alpbi(isp)/tk + alpci(isp)) + +#ifdef NOFRAC + wiso_alpi = 1._r8 +#endif +! + return +end function wiso_alpi + +!======================================================================= +function wiso_akel(isp,tk,hum0,alpeq) +!----------------------------------------------------------------------- +! Purpose: return modified fractination for kinetic effects during +! liquid evaporation into unsaturated air. +! Author: David Noone - Tue Jul 1 12:02:24 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species indes + real(r8), intent(in) :: tk ! Temperature (K) + real(r8), intent(in) :: hum0 ! initial humidity () + real(r8), intent(in) :: alpeq ! equilibrium fractionation factor + real(r8) :: wiso_akel ! return effective fractionation + real(r8) :: h0 ! humidity + real(r8) :: heff ! effective humidity + real(r8) :: difrmj ! diffusivity for iso. sub. hum. + real(r8) :: dondi ! (D / Di)^fdif, (rather than Di/D) +!----------------------------------------------------------------------- +!! if (tk > tkinl) then ! also do it for supercooled water + h0 = min(1.0_r8,hum0) +!! difrmj = difrm(isp)/fisub(isp) + difrmj = difrm(isp) + heff = wiso_heff(h0) + dondi = (1/difrmj)**dkfac + wiso_akel = alpeq*heff / (alpeq*dondi*(heff-1._r8) + 1._r8) +!! else +!! wiso_akel = alpeq +!! end if +! +! Modify for non-standard isotope +! +!! wiso_akel = wiso_akel**expk(isp) + +#ifdef NOKIN + wiso_akel = alpeq +#endif + + return +end function wiso_akel + +!======================================================================= + function wiso_akci(isp,tk,alpeq) +!----------------------------------------------------------------------- +! Purpose: return modified fractination for kinetic effects during +! condensation to ice. +! Make use of supersaturation function. +! Author: David Noone - Tue Jul 1 12:02:24 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species indes + real(r8), intent(in) :: tk ! temperature (k) + real(r8), intent(in) :: alpeq ! equilibrium fractionation factor + real(r8) :: wiso_akci ! return effective fractionation + real(r8) :: sat1 ! super sturation + real(r8) :: difrmj ! isotopic diffusion for subs. molec. + real(r8) :: dondi ! D / Di, (rather than Di/D) +!----------------------------------------------------------------------- +! + if (tk < tkini) then ! anytime below freezing + sat1 = max(1._r8, wiso_ssatf(tk)) +!! difrmj = difrm(isp)/fisub(isp) + difrmj = difrm(isp) + dondi = 1._r8/difrmj + wiso_akci = alpeq*sat1 / (alpeq*dondi*(sat1-1._r8) + 1._r8) + else + wiso_akci = alpeq + end if +! +! Modify for non-standard isotope +! +!! wiso_akci = wiso_akci**expk(isp) + +#ifdef NOKIN + wiso_akci = alpeq +#endif +! + return +end function wiso_akci + +!-------------------- +!Calculation routines +!-------------------- + +!======================================================================= + function wiso_get_roce(isp) +!----------------------------------------------------------------------- +! Purpose: Retrieve internal Roce variable, based on species index +! Author: David Noone - Sun Jun 29 20:29:04 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species index + real(r8) :: wiso_get_roce ! return isotope ratio +!----------------------------------------------------------------------- + wiso_get_roce = boce(isp)*rstd(isp) + return + end function wiso_get_roce + +!======================================================================= + +!======================================================================= + + subroutine wiso_flxoce( iso ,rbot ,zbot ,wtbot , & + ts , rocn, ustar ,re , & + ssq, qflx, qbot, qe ) + +!----------------------------------------------------------------------- +! +! Purpose: compute water tracer exchange from ocean +! +! Method: +! Used diagnostics output from (./dom/)flxoce to ensure +! quantities are exactly equal for constituent number 1. +! Isotopic fractionation (equilibrium and kinetci) is applied, +! when needed. +! + +! E = fac (q - qs(ts)) +! +! where fac is some exchange efficiency and qs is the saturation +! vapour mixing rati at the surface temperature. These are needed +! from calling routine to solve isotopic equivilent. +! +! Ei = fac (1-kmol) (qi - qs(ts)*Rocn/alpha) +! +! To compute the kinetic drag modifneed also +! +! Author: +! David Noone - Mon Jun 30 10:24:49 MDT 2003 +! +! Ported to CAM5, and added Schmidt, 1999 scheme - Jesse Nusbaumer - April, 2012 +! +!----------------------------------------------------------------------- +! use shr_kind_mod, only: r8 => shr_kind_r8 +! use water_tracers, only: trace_water, wtrc_is_vap, iwspec, ixwti, ixwtx +! use water_isotopes, only: wisotope, wiso_kmol, wiso_alpl,wiso_get_roce, & +! wiso_alpi + + implicit none + +!---------------------------- Arguments -------------------------------- +! + integer , intent(in) :: iso ! isotope value (1=16O,2=D,3=18O) + real(r8), intent(in) :: rbot ! density of lowest layer (kg/m3) + real(r8), intent(in) :: zbot ! height of lowest level (m) + real(r8), intent(in) :: wtbot ! constituents at lowest + real(r8), intent(in) :: qbot ! bulk water (q) at lowest + real(r8), intent(in) :: qe ! bulk evaporative flux (evp) + + real(r8), intent(in) :: ts ! (sea) surface temperature K + real(r8), intent(in) :: rocn ! (sea) surface temperature iso ratio/Rstd + real(r8), intent(in) :: ustar ! friction velocity (m/s) + real(r8), intent(in) :: re ! Reynolds number ? + real(r8), intent(in) :: ssq ! s.hum. saturation at Ts +! + real(r8), intent(out) :: qflx ! constituentflux (kg/kg/s) +! +!------------------------- Local Variables ----------------------------- + real(r8) alpkn ! kinetic fractionation efficiency (m) + real(r8) tau ! stress + real(r8) delq ! spec. hum. difference + real(r8) qstar ! spec. hum,. mixing scale + real(r8) Roce ! water tracer ratio of ocean surface + real(r8) alpha ! fractionation factor + real(r8) rh ! relative humidity + real(r8) rate ! tracer ratio in evaporation + real(r8) R_std ! tracer ratio in evaporation +!----------------------------------------------------------------------- +! +!-------------------------- +!calculate isotopic factors +!-------------------------- +! + alpha = wiso_alpl(iso,ts) !get equilibrium frac. factor + ! call wiso_kmolv10(iso,ustar,alpkn) !get kinetic frac. factor + call wiso_kmol(iso,rbot,zbot,ustar,alpkn) !Advanced kinetic frac. routine + + if(rocn .eq. 0._r8) then !no ocean model data: + Roce = wiso_get_roce(iso) !set to default value + else !isotopic ocean model present: + R_std = wiso_get_rstd(iso) !pull ratio from ocean data + Roce = R_std*rocn + end if !rocn value +! +!----------------------------------------------- +!David Noone (Merlivat and Jouzel, 1979) version +!----------------------------------------------- +! +! Compute the vapour deficit then, get the fluxes +! + delq = wtbot - ssq*Roce/alpha + + qstar = re*delq + tau = rbot * ustar * ustar + + qflx = tau*alpkn*qstar/ustar +! +!--------------------- +!Schmidt, 1999 version +!--------------------- +! +! rh = qbot/ssq !calculate relative humidity +! +!If RH is 100%, then assume no evaporation occurs (although isotopic equilibration does, which needs to be coded in) +! +! if(rh /= 1) then +! Rate = alpkn*(Roce/alpha - (rh*wtbot/qbot))/(1-rh) !calculate ratio in flux +! else +! Rate = 0 !Assume no evaporation occurs if RH is 100% +! end if +! +! qflx = Rate*qe !convert to specific humidity (qi) + + return +end subroutine wiso_flxoce + +!======================================================================= + function wiso_heff(h0) +!----------------------------------------------------------------------- +! Purpose: Compute effective humidity (Jouzel type thing) +! Author: David Noone - Fri Oct 24 12:06:55 PDT 2003 +!----------------------------------------------------------------------- + real(r8), intent(in) :: h0 ! initial humidity + real(r8) :: wiso_heff ! return humidity (subsaturation) +!----------------------------------------------------------------------- + wiso_heff = min(1.0_r8, fkhum*h0 + 1.0_r8-fkhum) + return +end function wiso_heff + +!======================================================================= +function wiso_ssatf(tk) +!----------------------------------------------------------------------- +! Purpose: Compute supersaturation based on temperature parameterization. +! Author: David Noone - Sun Jun 29 20:29:14 MDT 2003 +!----------------------------------------------------------------------- + real(r8), intent(in) :: tk ! temperature + real(r8) :: wiso_ssatf ! return supersaturation +!----------------------------------------------------------------------- +#ifdef OLDWAY + wiso_ssatf = max(1.0_r8, fsata + fsatb*(tk-tzero)) +#else + wiso_ssatf = fsata + fsatb*(tk-tzero) +!! wiso_ssatf = max(wiso_ssatf, fsata) + wiso_ssatf = max(wiso_ssatf, 1.0_r8) + wiso_ssatf = min(wiso_ssatf, ssatmx) +#endif + return +end function wiso_ssatf + +!---------------------- +!Data checking routines: +!---------------------- + +!======================================================================= + function wiso_get_rstd(isp) +!----------------------------------------------------------------------- +! Purpose: Retrieve internal Rstd variable, based on species index +! Author: David Noone - Sun Jun 29 20:29:14 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species index + real(r8) :: wiso_get_rstd ! return isotope ratio +!----------------------------------------------------------------------- + wiso_get_rstd = rstd(isp) + return + end function wiso_get_rstd + +!======================================================================= + function wiso_get_fisub(isp) +!----------------------------------------------------------------------- +! Purpose: Retrieve internal fisub variable, based on species index +! Author: David Noone - Sun Jun 29 20:28:52 MDT 2003 +!----------------------------------------------------------------------- + integer , intent(in) :: isp ! species index + real(r8) :: wiso_get_fisub ! return number of substitutions +!----------------------------------------------------------------------- + wiso_get_fisub = fisub(isp) + return + end function wiso_get_fisub + +!======================================================================= + function wiso_get_ispec(name) +!----------------------------------------------------------------------- +! Purpose: Retrieve speciies index, based on species name +! Author: Chuck Bardeen +!----------------------------------------------------------------------- + character(len=*), intent(in) :: name ! species name + integer :: wiso_get_ispec ! return species index +!----------------------------------------------------------------------- + do wiso_get_ispec = 1, pwtspec + if (name == spnam(wiso_get_ispec)) then + return + end if + end do + wiso_get_ispec = ispundef + return + end function wiso_get_ispec + +!======================================================================= + function wiso_ratio(isp,qiso,qtot) +!----------------------------------------------------------------------- +! Purpose: Compute isotopic ratio from masses, with numerical checks +! Author David Noone - Tue Jul 1 08:32:45 MDT 2003 +!----------------------------------------------------------------------- + integer, intent(in) :: isp ! species index + real(r8),intent(in) :: qiso ! isotopic mass + real(r8),intent(in) :: qtot ! isotopic mass + real(r8) :: wiso_ratio ! return value +!----------------------------------------------------------------------- +! TBD: This qtiny is different than found in the equivalent routine in +! water _tracers. Also, this value is larger than the smallest support +! mixing ratios, and probably should be made smaller so as not to +! produce incorrect ratios for small values. + real(r8) :: qtiny = 1.e-16_r8 +!----------------------------------------------------------------------- + if (qtot > 0._r8) then + wiso_ratio = qiso/(qtot+qtiny) + else + wiso_ratio = qiso/(qtot-qtiny) + end if +!! wiso_ratio = espmw(isp)*wiso_ratio/fisum(isp) ! correct! + end function wiso_ratio + +!======================================================================= + function wiso_delta(isp,qiso,qtot) +!----------------------------------------------------------------------- +! Purpose: Compute isotopic delta value from masses +! Author David Noone - Tue Jul 1 08:32:45 MDT 2003 +!----------------------------------------------------------------------- + integer, intent(in) :: isp ! species index + real(r8),intent(in) :: qiso ! isotopic mass + real(r8),intent(in) :: qtot ! isotopic mass + real(r8) :: wiso_delta ! return value +!----------------------------------------------------------------------- + wiso_delta = 1000._r8 * (wiso_ratio(isp,qiso,qtot) / Rstd(isp) - 1._r8) + return + end function wiso_delta + +!========================================================================= +end module water_isotopes + diff --git a/share/csm_share/shr/water_types.F90 b/share/csm_share/shr/water_types.F90 new file mode 100644 index 000000000000..c1144eeb2c45 --- /dev/null +++ b/share/csm_share/shr/water_types.F90 @@ -0,0 +1,160 @@ + +module water_types + +!----------------------------------------------------------------------- +! +! Provide core functionality for types of condensed water to be used +! with the water vapor tracers. +! +! This module works in with "water_isotopes" and "water_tracers". +! +! All interface routine are identified by wtype_*, etc. +! +! 5 types of water are available, three phases (vapor, cloud liquid +! and cloud ice) and precipitation (rain and snow). +! +! Author: Chuck Bardeen (2/4/2012) +!----------------------------------------------------------------------- + use shr_kind_mod, only: r8 => shr_kind_r8 + + implicit none + + private + save + +!------------------------ Module Interfaces ----------------------------- +! +! Public interfaces +! + public :: wtype_init ! initilize water types + public :: wtype_get_itype ! lookup a species index by name + + public :: wtype_get_alpha ! isotope fractionation + + +!------------------- Module Variable Declarations ----------------------- +! +! Water tracer type identifiers + integer, parameter, public :: pwtype = 7 ! number of water types + + integer, parameter, public :: iwtundef = 0 ! not water type + integer, parameter, public :: iwtvap = 1 ! water type is vapour + integer, parameter, public :: iwtliq = 2 ! water type is liquid + integer, parameter, public :: iwtice = 3 ! water type is ice + integer, parameter, public :: iwtstrain = 4 ! water type is stratiform rain + integer, parameter, public :: iwtstsnow = 5 ! water type is stratiform snow + integer, parameter, public :: iwtcvrain = 6 ! water type is convective rain + integer, parameter, public :: iwtcvsnow = 7 ! water type is convective snow + +! Water type names + character(len=8), dimension(pwtype), parameter, public :: & ! water type names + wtype_names = (/ 'VAPOR ', 'LIQUID ', 'ICE ', 'RAINS ', 'SNOWS ', 'RAINC ', 'SNOWC ' /) + +! Water type Suffix +character(len=2), dimension(pwtype), parameter, public :: & ! suffix names + wtype_suffix = (/ '_v', '_l', '_i', '_R', '_S', '_r', '_s' /) + + +! +!----------------------------------------------------------------------- +contains + +!======================================================================= + subroutine wtype_init +!----------------------------------------------------------------------- +! Purpose: Initialize module internal data arrays +!----------------------------------------------------------------------- + write(6,*) 'WTYPE_INIT: Initializing water types.' + return + end subroutine wtype_init + + +!======================================================================= + function wtype_get_itype(name) +!----------------------------------------------------------------------- +! Purpose: Retrieve type index, based on type name +! Author: Chuck Bardeen +!----------------------------------------------------------------------- + character(len=*), intent(in) :: name ! water type name + integer :: wtype_get_itype ! return species index +!----------------------------------------------------------------------- + do wtype_get_itype = 1, pwtype + if (name == wtype_names(wtype_get_itype)) then + return + end if + end do + + wtype_get_itype = iwtundef + + return + end function wtype_get_itype + +!========================================================================= + + +!======================================================================= + function wtype_get_alpha(ispec, isrctype, idsttype, tk, rh, do_kinetic) +!----------------------------------------------------------------------- +! Purpose: Retrieve the fractionation for a process that goes from +! the source water type to the destination water type. +! +! Author: Chuck Bardeen +!----------------------------------------------------------------------- + use water_isotopes, only : wiso_alpl, wiso_alpi, wiso_akel, wiso_akci + + integer, intent(in) :: ispec ! isotope species index + integer, intent(in) :: isrctype ! source water type index + integer, intent(in) :: idsttype ! destination water type index + real(r8), intent(in) :: tk ! temperature (K) + real(r8), intent(in) :: rh ! relative humidity (fraction) + logical, intent(in) :: do_kinetic ! use kinetic calculation + real(r8) :: wtype_get_alpha ! return alpha + +!----------------------------------------------------------------------- + + ! If their types are the same, then no fractionation occurs. + wtype_get_alpha = 1._r8 + + if (isrctype /= idsttype) then + + ! Is the source vapor? + if (isrctype == iwtvap) then + + ! Is the destination a liquid? + if ((idsttype == iwtliq) .or. (idsttype == iwtstrain) .or. (idsttype == iwtcvrain)) then + wtype_get_alpha = wiso_alpl(ispec,tk) + + if (do_kinetic) then + wtype_get_alpha = wiso_akel(ispec,tk,rh,wtype_get_alpha) + end if + else + wtype_get_alpha = wiso_alpi(ispec,tk) + + if (do_kinetic) then + wtype_get_alpha = wiso_akci(ispec,tk,wtype_get_alpha) + end if + end if + + ! Is the destination vapor? + else if (idsttype == iwtvap) then + + ! Is the source a liquid? + if ((isrctype == iwtliq) .or. (isrctype == iwtstrain) .or. (isrctype == iwtcvrain)) then + wtype_get_alpha = wiso_alpl(ispec,tk) + + if (do_kinetic) then + wtype_get_alpha = wiso_akel(ispec,tk,rh,wtype_get_alpha) + end if + wtype_get_alpha = 1._r8 / wtype_get_alpha + else + wtype_get_alpha = 1._r8 !No fractionation occurs during sublimation + end if + end if + end if + + return + end function wtype_get_alpha + +!========================================================================= + +end module water_types diff --git a/utils/python/CIME/SystemTests/erp.py b/utils/python/CIME/SystemTests/erp.py index ee55439e90dd..39d928fdd0e6 100644 --- a/utils/python/CIME/SystemTests/erp.py +++ b/utils/python/CIME/SystemTests/erp.py @@ -12,6 +12,7 @@ from CIME.XML.standard_module_setup import * from CIME.case import Case from CIME.case_setup import case_setup +from CIME.preview_namelists import preview_namelists import CIME.utils from system_tests_common import SystemTestsCommon @@ -24,23 +25,39 @@ def __init__(self, case): initialize a test object """ SystemTestsCommon.__init__(self, case) - + def build(self, sharedlib_only=False, model_only=False): """ Build two cases. Case one uses defaults, case2 uses half the number of threads and tasks. This test will fail for components (e.g. pop) that do not reproduce exactly with different numbers of mpi tasks. """ + if sharedlib_only: + SystemTestsCommon.build(self, sharedlib_only=sharedlib_only, model_only=model_only) + return + exeroot = self._case.get_value("EXEROOT") cime_model = CIME.utils.get_model() + # Make backup copies of the ORIGINAL env_mach_pes.xml and + # env_build.xml in LockedFiles if they are not there. If there + # are already copies there then simply copy them back to + # have the starting env_mach_pes.xml and env_build.xml machpes1 = os.path.join("LockedFiles","env_mach_pes.ERP1.xml") + envbuild1 = os.path.join("LockedFiles","env_build.ERP1.xml") if ( os.path.isfile(machpes1) ): shutil.copy(machpes1,"env_mach_pes.xml") else: - logging.warn("Copying env_mach_pes.xml to %s"%(machpes1)) - shutil.copy("env_mach_pes.xml", machpes1) + shutil.copy("env_mach_pes.xml","env_mach_pes.ERP1.xml") + + if ( os.path.isfile(envbuild1) ): + shutil.copy(envbuild1,"env_build.xml") + # Build two executables, one using the original tasks and threads (ERP1) and + # one using the modified tasks and threads (ERP2) + # The reason we currently need two executables that CESM-CICE has a compile time decomposition + # For cases where ERP works, changing this decomposition will not effect answers, but it will + # effect the executable that is used self._case.set_value("SMP_BUILD","0") for bld in range(1,3): logging.warn("Starting bld %s"%bld) @@ -58,104 +75,83 @@ def build(self, sharedlib_only=False, model_only=False): self._case.set_value("NTASKS_%s"%comp, ntasks/2) self._case.set_value("ROOTPE_%s"%comp, rootpe/2) - self._case.flush() - case_setup(self._case, test_mode=True, reset=True) - self.clean_build() - SystemTestsCommon.build(self, sharedlib_only=sharedlib_only, model_only=model_only) - if (not sharedlib_only): - shutil.move("%s/%s.exe"%(exeroot,cime_model), - "%s/%s.exe.ERP%s"%(exeroot,cime_model,bld)) - - shutil.copy("env_mach_pes.xml", "env_mach_pes.xml.%s"%bld ) - # - # Because mira/cetus interprets its run script differently than - # other systems we need to copy the original env_mach_pes.xml back - # - shutil.copy(machpes1,"env_mach_pes.xml") - shutil.copy("env_mach_pes.xml", os.path.join("LockedFiles","env_mach_pes.xml")) - - def _erp_first_phase(self): - - # Reset beginning test settings - expect(os.path.isfile("env_mach_pes.xml.1"), - "ERROR: env_mach_pes.xml.1 does not exist, run case.build" ) +# self._case.flush() - shutil.copy("env_mach_pes.xml.1", "env_mach_pes.xml") - shutil.copy("env_mach_pes.xml.1", "LockedFiles/env_mach_pes.xml") - - exeroot = self._case.get_value("EXEROOT") - cime_model = CIME.utils.get_model() - exefile = "%s/%s.exe"%(exeroot,cime_model) - exefile1 = "%s/%s.exe.ERP1"%(exeroot,cime_model) - if (os.path.isfile(exefile)): - os.remove(exefile) - shutil.copy(exefile1, exefile) - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") - expect(stop_n > 0, "Bad STOP_N: %d" % stop_n) - - rest_n = stop_n/2 + 1 - self._case.set_value("REST_N", rest_n) - self._case.set_value("REST_OPTION", stop_option) - self._case.set_value("HIST_N", stop_n) - self._case.set_value("HIST_OPTION", stop_option) - self._case.set_value("CONTINUE_RUN", False) - self._case.flush() - - expect(stop_n > 2, "ERROR: stop_n value %d too short"%stop_n) - logger.info("doing an %s %s initial test with restart file at %s %s" - %(str(stop_n), stop_option, str(rest_n), stop_option)) - - return SystemTestsCommon.run(self) - - def _erp_second_phase(self): - - expect(os.path.isfile("env_mach_pes.xml.2"), - "ERROR: env_mach_pes.xml.2 does not exist, run case.build" ) - - shutil.copy("env_mach_pes.xml.2", "env_mach_pes.xml") - shutil.copy("env_mach_pes.xml.2", "LockedFiles/env_mach_pes.xml") - - exeroot = self._case.get_value("EXEROOT") - cime_model = CIME.utils.get_model() - exefile = "%s/%s.exe"%(exeroot,cime_model) - exefile2 = "%s/%s.exe.ERP2"%(exeroot,cime_model) - if (os.path.isfile(exefile)): - os.remove(exefile) - shutil.copy(exefile2, exefile) - - #FIXME - this is where env_mach_pes.xml.1 seems to be rewritten to env_mach_pes.xml - #case_setup(self._case, test_mode=True, reset=True) - - stop_n = self._case.get_value("STOP_N") - stop_option = self._case.get_value("STOP_OPTION") + # Note, some components, like CESM-CICE, have + # decomposition information in env_build.xml + # case_setup(self._case, test_mode=True, reset=True)that + # needs to be regenerated for the above new tasks and thread counts + case_setup(self._case, test_mode=True, reset=True) - rest_n = stop_n/2 + 1 - stop_new = stop_n - rest_n - expect(stop_new > 0, "ERROR: stop_n value %d too short %d %d"%(stop_new,stop_n,rest_n)) + # update the case to the new values +# self._case = None +# self._case = Case(self._caseroot) - self._case.set_value("STOP_N", stop_new) - self._case.set_value("CONTINUE_RUN", True) - self._case.set_value("REST_OPTION","never") - self._case.flush() + # Now rebuild the system, given updated information in env_build.xml - logger.info("doing an %s %s restart test" %(str(stop_new), stop_option)) - success = SystemTestsCommon._run(self, "rest") + SystemTestsCommon.build(self, sharedlib_only=sharedlib_only, model_only=model_only) + shutil.move("%s/%s.exe"%(exeroot,cime_model), + "%s/%s.ERP%s.exe"%(exeroot,cime_model,bld)) - # Compare restart file - if success: - return self._component_compare_test("base", "rest") - else: - return False + # Make copies of the new env_mach_pes.xml and the new + # env_build.xml to be used in the run phase + shutil.copy("env_mach_pes.xml", os.path.join("LockedFiles","env_mach_pes.ERP%s.xml"%bld )) + shutil.copy("env_build.xml", os.path.join("LockedFiles","env_build.ERP%s.xml"%bld )) + # + # def run(self): - success = self._erp_first_phase() + # run will have values 1,2 + for run in range(1,3): + + expect(os.path.isfile(os.path.join("LockedFiles","env_mach_pes.ERP%d.xml"%run)), + "ERROR: LockedFiles/env_mach_pes.ERP%d.xml does not exist, run case.build"%run ) + + # Use the second env_mach_pes.xml and env_build.xml files + shutil.copy(os.path.join("LockedFiles","env_mach_pes.ERP%d.xml"%run), "env_mach_pes.xml") + shutil.copy("env_mach_pes.xml", os.path.join("LockedFiles","env_mach_pes.xml")) + shutil.copy(os.path.join("LockedFiles","env_build.ERP%d.xml")%run, "env_build.xml") + shutil.copy("env_build.xml", os.path.join("LockedFiles","env_build.xml")) + + # update the case to use the new values + self._case.read_xml(self._caseroot) + + # Use the second executable that was created + exeroot = self._case.get_value("EXEROOT") + cime_model = CIME.utils.get_model() + exefile = os.path.join(exeroot,"%s.exe"%(cime_model)) + exefile2 = os.path.join(exeroot,"%s.ERP%d.exe"%(cime_model,run)) + if (os.path.isfile(exefile)): + os.remove(exefile) + shutil.copy(exefile2, exefile) + + case_setup(self._case, test_mode=True, reset=True) + stop_n = self._case.get_value("STOP_N") + stop_option = self._case.get_value("STOP_OPTION") + + if run == 1: + expect(stop_n > 2, "ERROR: stop_n value %d too short"%stop_n) + rest_n = stop_n/2 + 1 + self._case.set_value("REST_N", rest_n) + self._case.set_value("REST_OPTION", stop_option) + self._case.set_value("HIST_N", stop_n) + self._case.set_value("HIST_OPTION", stop_option) + self._case.set_value("CONTINUE_RUN", False) + suffix = "base" + else: + rest_n = stop_n/2 + 1 + stop_new = stop_n - rest_n + expect(stop_new > 0, "ERROR: stop_n value %d too short %d %d"%(stop_new,stop_n,rest_n)) + self._case.set_value("STOP_N", stop_new) + self._case.set_value("CONTINUE_RUN", True) + self._case.set_value("REST_OPTION","never") + suffix = "rest" + success = SystemTestsCommon._run(self, suffix=suffix) + if not success: + break + + return success - if success: - return self._erp_second_phase() - else: - return False def report(self): SystemTestsCommon.report(self) diff --git a/utils/python/CIME/case.py b/utils/python/CIME/case.py index 96911a664bec..51742e263505 100644 --- a/utils/python/CIME/case.py +++ b/utils/python/CIME/case.py @@ -71,19 +71,7 @@ def __init__(self, case_root=None): self._env_files_that_need_rewrite = set() logger.debug("Initializing Case.") - - self._env_entryid_files = [] - self._env_entryid_files.append(EnvRun(case_root)) - self._env_entryid_files.append(EnvBuild(case_root)) - self._env_entryid_files.append(EnvMachPes(case_root)) - self._env_entryid_files.append(EnvCase(case_root)) - self._env_entryid_files.append(EnvBatch(case_root)) - if os.path.isfile(os.path.join(case_root,"env_test.xml")): - self._env_entryid_files.append(EnvTest(case_root)) - self._env_generic_files = [] - self._env_generic_files.append(EnvMachSpecific(case_root)) - self._env_generic_files.append(EnvArchive(case_root)) - self._files = self._env_entryid_files + self._env_generic_files + self.read_xml(case_root) # Hold arbitary values. In create_newcase we may set values # for xml files that haven't been created yet. We need a place @@ -103,6 +91,21 @@ def __init__(self, case_root=None): self._component_config_files = [] self._component_classes = [] + def read_xml(self, case_root): + expect(len(self._env_files_that_need_rewrite)==0,"Case object has modifications that would be overwritten by read_xml") + self._env_entryid_files = [] + self._env_entryid_files.append(EnvRun(case_root)) + self._env_entryid_files.append(EnvBuild(case_root)) + self._env_entryid_files.append(EnvMachPes(case_root)) + self._env_entryid_files.append(EnvCase(case_root)) + self._env_entryid_files.append(EnvBatch(case_root)) + if os.path.isfile(os.path.join(case_root,"env_test.xml")): + self._env_entryid_files.append(EnvTest(case_root)) + self._env_generic_files = [] + self._env_generic_files.append(EnvMachSpecific(case_root)) + self._env_generic_files.append(EnvArchive(case_root)) + self._files = self._env_entryid_files + self._env_generic_files + def __del__(self): self.flush() diff --git a/utils/python/CIME/preview_namelists.py b/utils/python/CIME/preview_namelists.py index a85fa2dc775a..b829ea07843c 100644 --- a/utils/python/CIME/preview_namelists.py +++ b/utils/python/CIME/preview_namelists.py @@ -10,6 +10,9 @@ logger = logging.getLogger(__name__) def preview_namelists(case, dryrun=False, casedir=None): + # refresh case xml files from object + case.flush() + # Get data from XML exeroot = case.get_value("EXEROOT") libroot = case.get_value("LIBROOT") @@ -72,7 +75,8 @@ def preview_namelists(case, dryrun=False, casedir=None): run_cmd("PREVIEW_NML=1 %s %s" % (cmd, caseroot)) else: run_cmd("%s %s" % (cmd, caseroot)) - + # refresh case xml object from file + case.read_xml(caseroot) # Save namelists to docdir if (not os.path.isdir(docdir)): os.makedirs(docdir)