diff --git a/.github/workflows/spack-ci.yml b/.github/workflows/spack-ci.yml index 7651942f..60c9288d 100644 --- a/.github/workflows/spack-ci.yml +++ b/.github/workflows/spack-ci.yml @@ -94,9 +94,8 @@ jobs: shell: spack-bash {0} run: | spack -e spack-env mirror add geos-buildcache oci://ghcr.io/GEOS-ESM/geos-buildcache - spack -e spack-env mirror set --oci-username ${{ github.actor }} --oci-password "${{ secrets.BUILDCACHE_TOKEN }}" geos-buildcache + spack -e spack-env mirror set --oci-username-variable "${{ secrets.BUILDCACHE_USERNAME }}" --oci-password-variable "${{ secrets.BUILDCACHE_TOKEN }}" geos-buildcache spack -e spack-env mirror list - spack -e spack-env buildcache update-index geos-buildcache spack -e spack-env buildcache list --allarch - name: Concretize @@ -190,9 +189,8 @@ jobs: shell: spack-bash {0} run: | spack -e spack-env mirror add geos-buildcache oci://ghcr.io/GEOS-ESM/geos-buildcache - spack -e spack-env mirror set --oci-username ${{ github.actor }} --oci-password "${{ secrets.BUILDCACHE_TOKEN }}" geos-buildcache + spack -e spack-env mirror set --oci-username-variable "${{ secrets.BUILDCACHE_USERNAME }}" --oci-password-variable "${{ secrets.BUILDCACHE_TOKEN }}" geos-buildcache spack -e spack-env mirror list - spack -e spack-env buildcache update-index geos-buildcache spack -e spack-env buildcache list --allarch - name: Concretize diff --git a/ESMF/GOCART2G_GridComp/GOCART2G_GridCompMod.F90 b/ESMF/GOCART2G_GridComp/GOCART2G_GridCompMod.F90 index 3450b616..1d21c41b 100644 --- a/ESMF/GOCART2G_GridComp/GOCART2G_GridCompMod.F90 +++ b/ESMF/GOCART2G_GridComp/GOCART2G_GridCompMod.F90 @@ -8,9 +8,7 @@ module GOCART2G_GridCompMod !USES: use ESMF use mapl_ErrorHandling, only: MAPL_Verify, MAPL_Return, MAPL_Assert - use MAPL_Constants, only: MAPL_R4, MAPL_GRAV, MAPL_PI - - use MAPL, only: MAPL2_GetPointer => MAPL_GetPointer + use MAPL_Constants, only: MAPL_GRAV, MAPL_PI use mapl3g_generic, only: MAPL_GridCompSetEntryPoint, MAPL_GridCompGet, MAPL_GridCompAddSpec use mapl3g_generic, only: MAPL_GridCompAddChild, MAPL_GridCompAddConnectivity, MAPL_GridCompRunChildren @@ -19,6 +17,7 @@ module GOCART2G_GridCompMod use mapl3g_generic, only: MAPL_STATEITEM_STATE, MAPL_STATEITEM_FIELDBUNDLE use mapl3g_RestartModes, only: MAPL_RESTART_SKIP use mapl3g_VerticalStaggerLoc, only: VERTICAL_STAGGER_NONE, VERTICAL_STAGGER_CENTER, VERTICAL_STAGGER_EDGE + use mapl3g_FieldBundle_API, only: MAPL_FieldBundleAdd use mapl3g_State_API, only: MAPL_StateGetPointer use mapl3g_Geom_API, only: MAPL_GridGet use mapl3g_UngriddedDim, only: UngriddedDim @@ -249,34 +248,37 @@ end subroutine SetServices subroutine Initialize (gc, import, export, clock, rc) !ARGUMENTS: - type (ESMF_GridComp) :: gc ! Gridded component - type (ESMF_State) :: import ! Import state - type (ESMF_State) :: export ! Export state - type (ESMF_Clock) :: clock ! The clock - integer, intent(out) :: rc ! Error code + type(ESMF_GridComp) :: gc ! Gridded component + type(ESMF_State) :: import ! Import state + type(ESMF_State) :: export ! Export state + type(ESMF_Clock) :: clock ! The clock + integer, intent(out) :: rc ! Error code !DESCRIPTION: This initializes the GOCART Grid Component. It primarily creates ! its exports and births its children. - !REVISION HISTORY: ! 14oct2019 E.Sherman First attempt at refactoring !EOP - - character (len=ESMF_MAXSTR) :: comp_name - type (ESMF_Grid) :: grid - type (GOCART_State), pointer :: self - type (wrap_) :: wrap + + type(ESMF_Geom) :: geom + type(ESMF_Grid) :: grid + type(ESMF_State) :: aero + type(ESMF_Info) :: info + type(GOCART_State), pointer :: self + type(wrap_) :: wrap + ! integer :: n_modes + character(len=ESMF_MAXSTR), allocatable :: aero_aci_modes(:) + real :: maxclean, ccntuning integer :: im, jm, km class(logger_t), pointer :: logger integer :: status ! Get the target components name and set-up traceback handle. - call ESMF_GridCompGet (gc, name=comp_name, _RC) call MAPL_GridCompGet(gc, logger=logger, _RC) call logger%info("Initialize:: starting...") - call MAPL_GridCompGet(gc, grid=grid, num_levels=km, _RC) + call MAPL_GridCompGet(gc, geom=geom, grid=grid, num_levels=km, _RC) call MAPL_GridGet(grid, im=im, jm=jm, _RC) ! Get my internal state @@ -289,8 +291,7 @@ subroutine Initialize (gc, import, export, clock, rc) ! ! Get children and their export states from my generic state ! call MAPL_Get (MAPL, gcs=gcs, gex=gex, _RC ) - ! ! Fill AERO_RAD, AERO_ACI, and AERO_DP with the children's states - ! call ESMF_StateGet (export, 'AERO', aero, _RC) + ! Fill AERO_RAD, AERO_ACI, and AERO_DP with the children's states ! call ESMF_StateGet (export, 'AERO_DP', aero_dp, _RC) ! ! Add children's AERO states to GOCART2G's AERO states @@ -301,96 +302,89 @@ subroutine Initialize (gc, import, export, clock, rc) ! call add_aero_states_(self%CA%instances(:)) ! call add_aero_states_(self%NI%instances(:)) - ! ! Begin AERO_RAD - ! ! Add variables to AERO_RAD state. Used in aerosol optics calculations - ! call add_aero (aero, label='air_pressure_for_aerosol_optics', label2='PLE', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='relative_humidity_for_aerosol_optics', label2='RH', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='extinction_in_air_due_to_ambient_aerosol', label2='EXT', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='single_scattering_albedo_of_ambient_aerosol', label2='SSA', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='asymmetry_parameter_of_ambient_aerosol', label2='ASY', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='monochromatic_extinction_in_air_due_to_ambient_aerosol', & - ! label2='monochromatic_EXT', grid=grid, typekind=MAPL_R4, _RC) - - ! ! Used in get_mixRatioSum - ! call add_aero (aero, label='sum_of_internalState_aerosol_DU', label2='aerosolSumDU', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_SS', label2='aerosolSumSS', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_NI', label2='aerosolSumNI', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_CA.oc', label2='aerosolSumCA.oc', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_CA.bc', label2='aerosolSumCA.bc', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_CA.br', label2='aerosolSumCA.br', & - ! grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='sum_of_internalState_aerosol_SU', label2='aerosolSumSU', & - ! grid=grid, typekind=MAPL_R4, _RC) - - ! call ESMF_AttributeSet(aero, name='band_for_aerosol_optics', value=0, _RC) - ! call ESMF_AttributeSet(aero, name='wavelength_for_aerosol_optics', value=0., _RC) - ! call ESMF_AttributeSet(aero, name='aerosolName', value='', _RC) - ! call ESMF_AttributeSet(aero, name='im', value=dims(1), _RC) - ! call ESMF_AttributeSet(aero, name='jm', value=dims(2), _RC) - ! call ESMF_AttributeSet(aero, name='km', value=dims(3), _RC) - - ! ! Attach method to return sum of aerosols. Used in GAAS. - ! call ESMF_MethodAdd (aero, label='get_mixRatioSum', userRoutine=get_mixRatioSum, _RC) - - ! ! Attach method to create a Bundle of aerosol fields. Used in GAAS. - ! call ESMF_MethodAdd (aero, label='serialize_bundle', userRoutine=serialize_bundle, _RC) - - ! ! Attach the monochromatic aerosol optics method. Used in GAAS. - ! call ESMF_MethodAdd (aero, label='get_monochromatic_aop', & - ! userRoutine=get_monochromatic_aop, _RC) - - ! ! Attach the aerosol optics method. Used in Radiation. - ! call ESMF_MethodAdd (aero, label='run_aerosol_optics', userRoutine=run_aerosol_optics, _RC) - - ! ! This attribute indicates if the aerosol optics method is implemented or not. - ! ! Radiation will not call the aerosol optics method unless this attribute is - ! ! explicitly set to true. - ! call ESMF_AttributeSet(aero, name='implements_aerosol_optics_method', value=.true., _RC) - - ! ! Begin adding necessary aerosol cloud interaction information - ! aero_aci_modes = [ & - ! 'du001 ', 'du002 ', 'du003 ', & - ! 'du004 ', 'du005 ', & - ! 'ss001 ', 'ss002 ', 'ss003 ', & - ! 'sulforg01', 'sulforg02', 'sulforg03', & - ! 'bcphilic ', 'ocphilic ', 'brcphilic'} - + ! Begin AERO_RAD + call ESMF_StateGet(export, 'AERO', aero, _RC) + ! Add variables to AERO_RAD state. Used in aerosol optics calculations + call add_aero(aero, label='air_pressure_for_aerosol_optics', label2='PLE', geom=geom, km=km, _RC) + call add_aero(aero, label='relative_humidity_for_aerosol_optics', label2='RH', geom=geom, km=km, _RC) + call add_aero(aero, label='extinction_in_air_due_to_ambient_aerosol', label2='EXT', geom=geom, km=km, _RC) + call add_aero(aero, label='single_scattering_albedo_of_ambient_aerosol', label2='SSA', geom=geom, km=km, _RC) + call add_aero(aero, label='asymmetry_parameter_of_ambient_aerosol', label2='ASY', geom=geom, km=km, _RC) + call add_aero( & + aero, & + label='monochromatic_extinction_in_air_due_to_ambient_aerosol', label2='monochromatic_EXT', & + geom=geom, _RC) + + ! Used in get_mixRatioSum + call add_aero(aero, label='sum_of_internalState_aerosol_DU', label2='aerosolSumDU', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_SS', label2='aerosolSumSS', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_NI', label2='aerosolSumNI', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_CA.oc', label2='aerosolSumCA.oc', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_CA.bc', label2='aerosolSumCA.bc', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_CA.br', label2='aerosolSumCA.br', geom=geom, km=km, _RC) + call add_aero(aero, label='sum_of_internalState_aerosol_SU', label2='aerosolSumSU', geom=geom, km=km, _RC) + + call ESMF_InfoGetFromHost(aero, info, _RC) + call ESMF_InfoSet(info, key="band_for_aerosol_optics", value=0, _RC) + call ESMF_InfoSet(info, key="wavelength_for_aerosol_optics", value=0., _RC) + call ESMF_InfoSet(info, key="aerosolName", value="", _RC) + call ESMF_InfoSet(info, key="im", value=im, _RC) + call ESMF_InfoSet(info, key="jm", value=jm, _RC) + call ESMF_InfoSet(info, key="km", value=km, _RC) + + ! Attach method to return sum of aerosols. Used in GAAS. + call ESMF_MethodAdd(aero, label='get_mixRatioSum', userRoutine=get_mixRatioSum, _RC) + + ! Attach method to create a Bundle of aerosol fields. Used in GAAS. + call ESMF_MethodAdd(aero, label='serialize_bundle', userRoutine=serialize_bundle, _RC) + + ! Attach the monochromatic aerosol optics method. Used in GAAS. + call ESMF_MethodAdd(aero, label='get_monochromatic_aop', userRoutine=get_monochromatic_aop, _RC) + + ! Attach the aerosol optics method. Used in Radiation. + call ESMF_MethodAdd(aero, label='run_aerosol_optics', userRoutine=run_aerosol_optics, _RC) + + ! This attribute indicates if the aerosol optics method is implemented or not. + ! Radiation will not call the aerosol optics method unless this attribute is + ! explicitly set to true. + call ESMF_InfoSet(info, key='implements_aerosol_optics_method', value=.true., _RC) + + ! Begin adding necessary aerosol cloud interaction information + aero_aci_modes = [ & + 'du001 ', 'du002 ', 'du003 ', & + 'du004 ', 'du005 ', & + 'ss001 ', 'ss002 ', 'ss003 ', & + 'sulforg01', 'sulforg02', 'sulforg03', & + 'bcphilic ', 'ocphilic ', 'brcphilic'] ! n_modes = size(aero_aci_modes) - ! call ESMF_AttributeSet(aero, name='number_of_aerosol_modes', value=n_modes, _RC) - ! call ESMF_AttributeSet(aero, name='aerosol_modes', itemcount=n_modes, valuelist=aero_aci_modes, _RC) + ! call ESMF_InfoSet(info, key='number_of_aerosol_modes', value=n_modes, _RC) + call ESMF_InfoSet(info, key='aerosol_modes', values=aero_aci_modes, _RC) - ! ! max mixing ratio before switching to "polluted" size distributions - ! call ESMF_ConfigGetAttribute(CF, maxclean, default=1.0e-9, label='MAXCLEAN:', _RC) - ! call ESMF_AttributeSet(aero, name='max_q_clean', value=maxclean, _RC) + ! max mixing ratio before switching to "polluted" size distributions + call MAPL_GridCompGetResource(gc, "MAXCLEAN", maxclean, default=1.0e-9, _RC) + call ESMF_InfoSet(info, key='max_q_clean', value=maxclean, _RC) ! call ESMF_ConfigGetAttribute(CF, CCNtuning, default=1.8, label='CCNTUNING:', _RC) - ! call ESMF_AttributeSet(aero, name='ccn_tuning', value=CCNtuning, _RC) - - ! ! Add variables to AERO state - ! call add_aero (aero, label='air_temperature', label2='T', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='fraction_of_land_type', label2='FRLAND', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='width_of_aerosol_mode', label2='SIGMA', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='aerosol_number_concentration', label2='NUM', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='aerosol_dry_size', label2='DGN', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='aerosol_density', label2='density', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='aerosol_hygroscopicity', label2='KAPPA', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='fraction_of_dust_aerosol', label2='FDUST', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='fraction_of_soot_aerosol', label2='FSOOT', grid=grid, typekind=MAPL_R4, _RC) - ! call add_aero (aero, label='fraction_of_organic_aerosol', label2='FORGANIC', grid=grid, typekind=MAPL_R4, _RC) - - ! ! Attach the aerosol optics method - ! call ESMF_MethodAdd(aero, label='aerosol_activation_properties', userRoutine=aerosol_activation_properties, _RC) + call MAPL_GridCompGetResource(gc, "CCNTUNING", ccntuning, default=1.8, _RC) + call ESMF_InfoSet(info, key='ccn_tuning', value=ccntuning, _RC) + + ! Add variables to AERO state + call add_aero(aero, label='air_temperature', label2='T', geom=geom, km=km, _RC) + call add_aero(aero, label='fraction_of_land_type', label2='FRLAND', geom=geom, _RC) + call add_aero(aero, label='width_of_aerosol_mode', label2='SIGMA', geom=geom, km=km, _RC) + call add_aero(aero, label='aerosol_number_concentration', label2='NUM', geom=geom, km=km, _RC) + call add_aero(aero, label='aerosol_dry_size', label2='DGN', geom=geom, km=km, _RC) + call add_aero(aero, label='aerosol_density', label2='density', geom=geom, km=km, _RC) + call add_aero(aero, label='aerosol_hygroscopicity', label2='KAPPA', geom=geom, km=km, _RC) + call add_aero(aero, label='fraction_of_dust_aerosol', label2='FDUST', geom=geom, km=km, _RC) + call add_aero(aero, label='fraction_of_soot_aerosol', label2='FSOOT', geom=geom, km=km, _RC) + call add_aero(aero, label='fraction_of_organic_aerosol', label2='FORGANIC', geom=geom, km=km, _RC) + + ! Attach the aerosol optics method + call ESMF_MethodAdd(aero, label='aerosol_activation_properties', userRoutine=aerosol_activation_properties, _RC) + + ! call ESMF_StatePrint(aero, _RC) call logger%info("Initialize:: ...complete") _RETURN(_SUCCESS) @@ -1185,123 +1179,123 @@ subroutine add_children__(gc, species, setservices, rc) _RETURN(_SUCCESS) end subroutine add_children__ -!=================================================================================== -! subroutine serialize_bundle (state, rc) - -! implicit none - -! ! !ARGUMENTS: -! type (ESMF_State) :: state -! integer, intent(out) :: rc - -! ! !Local -! character (len=ESMF_MAXSTR), allocatable :: itemList(:) -! type (ESMF_State) :: child_state -! type (ESMF_StateItem_Flag), allocatable :: itemTypes(:) -! type (ESMF_FieldBundle) :: bundle -! type (ESMF_Grid) :: grid -! type (ESMF_Field) :: field, serializedField - -! character (len=ESMF_MAXSTR) :: binIndexstr -! character (len=ESMF_MAXSTR), allocatable :: aeroName(:) - -! real, pointer, dimension(:,:,:,:) :: orig_ptr -! real, pointer, dimension(:,:,:) :: ptr3d - -! integer :: b, i, j, n, rank, nbins - -! __Iam__('GOCART2G::serialize_bundle') - -! ! !Description: Callback for AERO_RAD state used in GAAS module to provide a -! ! serialized ESMF_Bundle of aerosol fields. -! !----------------------------------------------------------------------------------- -! ! Begin... - -! ! Get list of child states within state and add to aeroList -! ! Remember, AERO_RAD contains its children's AERO_RAD states -! ! ---------------------------------------------------------- -! call ESMF_StateGet (state, itemCount=n, _RC) -! allocate (itemList(n), __STAT__) -! allocate (itemTypes(n), __STAT__) -! call ESMF_StateGet (state, itemNameList=itemList, itemTypeList=itemTypes, _RC) - -! ! Create empty ESMF_FieldBundle to add Children's aerosol fields to -! bundle = ESMF_FieldBundleCreate(name="serialized_aerosolBundle", _RC) -! call MAPL_StateAdd(state, bundle, _RC) - -! do i = 1, n -! if (itemTypes(i) /= ESMF_StateItem_State) cycle ! exclude non-states -! call ESMF_StateGet (state, trim(itemList(i)), child_state, _RC) -! call ESMF_AttributeGet (child_state, name='internal_variable_name', itemCount=nbins, _RC) -! allocate (aeroName(nbins), __STAT__) -! call ESMF_AttributeGet (child_state, name='internal_variable_name', valueList=aeroName, _RC) - - -! do b = 1, size(aeroName) -! call ESMF_StateGet (child_state, trim(aeroName(b)), field, _RC) -! call ESMF_FieldGet (field, rank=rank, _RC) - -! if (rank == 3) then -! call MAPL_FieldBundleAdd (bundle, field, _RC) - -! else if (rank == 4) then ! serialize 4d variables to mulitple 3d variables -! call ESMF_FieldGet (field, grid=grid, _RC) -! call MAPL_GetPointer (child_state, orig_ptr, trim(aeroName(b)), _RC) -! do j = 1, size(orig_ptr, 4) -! write (binIndexstr, '(I0.3)') j -! ptr3d => orig_ptr(:,:,:,j) -! serializedField = ESMF_FieldCreate (grid=grid, datacopyFlag=ESMF_DATACOPY_REFERENCE, & -! farrayPtr=ptr3d, name=trim(aeroName(b))//trim(binIndexstr), _RC) -! call MAPL_FieldBundleAdd (bundle, serializedField, _RC) ! probably need to add a flag to allow for adding multilple fields of the same name. -! end do ! do j -! end if ! if (rank -! end do ! do b -! deallocate (aeroName, __STAT__) -! end do ! do i - -! end subroutine serialize_bundle + subroutine serialize_bundle(state, rc) + !ARGUMENTS: + type(ESMF_State) :: state + integer, intent(out) :: rc + + !Local + character(len=ESMF_MAXSTR), allocatable :: itemList(:) + type(ESMF_State) :: child_state + type(ESMF_StateItem_Flag), allocatable :: itemTypes(:) + type(ESMF_FieldBundle) :: bundle + type(ESMF_Grid) :: grid + type(ESMF_Field) :: field, serializedField + type(ESMF_Info) :: info + + character(len=ESMF_MAXSTR) :: binIndexstr + character(len=ESMF_MAXSTR), allocatable :: aeroName(:) + + real, pointer, dimension(:,:,:,:) :: orig_ptr + real, pointer, dimension(:,:,:) :: ptr3d + + integer :: b, i, j, n, rank, nbins, status + + !Description: Callback for AERO_RAD state used in GAAS module to provide a + ! serialized ESMF_Bundle of aerosol fields. + + ! Get list of child states within state and add to aeroList + ! Remember, AERO_RAD contains its children's AERO_RAD states + call ESMF_StateGet(state, itemCount=n, _RC) + allocate(itemList(n), _STAT) + allocate(itemTypes(n), _STAT) + call ESMF_StateGet(state, itemNameList=itemList, itemTypeList=itemTypes, _RC) + + ! Create empty ESMF_FieldBundle to add Children's aerosol fields to + bundle = ESMF_FieldBundleCreate(name="serialized_aerosolBundle", _RC) + call ESMF_StateAdd(state, [bundle], _RC) + + do i = 1, n + if (itemTypes(i) /= ESMF_STATEITEM_STATE) cycle ! exclude non-states + call ESMF_StateGet(state, trim(itemList(i)), child_state, _RC) + call ESMF_InfoGetFromHost(state, info, _RC) + call ESMF_InfoGet(info, key="internal_variable_name", values=aeroName, _RC) + do b = 1, size(aeroName) + call ESMF_StateGet(child_state, trim(aeroName(b)), field, _RC) + call ESMF_FieldGet(field, rank=rank, _RC) + select case(rank) + case(3) + call MAPL_FieldBundleAdd(bundle, [field], _RC) + case(4) ! serialize 4d variables to mulitple 3d variables + call ESMF_FieldGet(field, grid=grid, _RC) + call MAPL_StateGetPointer(child_state, itemName=trim(aeroName(b)), farrayPtr=orig_ptr, _RC) + do j = 1, size(orig_ptr, 4) + write (binIndexstr, '(I0.3)') j + ptr3d => orig_ptr(:,:,:,j) + ! pchakrab: TODO, we are sharing data here + serializedField = ESMF_FieldCreate( & + grid=grid, & + datacopyFlag=ESMF_DATACOPY_REFERENCE, & + farrayPtr=ptr3d, & + name=trim(aeroName(b))//trim(binIndexstr), _RC) + ! probably need to add a flag to allow for adding multilple fields of the same name + call MAPL_FieldBundleAdd(bundle, [serializedField], _RC) + end do ! do j + case default + _FAIL("rank not supported") + end select ! select case + end do ! do b + deallocate (aeroName, _STAT) + end do ! do i + + _RETURN(_SUCCESS) + end subroutine serialize_bundle subroutine run_aerosol_optics (state, rc) !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc + type(ESMF_State) :: state + integer, intent(out) :: rc !Local - real, dimension(:,:,:), pointer :: ple - real, dimension(:,:,:), pointer :: rh - real, dimension(:,:,:), pointer :: var + real, dimension(:,:,:), pointer :: ple + real, dimension(:,:,:), pointer :: rh + real, dimension(:,:,:), pointer :: var - character (len=ESMF_MAXSTR) :: fld_name + character(len=:), allocatable :: fld_name - real(kind=8), dimension(:,:,:),pointer :: ext_, ssa_, asy_ ! (lon:,lat:,lev:) - real(kind=8), dimension(:,:,:), allocatable :: ext, ssa, asy ! (lon:,lat:,lev:) + real(kind=8), dimension(:,:,:), pointer :: ext_, ssa_, asy_ ! (lon:,lat:,lev:) + real(kind=8), dimension(:,:,:), allocatable :: ext, ssa, asy ! (lon:,lat:,lev:) - integer :: i, n, b, j - integer :: i1, j1, i2, j2, km - integer :: band - integer, parameter :: n_bands = 1 + integer :: i, n, b, j + integer :: i1, j1, i2, j2, km + integer :: band + integer, parameter :: n_bands = 1 - character (len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) - type (ESMF_State) :: child_state - real, pointer, dimension(:,:,:) :: as_ptr_3d + character(len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) + type(ESMF_State) :: child_state + real, pointer, dimension(:,:,:) :: as_ptr_3d - type (ESMF_StateItem_Flag), allocatable :: itemTypes(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypes(:) + type(ESMF_Info) :: info, child_info integer :: status ! Description: Used in Radiation gridded components to provide aerosol properties + call ESMF_InfoGetFromHost(state, info, _RC) + ! Radiation band - call ESMF_AttributeGet(state, name='band_for_aerosol_optics', value=band, _RC) + call ESMF_InfoGet(info, key='band_for_aerosol_optics', value=band, _RC) ! Relative humidity - call ESMF_AttributeGet(state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) - call MAPL2_GetPointer(state, RH, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=rh, _RC) ! Pressure at layer edges - call ESMF_AttributeGet(state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) - call MAPL2_GetPointer(state, PLE, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=ple, _RC) + ! TODO: pchakrab - CAREFUL! In MAPL3 land, PLE is (:, :, 1:km+1), instead of (:, :, 0:km) i1 = lbound(ple, 1); i2 = ubound(ple, 1) j1 = lbound(ple, 2); j2 = ubound(ple, 2) km = ubound(ple, 3) @@ -1312,23 +1306,23 @@ subroutine run_aerosol_optics (state, rc) asy(i1:i2,j1:j2,km), _STAT) ! Get list of child states within state and add to aeroList - call ESMF_StateGet (state, itemCount=n, _RC) - allocate (itemList(n), __STAT__) - allocate (itemTypes(n), __STAT__) - call ESMF_StateGet (state, itemNameList=itemList, itemTypeList=itemTypes, _RC) + call ESMF_StateGet(state, itemCount=n, _RC) + allocate(itemList(n), _STAT) + allocate(itemTypes(n), _STAT) + call ESMF_StateGet(state, itemNameList=itemList, itemTypeList=itemTypes, _RC) b=0 do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then + if (itemTypes(i) == ESMF_STATEITEM_STATE) then b = b + 1 end if end do - allocate (aeroList(b), __STAT__) + allocate (aeroList(b), _STAT) j = 1 do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then + if (itemTypes(i) == ESMF_STATEITEM_STATE) then aeroList(j) = trim(itemList(i)) j = j + 1 end if @@ -1342,70 +1336,72 @@ subroutine run_aerosol_optics (state, rc) do i = 1, size(aeroList) call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) + call ESMF_InfoGetFromHost(child_state, child_info, _RC) + ! set RH in child's aero state - call ESMF_AttributeGet(child_state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(child_info, key='relative_humidity_for_aerosol_optics', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(child_state, as_ptr_3d, trim(fld_name), _RC) + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=as_ptr_3d, _RC) as_ptr_3d = rh end if ! set PLE in child's aero state - call ESMF_AttributeGet(child_state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(child_info, key='air_pressure_for_aerosol_optics', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(child_state, as_ptr_3d, trim(fld_name), _RC) + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=as_ptr_3d, _RC) as_ptr_3d = ple end if ! set band in child's aero state - call ESMF_AttributeSet(child_state, name='band_for_aerosol_optics', value=band, _RC) + call ESMF_InfoSet(child_info, key='band_for_aerosol_optics', value=band, _RC) ! execute the aerosol optics method call ESMF_MethodExecute(child_state, label="aerosol_optics", _RC) ! Retrieve extinction from each child - call ESMF_AttributeGet(child_state, name='extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(child_info, key='extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(child_state, ext_, trim(fld_name), _RC) + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=ext_, _RC) end if ! Retrieve scattering extinction from each child - call ESMF_AttributeGet(child_state, name='single_scattering_albedo_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(child_info, key='single_scattering_albedo_of_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(child_state, ssa_, trim(fld_name), _RC) + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=ssa_, _RC) end if ! Retrieve asymetry parameter multiplied by scatering extiction from each child - call ESMF_AttributeGet(child_state, name='asymmetry_parameter_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(child_info, key='asymmetry_parameter_of_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(child_state, asy_, trim(fld_name), _RC) + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=asy_, _RC) end if ! Sum aerosol optic properties from each child ext = ext + ext_ ssa = ssa + ssa_ asy = asy + asy_ - end do + call ESMF_InfoGetFromHost(state, info, _RC) ! Set ext, ssa, asy to equal the sum of ext, ssa, asy from the children. This is what is passed to radiation. - call ESMF_AttributeGet(state, name='extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key='extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(state, var, trim(fld_name), _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) var = ext(:,:,:) end if - call ESMF_AttributeGet(state, name='single_scattering_albedo_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key='single_scattering_albedo_of_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(state, var, trim(fld_name), _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) var = ssa(:,:,:) end if - call ESMF_AttributeGet(state, name='asymmetry_parameter_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key='asymmetry_parameter_of_ambient_aerosol', value=fld_name, _RC) if (fld_name /= '') then - call MAPL2_GetPointer(state, var, trim(fld_name), _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) var = asy(:,:,:) end if @@ -1418,71 +1414,72 @@ end subroutine run_aerosol_optics subroutine aerosol_activation_properties(state, rc) ! Arguments - type(ESMF_State) :: state + type(ESMF_State) :: state integer, intent(out) :: rc ! Local - character(len=ESMF_MAXSTR) :: mode ! mode name - character(len=ESMF_MAXSTR) :: mode_ ! lowercase mode name + character(len=ESMF_MAXSTR) :: mode ! mode name + character(len=ESMF_MAXSTR) :: mode_ ! lowercase mode name - type(ESMF_State) :: child_state + type(ESMF_State) :: child_state + type(ESMF_Info) :: info - real, dimension(:,:,:), pointer :: ple ! pressure at the edges of model layers - real, dimension(:,:,:), pointer :: temperature ! air temperature - real, dimension(:,:), pointer :: f_land ! fraction of land type in a grid cell + real, dimension(:,:,:), pointer :: ple ! pressure at the edges of model layers + real, dimension(:,:,:), pointer :: temperature ! air temperature + real, dimension(:,:), pointer :: f_land ! fraction of land type in a grid cell - real, dimension(:,:,:), pointer :: f ! correction factor for sea salt + real, dimension(:,:,:), pointer :: f ! correction factor for sea salt - real, dimension(:,:,:), allocatable :: q ! aerosol mass mixing ratio - real, dimension(:,:,:,:), pointer :: ptr_4d ! aerosol mass mixing ratio (temporary) - real, dimension(:,:,:), pointer :: ptr_3d ! aerosol mass mixing ratio (temporary) + real, dimension(:,:,:), allocatable :: q ! aerosol mass mixing ratio + real, dimension(:,:,:,:), pointer :: ptr_4d ! aerosol mass mixing ratio (temporary) + real, dimension(:,:,:), pointer :: ptr_3d ! aerosol mass mixing ratio (temporary) - real, dimension(:,:,:), pointer :: num ! number concentration of aerosol particles - real, dimension(:,:,:), pointer :: diameter ! dry size of aerosol - real, dimension(:,:,:), pointer :: sigma ! width of aerosol mode - real, dimension(:,:,:), pointer :: density ! density of aerosol - real, dimension(:,:,:), pointer :: hygroscopicity ! hygroscopicity of aerosol - real, dimension(:,:,:), pointer :: f_dust ! fraction of dust aerosol - real, dimension(:,:,:), pointer :: f_soot ! fraction of soot aerosol - real, dimension(:,:,:), pointer :: f_organic ! fraction of organic aerosol + real, dimension(:,:,:), pointer :: num ! number concentration of aerosol particles + real, dimension(:,:,:), pointer :: diameter ! dry size of aerosol + real, dimension(:,:,:), pointer :: sigma ! width of aerosol mode + real, dimension(:,:,:), pointer :: density ! density of aerosol + real, dimension(:,:,:), pointer :: hygroscopicity ! hygroscopicity of aerosol + real, dimension(:,:,:), pointer :: f_dust ! fraction of dust aerosol + real, dimension(:,:,:), pointer :: f_soot ! fraction of soot aerosol + real, dimension(:,:,:), pointer :: f_organic ! fraction of organic aerosol - real :: max_clean ! max mixing ratio before considered polluted - real :: ccn_tuning ! tunes conversion factors for sulfate + real :: max_clean ! max mixing ratio before considered polluted + real :: ccn_tuning ! tunes conversion factors for sulfate - character(len=ESMF_MAXSTR) :: fld_name + character(len=:), allocatable :: fld_name - integer :: i2, j2, km - integer :: b, i, j, n, aerosol_bin - integer :: varNameLen + integer :: i2, j2, km + integer :: b, i, j, n, aerosol_bin + integer :: varNameLen - character (len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) - type (ESMF_StateItem_Flag), allocatable :: itemTypes(:) + character(len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypes(:) ! auxilliary parameters real, parameter :: densSO4 = 1700.0 real, parameter :: densORG = 1600.0 - real, parameter :: densSS = 2200.0 - real, parameter :: densDU = 1700.0 - real, parameter :: densBC = 1600.0 - real, parameter :: densOC = 900.0 - real, parameter :: densBR = 900.0 - - real, parameter :: k_SO4 = 0.65 - real, parameter :: k_ORG = 0.20 - real, parameter :: k_SS = 1.28 - real, parameter :: k_DU = 0.0001 - real, parameter :: k_BC = 0.0001 - real, parameter :: k_OC = 0.0001 - real, parameter :: k_BR = 0.0001 + real, parameter :: densSS = 2200.0 + real, parameter :: densDU = 1700.0 + real, parameter :: densBC = 1600.0 + real, parameter :: densOC = 900.0 + real, parameter :: densBR = 900.0 + + real, parameter :: k_SO4 = 0.65 + real, parameter :: k_ORG = 0.20 + real, parameter :: k_SS = 1.28 + real, parameter :: k_DU = 0.0001 + real, parameter :: k_BC = 0.0001 + real, parameter :: k_OC = 0.0001 + real, parameter :: k_BR = 0.0001 integer, parameter :: UNKNOWN_AEROSOL_MODE = 2015 integer :: status ! Get list of child states within state and add to aeroList - call ESMF_StateGet (state, itemCount=n, _RC) - allocate (itemList(n), __STAT__) - allocate (itemTypes(n), __STAT__) - call ESMF_StateGet (state, itemNameList=itemList, itemTypeList=itemTypes, _RC) + call ESMF_StateGet(state, itemCount=n, _RC) + allocate(itemList(n), _STAT) + allocate(itemTypes(n), _STAT) + call ESMF_StateGet(state, itemNameList=itemList, itemTypeList=itemTypes, _RC) b=0 do i = 1, n @@ -1491,7 +1488,7 @@ subroutine aerosol_activation_properties(state, rc) end if end do - allocate (aeroList(b), __STAT__) + allocate(aeroList(b), _STAT) j = 1 do i = 1, n @@ -1501,59 +1498,61 @@ subroutine aerosol_activation_properties(state, rc) end if end do + call ESMF_InfoGetFromHost(state, info, _RC) + ! Aerosol mode - call ESMF_AttributeGet(state, name='aerosol_mode', value=mode, _RC) + call ESMF_InfoGet(info, key='aerosol_mode', value=mode, _RC) ! Land fraction - call ESMF_AttributeGet(state, name='fraction_of_land_type', value=fld_name, _RC) - call MAPL2_GetPointer(state, f_land, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='fraction_of_land_type', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=f_land, _RC) ! Pressure at layer edges - call ESMF_AttributeGet(state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) - call MAPL2_GetPointer(state, ple, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=ple, _RC) ! Temperature - call ESMF_AttributeGet(state, name='air_temperature', value=fld_name, _RC) - call MAPL2_GetPointer(state, temperature, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='air_temperature', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=temperature, _RC) i2 = ubound(temperature, 1) j2 = ubound(temperature, 2) km = ubound(temperature, 3) ! Activation activation properties - call ESMF_AttributeGet(state, name='aerosol_number_concentration', value=fld_name, _RC) - call MAPL2_GetPointer(state, num, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='aerosol_number_concentration', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=num, _RC) - call ESMF_AttributeGet(state, name='aerosol_dry_size', value=fld_name, _RC) - call MAPL2_GetPointer(state, diameter, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='aerosol_dry_size', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=diameter, _RC) - call ESMF_AttributeGet(state, name='width_of_aerosol_mode', value=fld_name, _RC) - call MAPL2_GetPointer(state, sigma, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='width_of_aerosol_mode', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=sigma, _RC) - call ESMF_AttributeGet(state, name='aerosol_density', value=fld_name, _RC) - call MAPL2_GetPointer(state, density, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='aerosol_density', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=density, _RC) - call ESMF_AttributeGet(state, name='aerosol_hygroscopicity', value=fld_name, _RC) - call MAPL2_GetPointer(state, hygroscopicity, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='aerosol_hygroscopicity', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=hygroscopicity, _RC) - call ESMF_AttributeGet(state, name='fraction_of_dust_aerosol', value=fld_name, _RC) - call MAPL2_GetPointer(state, f_dust, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='fraction_of_dust_aerosol', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=f_dust, _RC) - call ESMF_AttributeGet(state, name='fraction_of_soot_aerosol', value=fld_name, _RC) - call MAPL2_GetPointer(state, f_soot, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='fraction_of_soot_aerosol', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=f_soot, _RC) - call ESMF_AttributeGet(state, name='fraction_of_organic_aerosol', value=fld_name, _RC) - call MAPL2_GetPointer(state, f_organic, trim(fld_name), _RC) + call ESMF_InfoGet(info, key='fraction_of_organic_aerosol', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=f_organic, _RC) ! Sea salt scaling fctor - call ESMF_AttributeGet(state, name='max_q_clean', value=max_clean, _RC) - call ESMF_AttributeGet(state, name='ccn_tuning', value=ccn_tuning, _RC) + call ESMF_InfoGet(info, key='max_q_clean', value=max_clean, _RC) + call ESMF_InfoGet(info, key='ccn_tuning', value=ccn_tuning, _RC) ! Aerosol mass mixing ratios mode_ = trim(mode) mode_ = ESMF_UtilStringLowerCase(mode_, _RC) - allocate(q(i2,j2,km), __STAT__) + allocate(q(i2,j2,km), _STAT) q = 0.0 if (index(mode_, 'du00') > 0) then ! Dust @@ -1562,7 +1561,7 @@ subroutine aerosol_activation_properties(state, rc) if (index(aeroList(i), 'DU') > 0) then read (mode_(3:len(mode_)),*) aerosol_bin call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) - call MAPL2_GetPointer(child_state, ptr_4d, 'DU', _RC) + call MAPL_StateGetPointer(child_state, itemName="DU", farrayPtr=ptr_4d, _RC) q = q + ptr_4d(:,:,:,aerosol_bin) ptr_3d => ptr_4d(:,:,:,aerosol_bin) @@ -1576,7 +1575,7 @@ subroutine aerosol_activation_properties(state, rc) do i = 1, size(aeroList) if (index(aeroList(i), 'SS') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) - call MAPL2_GetPointer(child_state, ptr_4d, 'SS', _RC) + call MAPL_StateGetPointer(child_state, itemName="SS", farrayPtr=ptr_4d, _RC) do j = 1, ubound(ptr_4d, 4) q = q + ptr_4d(:,:,:,j) ptr_3d => ptr_4d(:,:,:,j) @@ -1594,7 +1593,7 @@ subroutine aerosol_activation_properties(state, rc) do i = 1, size(aeroList) if (index(aeroList(i), 'SU') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) - call MAPL2_GetPointer(child_state, ptr_3d, 'SO4', _RC) + call MAPL_StateGetPointer(child_state, itemName="SO4", farrayPtr=ptr_3d, _RC) q = q + ptr_3d hygroscopicity = k_SO4 * ptr_3d + hygroscopicity density = densSO4 * ptr_3d + density @@ -1603,14 +1602,14 @@ subroutine aerosol_activation_properties(state, rc) if (index(aeroList(i), 'CA.oc') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) varNameLen = len_trim(aeroList(i)) - ! the '5' refers to '_AERO', which we want to remove to get the CA component name (e.g. CA.oc, or CA.oc.data) + ! the '5' refers to '_AERO', which we want to remove + ! to get the CA component name (e.g. CA.oc, or CA.oc.data) varNameLen = varNameLen - 5 - call MAPL2_GetPointer(child_state, ptr_3d, aeroList(i)(1:varNameLen)//'philic', _RC) + call MAPL_StateGetPointer(child_state, itemName=aeroList(i)(1:varNameLen)//"philic", farrayPtr=ptr_3d, _RC) q = q + ptr_3d hygroscopicity = k_ORG * ptr_3d + hygroscopicity density = densORG * ptr_3d + density end if - end do where (q > 2.0e-12 .and. hygroscopicity > tiny(0.0)) @@ -1629,9 +1628,10 @@ subroutine aerosol_activation_properties(state, rc) if (index(aeroList(i), 'CA.bc') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) varNameLen = len_trim(aeroList(i)) - ! the '5' refers to '_AERO', which we want to remove to get the CA component name (e.g. CA.bc, or CA.bc.data) + ! the '5' refers to '_AERO', which we want to remove + ! to get the CA component name (e.g. CA.bc, or CA.bc.data) varNameLen = varNameLen - 5 - call MAPL2_GetPointer(child_state, ptr_3d, aeroList(i)(1:varNameLen)//'philic', _RC) + call MAPL_StateGetPointer(child_state, itemName=aeroList(i)(1:varNameLen)//"philic", farrayPtr=ptr_3d, _RC) q = q + ptr_3d hygroscopicity = k_BC density = densBC @@ -1643,9 +1643,10 @@ subroutine aerosol_activation_properties(state, rc) if (index(aeroList(i), 'CA.oc') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) varNameLen = len_trim(aeroList(i)) - ! the '5' refers to '_AERO', which we want to remove to get the CA component name (e.g. CA.oc, or CA.oc.data) + ! the '5' refers to '_AERO', which we want to remove + ! to get the CA component name (e.g. CA.oc, or CA.oc.data) varNameLen = varNameLen - 5 - call MAPL2_GetPointer(child_state, ptr_3d, aeroList(i)(1:varNameLen)//'philic', _RC) + call MAPL_StateGetPointer(child_state, itemName=aeroList(i)(1:varNameLen)//"philic", farrayPtr=ptr_3d, _RC) q = q + ptr_3d hygroscopicity = k_OC density = densOC @@ -1657,9 +1658,10 @@ subroutine aerosol_activation_properties(state, rc) if (index(aeroList(i), 'CA.br') > 0) then call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) varNameLen = len_trim(aeroList(i)) - ! the '5' refers to '_AERO', which we want to remove to get the CA component name (e.g. CA.bc, or CA.bc.data) + ! the '5' refers to '_AERO', which we want to remove + ! to get the CA component name (e.g. CA.bc, or CA.bc.data) varNameLen = varNameLen - 5 - call MAPL2_GetPointer(child_state, ptr_3d, aeroList(i)(1:varNameLen)//'philic', _RC) + call MAPL_StateGetPointer(child_state, itemName=aeroList(i)(1:varNameLen)//"philic", farrayPtr=ptr_3d, _RC) q = q + ptr_3d hygroscopicity = k_BR density = densBR @@ -1680,7 +1682,7 @@ subroutine aerosol_activation_properties(state, rc) f_organic, & density, & ptr_3d, & - 1, i2, 1, j2, km, & + 1, i2, 1, j2, km, & _RC) deallocate(q, _STAT) @@ -1692,33 +1694,32 @@ subroutine aerosol_activation_properties(state, rc) subroutine aap_(mode, q, num, diameter, sigma, f_dust, f_soot, f_organic, dens_, q_, & i1, i2, j1, j2, km, rc) - integer, intent(in) :: i1, i2 ! dimension bounds - integer, intent(in) :: j1, j2 ! ... // .. - integer, intent(in) :: km ! ... // .. + integer, intent(in) :: i1, i2 ! dimension bounds + integer, intent(in) :: j1, j2 ! ... // .. + integer, intent(in) :: km ! ... // .. - character(len=*), intent(in ) :: mode ! name of aerosol mode - real, intent(in), dimension(i1:i2,j1:j2,km) :: q ! aerosol mass mixing ratio, kg kg-1 - real, intent(in), dimension(i1:i2,j1:j2,km) :: q_ ! auxiliary mass - real, intent(in), dimension(i1:i2,j1:j2,km) :: dens_ ! density + character(len=*), intent(in ) :: mode ! name of aerosol mode + real, intent(in), dimension(i1:i2,j1:j2,km) :: q ! aerosol mass mixing ratio, kg kg-1 + real, intent(in), dimension(i1:i2,j1:j2,km) :: q_ ! auxiliary mass + real, intent(in), dimension(i1:i2,j1:j2,km) :: dens_ ! density - real, intent(out), dimension(i1:i2,j1:j2,km) :: num ! number concentration of aerosol particles - real, intent(out), dimension(i1:i2,j1:j2,km) :: diameter ! dry size of aerosol - real, intent(out), dimension(i1:i2,j1:j2,km) :: sigma ! width of aerosol mode - real, intent(out), dimension(i1:i2,j1:j2,km) :: f_dust ! fraction of dust aerosol - real, intent(out), dimension(i1:i2,j1:j2,km) :: f_soot ! fraction of soot aerosol - real, intent(out), dimension(i1:i2,j1:j2,km) :: f_organic ! fraction of organic aerosol + real, intent(out), dimension(i1:i2,j1:j2,km) :: num ! number concentration of aerosol particles + real, intent(out), dimension(i1:i2,j1:j2,km) :: diameter ! dry size of aerosol + real, intent(out), dimension(i1:i2,j1:j2,km) :: sigma ! width of aerosol mode + real, intent(out), dimension(i1:i2,j1:j2,km) :: f_dust ! fraction of dust aerosol + real, intent(out), dimension(i1:i2,j1:j2,km) :: f_soot ! fraction of soot aerosol + real, intent(out), dimension(i1:i2,j1:j2,km) :: f_organic ! fraction of organic aerosol - integer, intent(out) :: rc ! return code + integer, intent(out) :: rc ! local - integer :: STATUS - character(len=ESMF_MAXSTR) :: mode_ - character(len=ESMF_MAXSTR) :: Iam = 'GOCART::aerosol_activation_properties::aap_()' + integer :: status + character(len=:), allocatable :: mode_ integer, parameter :: UNKNOWN_AEROSOL_MODE = 2015 - integer :: kinx - real :: fmassaux, fmassclean + integer :: kinx + real :: fmassaux, fmassclean real, dimension(3) :: TPI, DPGI, SIGI real, dimension(3) :: TPIclean, DPGIclean, SIGIclean real, dimension(i1:i2,j1:j2,km) :: qaux @@ -1893,7 +1894,7 @@ subroutine aap_(mode, q, num, diameter, sigma, f_dust, f_soot, f_organic, dens_, num = q / ((MAPL_PI/6.0) * densOrg * diameter*diameter*diameter * exp(4.5*sigma*sigma)) case default - __raise__(UNKNOWN_AEROSOL_MODE,"Unknown aerosol mode used in the GOCART aerosol activation properties method: "//trim(mode)) + _FAIL("Unknown aerosol mode used in the GOCART aerosol activation properties method: "//trim(mode)) end select @@ -1904,304 +1905,291 @@ end subroutine aap_ end subroutine aerosol_activation_properties + subroutine get_monochromatic_aop (state, rc) -!=================================================================================== - subroutine get_monochromatic_aop (state, rc) + implicit none - implicit none + !ARGUMENTS: + type(ESMF_State) :: state + integer, intent(out) :: rc -! !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc + !Local + real, dimension(:,:,:), pointer :: ple + real, dimension(:,:,:), pointer :: rh + real, dimension(:,:), pointer :: var + character(len=:), allocatable :: fld_name + real, dimension(:,:), pointer :: tau_ ! (lon:,lat:,lev:) + real, dimension(:,:), allocatable :: tau ! (lon:,lat:,lev:) + integer :: i, n, b, j + integer :: i1, j1, i2, j2, km + real :: wavelength + character(len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) + type(ESMF_State) :: child_state + real, pointer, dimension(:,:,:) :: as_ptr_3d + type(ESMF_StateItem_Flag), allocatable :: itemTypes(:) + type(ESMF_Info) :: info, child_info + integer :: status -! !Local - real, dimension(:,:,:), pointer :: ple - real, dimension(:,:,:), pointer :: rh - real, dimension(:,:), pointer :: var + ! Description: Used in GAAS gridded component to provide aerosol properties - character (len=ESMF_MAXSTR) :: fld_name + call ESMF_InfoGetFromHost(state, info, _RC) - real, dimension(:,:),pointer :: tau_ ! (lon:,lat:,lev:) - real, dimension(:,:), allocatable :: tau ! (lon:,lat:,lev:) + ! Radiation band + call ESMF_InfoGet(info, key='wavelength_for_aerosol_optics', value=wavelength, _RC) - integer :: i, n, b, j - integer :: i1, j1, i2, j2, km - real :: wavelength + ! Relative humidity + call ESMF_InfoGet(info, key='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=rh, _RC) - character (len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) - type (ESMF_State) :: child_state - real, pointer, dimension(:,:,:) :: as_ptr_3d + ! Pressure at layer edges + call ESMF_InfoGet(info, key='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=ple, _RC) - type (ESMF_StateItem_Flag), allocatable :: itemTypes(:) - integer :: status + ! TODO: pchakrab - CAREFUL! ple in MAPL3 is (:, :, 1:km+1), instead of (:, :, km) + i1 = lbound(ple, 1); i2 = ubound(ple, 1) + j1 = lbound(ple, 2); j2 = ubound(ple, 2) + km = ubound(ple, 3) -! Description: Used in GAAS gridded component to provide aerosol properties -!----------------------------------------------------------------------------------- -! Begin... + allocate(tau(i1:i2,j1:j2), _STAT) + tau = 0.0 -! Radiation band -! -------------- - call ESMF_AttributeGet(state, name='wavelength_for_aerosol_optics', value=wavelength, _RC) + ! Get list of child states within state and add to aeroList + call ESMF_StateGet (state, itemCount=n, _RC) + allocate(itemList(n), _STAT) + allocate(itemTypes(n), _STAT) + call ESMF_StateGet(state, itemNameList=itemList, itemTypeList=itemTypes, _RC) -! Relative humidity -! ----------------- - call ESMF_AttributeGet(state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) - call MAPL2_GetPointer(state, RH, trim(fld_name), _RC) + b=0 + do i = 1, n + if (itemTypes(i) == ESMF_StateItem_State) then + b = b + 1 + end if + end do -! Pressure at layer edges -! ------------------------ - call ESMF_AttributeGet(state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) - call MAPL2_GetPointer(state, PLE, trim(fld_name), _RC) + allocate(aeroList(b), _STAT) - i1 = lbound(ple, 1); i2 = ubound(ple, 1) - j1 = lbound(ple, 2); j2 = ubound(ple, 2) - km = ubound(ple, 3) + j = 1 + do i = 1, n + if (itemTypes(i) == ESMF_StateItem_State) then + aeroList(j) = trim(itemList(i)) + j = j + 1 + end if + end do - allocate(tau(i1:i2,j1:j2), __STAT__) - tau = 0.0 + ! Get aerosol optic properties from children + do i = 1, size(aeroList) + call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) + call ESMF_InfoGetFromHost(child_state, child_info, _RC) -! Get list of child states within state and add to aeroList -! --------------------------------------------------------- - call ESMF_StateGet (state, itemCount=n, _RC) - allocate (itemList(n), __STAT__) - allocate (itemTypes(n), __STAT__) - call ESMF_StateGet (state, itemNameList=itemList, itemTypeList=itemTypes, _RC) + ! set RH in child's aero state + call ESMF_InfoGet(child_info, key='relative_humidity_for_aerosol_optics', value=fld_name, _RC) - b=0 - do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then - b = b + 1 - end if - end do + if (fld_name /= '') then + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=as_ptr_3d, _RC) + as_ptr_3d = rh + end if - allocate (aeroList(b), __STAT__) + ! set PLE in child's aero state + call ESMF_InfoGet(child_info, key='air_pressure_for_aerosol_optics', value=fld_name, _RC) - j = 1 - do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then - aeroList(j) = trim(itemList(i)) - j = j + 1 - end if - end do + if (fld_name /= '') then + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=as_ptr_3d, _RC) + as_ptr_3d = ple + end if -! ! Get aerosol optic properties from children - do i = 1, size(aeroList) - call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) + ! set wavelength in child's aero state + call ESMF_InfoSet(child_info, key='wavelength_for_aerosol_optics', value=wavelength, _RC) -! ! set RH in child's aero state - call ESMF_AttributeGet(child_state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + ! execute the aerosol optics method + call ESMF_MethodExecute(child_state, label="monochromatic_aerosol_optics", _RC) - if (fld_name /= '') then - call MAPL2_GetPointer(child_state, as_ptr_3d, trim(fld_name), _RC) - as_ptr_3d = rh - end if + ! Retrieve extinction from each child + call ESMF_InfoGet(child_info, key='monochromatic_extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=tau_, _RC) + end if -! ! set PLE in child's aero state - call ESMF_AttributeGet(child_state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) + ! Sum aerosol optic properties from each child + tau = tau + tau_ + end do - if (fld_name /= '') then - call MAPL2_GetPointer(child_state, as_ptr_3d, trim(fld_name), _RC) - as_ptr_3d = ple - end if + ! Set ext, ssa, asy to equal the sum of ext, ssa, asy from the children. This is what is passed to radiation. + call ESMF_InfoGet(info, key='monochromatic_extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = tau + end if -! ! set wavelength in child's aero state - call ESMF_AttributeSet(child_state, name='wavelength_for_aerosol_optics', value=wavelength, _RC) + deallocate(tau, _STAT) + + _RETURN(_SUCCESS) -! ! execute the aerosol optics method - call ESMF_MethodExecute(child_state, label="monochromatic_aerosol_optics", _RC) + end subroutine get_monochromatic_aop -! ! Retrieve extinction from each child - call ESMF_AttributeGet(child_state, name='monochromatic_extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer(child_state, tau_, trim(fld_name), _RC) - end if + subroutine get_mixRatioSum (state, rc) -! ! Sum aerosol optic properties from each child - tau = tau + tau_ - end do + implicit none -! ! Set ext, ssa, asy to equal the sum of ext, ssa, asy from the children. This is what is passed to radiation. - call ESMF_AttributeGet(state, name='monochromatic_extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer(state, var, trim(fld_name), _RC) - var = tau - end if + !ARGUMENTS: + type(ESMF_State) :: state + integer, intent(out) :: rc - deallocate(tau, __STAT__) + !Local + character(len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) + character(len=:), allocatable :: aeroName, fld_name - _RETURN(_SUCCESS) + real, pointer, dimension(:,:,:) :: var + real, dimension(:,:,:), allocatable :: aeroOut + type(ESMF_StateItem_Flag), allocatable :: itemTypes(:) + type(ESMF_Info) :: info - end subroutine get_monochromatic_aop + integer :: b, i, n, j, im, jm, km, status + ! Description: Used in GAAS gridded component to provide sum of aerosol mixing ratio -!=================================================================================== - subroutine get_mixRatioSum (state, rc) + call ESMF_InfoGetFromHost(state, info, _RC) + + call ESMF_InfoGet(info, key='aerosolName', value=aeroName, _RC) + call ESMF_InfoGet(info, key='im', value=im, _RC) + call ESMF_InfoGet(info, key='jm', value=jm, _RC) + call ESMF_InfoGet(info, key='km', value=km, _RC) - implicit none + allocate(aeroOut(im,jm,km), _STAT) + aeroOut = 0.0 -! !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc + ! Get list of child states within state and add to aeroList + call ESMF_StateGet(state, itemCount=n, _RC) + allocate(itemList(n), _STAT) + allocate(itemTypes(n), _STAT) + call ESMF_StateGet(state, itemNameList=itemList, itemTypeList=itemTypes, _RC) -! !Local - character (len=ESMF_MAXSTR), allocatable :: itemList(:), aeroList(:) - character (len=ESMF_MAXSTR) :: aeroName - character (len=ESMF_MAXSTR) :: fld_name + b=0 + do i = 1, n + if (itemTypes(i) == ESMF_StateItem_State) then + b = b + 1 + end if + end do - real, pointer, dimension(:,:,:) :: var - real, dimension(:,:,:), allocatable :: aeroOut - type (ESMF_StateItem_Flag), allocatable :: itemTypes(:) + allocate(aeroList(b), _STAT) - integer :: b, i, n, j, im, jm, km, status + j = 1 + do i = 1, n + if (itemTypes(i) == ESMF_StateItem_State) then + aeroList(j) = trim(itemList(i)) + j = j + 1 + end if + end do -! Description: Used in GAAS gridded component to provide sum of aerosol mixing ratio -!-------------------------------------------------------------------------------------- -! Begin... + ! Retrieve summed aerosol mixing ratios from active instances + select case (trim(aeroName)) + case ('dust') + call getAerosolSum('DU', state, aeroList, aeroOut, _RC) - call ESMF_AttributeGet(state, name='aerosolName', value=aeroName, _RC) - call ESMF_AttributeGet(state, name='im', value=im, _RC) - call ESMF_AttributeGet(state, name='jm', value=jm, _RC) - call ESMF_AttributeGet(state, name='km', value=km, _RC) + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_DU', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if - allocate(aeroOut(im,jm,km), __STAT__) - aeroOut = 0.0 + case ('seasalt') + call getAerosolSum('SS', state, aeroList, aeroOut, _RC) -! Get list of child states within state and add to aeroList -! --------------------------------------------------------- - call ESMF_StateGet (state, itemCount=n, _RC) - allocate (itemList(n), __STAT__) - allocate (itemTypes(n), __STAT__) - call ESMF_StateGet (state, itemNameList=itemList, itemTypeList=itemTypes, _RC) + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_SS', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if - b=0 - do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then - b = b + 1 - end if - end do + case ('organicCarbon') + call getAerosolSum('CA.oc', state, aeroList, aeroOut, _RC) - allocate (aeroList(b), __STAT__) + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_CA.oc', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if - j = 1 - do i = 1, n - if (itemTypes(i) == ESMF_StateItem_State) then - aeroList(j) = trim(itemList(i)) - j = j + 1 - end if - end do - - -! Retrieve summed aerosol mixing ratios from active instances - select case (trim(aeroName)) - case ('dust') - call getAerosolSum ('DU', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_DU', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('seasalt') - call getAerosolSum ('SS', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_SS', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('organicCarbon') - call getAerosolSum ('CA.oc', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_CA.oc', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('blackCarbon') - call getAerosolSum ('CA.bc', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_CA.bc', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('brownCarbon') - call getAerosolSum ('CA.br', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_CA.br', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('sulfate') - call getAerosolSum ('SU', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_SU', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case ('nitrate') - call getAerosolSum ('NI', state, aeroList, aeroOut, _RC) - - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol_NI', value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer (state, var, trim(fld_name), _RC) - var = aeroOut - end if - - case default - !$omp critical (G2G_2) - print *,"Invalid aerosolName of '",trim(aeroName), "' in GOCART2G::get_mixRatioSum" - !$omp end critical (G2G_2) - end select + case ('blackCarbon') + call getAerosolSum('CA.bc', state, aeroList, aeroOut, _RC) -contains - subroutine getAerosolSum (aeroToken, state, aeroList, aeroOut, rc) + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_CA.bc', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if + + case ('brownCarbon') + call getAerosolSum ('CA.br', state, aeroList, aeroOut, _RC) + + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_CA.br', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if - implicit none + case ('sulfate') + call getAerosolSum('SU', state, aeroList, aeroOut, _RC) -! !ARGUMENTS: - character (len=*), intent(in) :: aeroToken - type (ESMF_State), intent(in) :: state - character (len=ESMF_MAXSTR), intent(in) :: aeroList(:) - real, dimension(:,:,:), intent(out) :: aeroOut - integer, optional, intent(out) :: rc + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_SU', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if -! !LOCALS: - integer :: i, endInd - character (len=ESMF_MAXSTR) :: fld_name - type (ESMF_State) :: child_state - real, pointer, dimension(:,:,:) :: ptr3d + case ('nitrate') + call getAerosolSum('NI', state, aeroList, aeroOut, _RC) + call ESMF_InfoGet(info, key='sum_of_internalState_aerosol_NI', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=var, _RC) + var = aeroOut + end if + + case default + !$omp critical (G2G_2) + print *,"Invalid aerosolName of '",trim(aeroName), "' in GOCART2G::get_mixRatioSum" + !$omp end critical (G2G_2) + end select -! Begin... + _RETURN(_SUCCESS) - endInd = len_trim(aeroToken) + contains - aeroOut = 0.0 - do i = 1, size(aeroList) - if (trim(aeroList(i)(1:endInd)) == trim(aeroToken)) then - call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) - call ESMF_MethodExecute(child_state, label="get_mixR", _RC) - call ESMF_AttributeGet(child_state, name='sum_of_internalState_aerosol', & - value=fld_name, _RC) - if (fld_name /= '') then - call MAPL2_GetPointer(child_state, ptr3d, trim(fld_name), _RC) - aeroOut = aeroOut + ptr3d - end if - end if - end do + subroutine getAerosolSum(aeroToken, state, aeroList, aeroOut, rc) + !ARGUMENTS: + character(len=*), intent(in) :: aeroToken + type(ESMF_State), intent(in) :: state + character(len=ESMF_MAXSTR), intent(in) :: aeroList(:) + real, dimension(:,:,:), intent(out) :: aeroOut + integer, optional, intent(out) :: rc - end subroutine getAerosolSum + !LOCALS: + integer :: i, endInd + character(len=ESMF_MAXSTR) :: fld_name + type(ESMF_State) :: child_state + type(ESMF_Info) :: child_info + real, pointer, dimension(:,:,:) :: ptr3d + + endInd = len_trim(aeroToken) + + aeroOut = 0.0 + do i = 1, size(aeroList) + if (trim(aeroList(i)(1:endInd)) == trim(aeroToken)) then + call ESMF_StateGet(state, trim(aeroList(i)), child_state, _RC) + call ESMF_MethodExecute(child_state, label="get_mixR", _RC) + call ESMF_InfoGetFromHost(child_state, child_info, _RC) + call ESMF_InfoGet(child_info, key='sum_of_internalState_aerosol', value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(child_state, itemName=fld_name, farrayPtr=ptr3d, _RC) + aeroOut = aeroOut + ptr3d + end if + end if + end do + + _RETURN(_SUCCESS) + end subroutine getAerosolSum - end subroutine get_mixRatioSum + end subroutine get_mixRatioSum end module GOCART2G_GridCompMod diff --git a/ESMF/GOCART2G_GridComp/SS2G_GridComp/SS2G_GridCompMod.F90 b/ESMF/GOCART2G_GridComp/SS2G_GridComp/SS2G_GridCompMod.F90 index b032f926..4d635f0c 100644 --- a/ESMF/GOCART2G_GridComp/SS2G_GridComp/SS2G_GridCompMod.F90 +++ b/ESMF/GOCART2G_GridComp/SS2G_GridComp/SS2G_GridCompMod.F90 @@ -10,14 +10,11 @@ module SS2G_GridCompMod !USES: use ESMF use pflogger, only: logger_t => logger - use mapl_ErrorHandling, only: MAPL_Verify, MAPL_VRFY, MAPL_RTRN, MAPL_Assert, MAPL_Return - use MAPL_Constants, only: MAPL_R4, MAPL_R8, MAPL_RADIANS_TO_DEGREES, MAPL_PI, MAPL_GRAV, MAPL_KARMAN + use mapl_ErrorHandling, only: MAPL_Verify, MAPL_Assert, MAPL_Return + use MAPL_Constants, only: MAPL_RADIANS_TO_DEGREES, MAPL_PI, MAPL_GRAV, MAPL_KARMAN use MAPL_MaplGrid, only: MAPL2_GridGet => MAPL_GridGet - use MAPL_Base, only: MAPL2_FieldCreate => MAPL_FieldCreate - use MAPL_Base, only: MAPL2_StateAdd => MAPL_StateAdd use mapl3g_generic, only: MAPL_GridCompSetEntryPoint use mapl3g_generic, only: MAPL_GridCompAddSpec - use mapl3g_generic, only: MAPL_GridCompReexport use mapl3g_generic, only: MAPL_GridCompGet use mapl3g_generic, only: MAPL_GridCompGetResource use mapl3g_generic, only: MAPL_GridCompGetInternalState @@ -40,34 +37,34 @@ module SS2G_GridCompMod integer, parameter :: instanceComputational = 1 integer, parameter :: instanceData = 2 - real, parameter :: OCEAN=0.0, LAND = 1.0, SEA_ICE = 2.0 - integer, parameter :: DP=kind(1.0d0) + real, parameter :: OCEAN = 0.0, LAND = 1.0, SEA_ICE = 2.0 + integer, parameter :: DP = kind(1.0d0) + ! character(len=*), parameter :: namespace = "/user/SS" !PUBLIC MEMBER FUNCTIONS: PUBLIC SetServices - real, parameter :: cpd = 1004.16 + real, parameter :: cpd = 1004.16 !DESCRIPTION: This module implements GOCART's Sea Salt (SS) Gridded Component. !REVISION HISTORY: ! 24Oct2019 E.Sherman First attempt at refactoring. !EOP - integer, parameter :: NHRES = 6 + integer, parameter :: NHRES = 6 !Sea Salt state type, extends(GA_Environment) :: SS2G_GridComp - real, allocatable :: rlow(:) ! particle effective radius lower bound [um] - real, allocatable :: rup(:) ! particle effective radius upper bound [um] - real, allocatable :: rmed(:) ! number median radius [um] - integer :: sstEmisFlag ! Choice of SST correction to emissions: - ! 0 - none; 1 - Jaegle et al. 2011; 2 - GEOS5 - logical :: hoppelFlag ! Apply the Hoppel correction to emissions (Fan and Toon, 2011) - logical :: weibullFlag ! Apply the Weibull distribution to wind speed for emissions (Fan and Toon, 2011) - !real, allocatable :: deep_lakes_mask(:,:) - integer :: emission_scheme - real :: emission_scale ! global scaling factor - real :: emission_scale_res(NHRES) ! global scaling factor + real, allocatable :: rlow(:) ! particle effective radius lower bound [um] + real, allocatable :: rup(:) ! particle effective radius upper bound [um] + real, allocatable :: rmed(:) ! number median radius [um] + integer :: sstEmisFlag ! SST correction to emissions: 0 - none; 1 - Jaegle et al. 2011; 2 - GEOS5 + logical :: hoppelFlag ! Apply Hoppel correction to emissions (Fan and Toon, 2011) + logical :: weibullFlag ! Apply Weibull distribution to wind speed for emissions (Fan and Toon, 2011) + !real, allocatable :: deep_lakes_mask(:,:) + integer :: emission_scheme + real :: emission_scale ! global scaling factor + real :: emission_scale_res(NHRES) ! global scaling factor end type SS2G_GridComp type wrap_ @@ -79,7 +76,6 @@ module SS2G_GridCompMod !BOP !IROUTINE: SetServices !INTERFACE: - subroutine SetServices(gc, rc) !ARGUMENTS: @@ -323,42 +319,37 @@ subroutine Initialize (gc, import, export, clock, RC) !EOP !Locals - character (len=ESMF_MAXSTR) :: comp_name - type (ESMF_Grid) :: grid - type (ESMF_State) :: internal - type (ESMF_State) :: aero - type (ESMF_State) :: providerState - type (ESMF_FieldBundle) :: Bundle_DP - type (wrap_) :: wrap - type (SS2G_GridComp), pointer :: self - - integer, allocatable :: mieTable_pointer(:) - integer :: i, dims(3), km - integer :: instance - type (ESMF_Field) :: field, fld - character (len=ESMF_MAXSTR) :: prefix, bin_index - real, pointer, dimension(:,:) :: lats - real, pointer, dimension(:,:) :: lons - type (ESMF_TimeInterval) :: time_step - real :: CDT ! chemistry timestep (secs) - real(ESMF_KIND_R4) :: HDT ! model timestep (secs) - real, pointer, dimension(:,:,:,:) :: int_ptr - logical :: data_driven - integer :: NUM_BANDS - logical :: bands_are_present - real, pointer, dimension(:,:,:) :: ple - real, pointer, dimension(:,:) :: deep_lakes_mask - - integer, allocatable, dimension(:) :: channels_ - integer :: nmom_ - character(:), allocatable :: file_ - logical :: file_exists + type(ESMF_Geom) :: geom + type(ESMF_Grid) :: grid + type(ESMF_State) :: internal, aero, provider_state + type(ESMF_Field) :: field + type(ESMF_FieldBundle) :: bundle_dp + type(ESMF_TimeInterval) :: time_step + type(ESMF_Info) :: field_info, aero_info + + type(wrap_) :: wrap + type(SS2G_GridComp), pointer :: self + + character(len=:), allocatable :: comp_name + character(len=ESMF_MAXSTR) :: prefix, bin_index + character(:), allocatable :: file_ + + real, pointer, dimension(:,:,:,:) :: int_ptr + real, pointer, dimension(:,:,:) :: ple + real, pointer, dimension(:,:) :: deep_lakes_mask, lats, lons + real :: CDT ! chemistry timestep (secs) + real(ESMF_KIND_R4) :: HDT ! model timestep (secs) + + logical :: data_driven, bands_are_present, file_exists + + integer, allocatable, dimension(:) :: mieTable_pointer, channels_ + integer :: instance, nmom_ + integer :: i, dims(3), km integer :: i1, i2, j1, j2, status + class(logger_t), pointer :: logger - ! Get the target components name and set-up traceback handle. - call ESMF_GridCompGet(gc, NAME=comp_name, _RC) - call MAPL_GridCompGet(gc, logger=logger, _RC) + call MAPL_GridCompGet(gc, name=comp_name,logger=logger, _RC) call logger%info("Initialize:: starting...") ! Get my internal private state @@ -366,8 +357,8 @@ subroutine Initialize (gc, import, export, clock, RC) self => wrap%ptr ! Global dimensions are needed here for choosing tuning parameters - call MAPL_GridCompGet(gc, grid=grid, num_levels=km, _RC) - call MAPL2_GridGet (grid, globalCellCountPerDim=dims, _RC ) + call MAPL_GridCompGet(gc, geom=geom, grid=grid, num_levels=km, _RC) + call MAPL2_GridGet(grid, globalCellCountPerDim=dims, _RC) self%km = km ! Scaling factor to multiply calculated emissions by. Applies to all size bins. @@ -381,70 +372,61 @@ subroutine Initialize (gc, import, export, clock, RC) ! Get parameters from generic state. call MAPL_GridCompGetInternalState(gc, internal, _RC) - call MAPL_GridGet(grid, latitudes=lats, longitudes=lons, _RC) ! Is SS data driven? call determine_data_driven (comp_name, data_driven, _RC) ! If this is a data component, the data is provided in the import ! state via ExtData instead of the actual GOCART children - if ( data_driven ) then - providerState = import + provider_state = export + prefix = '' + if (data_driven) then + provider_state = import prefix = 'clim' - else - providerState = export - prefix = '' end if ! Add attribute information for SS export. Used in NI hetergenous chemistry. - call ESMF_StateGet (export, 'SS', field, _RC) - call ESMF_AttributeSet(field, NAME='radius', valueList=self%rmed, itemCount=self%nbins, _RC) - call ESMF_AttributeSet(field, NAME='fnum', valueList=self%fnum, itemCount=self%nbins, _RC) + call ESMF_StateGet(export, 'SS', field, _RC) + call ESMF_InfoGetFromHost(field, field_info, _RC) + call ESMF_InfoSet(field_info, key="radius", values=self%rmed, _RC) + call ESMF_InfoSet(field_info, key="fnum", values=self%fnum, _RC) + call ESMF_InfoSet(field_info, key="ScavengingFractionPerKm", value=self%fscav(1), _RC) ! Fill AERO State with sea salt fields - call ESMF_StateGet (export, trim(comp_name)//'_AERO' , aero , _RC) - call ESMF_StateGet (export, trim(comp_name)//'_AERO_DP' , Bundle_DP, _RC) - - call ESMF_StateGet (internal, 'SS', field, _RC) + call ESMF_StateGet(export, trim(comp_name)//'_AERO', aero, _RC) + call ESMF_StateGet(export, trim(comp_name)//'_AERO_DP', bundle_dp, _RC) + + call ESMF_StateGet(internal, 'SS', field, _RC) ! call ESMF_AttributeSet(field, NAME='klid', value=self%klid, _RC) - fld = MAPL2_FieldCreate (field, 'SS', _RC) - call MAPL2_StateAdd (aero, fld, _RC) - - call ESMF_AttributeSet(field, NAME='ScavengingFractionPerKm', value=self%fscav(1), _RC) + ! pchakrab: I'm confused here. Why are we renaming SS as SS? + ! fld = MAPL2_FieldCreate(field, 'SS', _RC) ! pchakrab: This is equivalent to fld = field + ! call MAPL2_StateAdd(aero, fld, _RC) + call ESMF_StateAdd(aero, [field], _RC) if (data_driven) then instance = instanceData - do i = 1, self%nbins write (bin_index, '(A, I0.3)') '', i ! Dry deposition - call append_to_bundle('SSDP'//trim(bin_index), providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSDP'//trim(bin_index), provider_state, prefix, bundle_dp, _RC) ! Wet deposition (Convective scavenging) - call append_to_bundle('SSSV'//trim(bin_index), providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSSV'//trim(bin_index), provider_state, prefix, bundle_dp, _RC) ! Wet deposition - call append_to_bundle('SSWT'//trim(bin_index), providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSWT'//trim(bin_index), provider_state, prefix, bundle_dp, _RC) ! Gravitational Settling - call append_to_bundle('SSSD'//trim(bin_index), providerState, prefix, Bundle_DP, _RC) + call append_to_bundle('SSSD'//trim(bin_index), provider_state, prefix, bundle_dp, _RC) end do else instance = instanceComputational - ! Dry deposition - call append_to_bundle('SSDP', providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSDP', provider_state, prefix, bundle_dp, _RC) ! Wet deposition (Convective scavenging) - call append_to_bundle('SSSV', providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSSV', provider_state, prefix, bundle_dp, _RC) ! Wet deposition - call append_to_bundle('SSWT', providerState, prefix, Bundle_DP, _RC) - + call append_to_bundle('SSWT', provider_state, prefix, bundle_dp, _RC) ! Gravitational Settling - call append_to_bundle('SSSD', providerState, prefix, Bundle_DP, _RC) + call append_to_bundle('SSSD', provider_state, prefix, bundle_dp, _RC) end if - self%instance = instance ! Create Radiation Mie Table @@ -457,36 +439,49 @@ subroutine Initialize (gc, import, export, clock, RC) call MAPL_GridCompGetResource(gc, "n_moments", nmom_, default=0, _RC) call MAPL_GridCompGetResource(gc, "aerosol_monochromatic_optics_wavelength_in_nm_from_LUT", channels_, _RC) self%diag_Mie = GOCART2G_Mie(trim(file_), channels_*1.e-9, nmom=nmom_, _RC) - ! Mie Table instance/index - call ESMF_AttributeSet(aero, name='mie_table_instance', value=instance, _RC) ! Add variables to SS instance's aero state. This is used in aerosol optics calculations - call add_aero (aero, label='air_pressure_for_aerosol_optics', label2='PLE', grid=grid, typekind=MAPL_R4, _RC) - call add_aero (aero, label='relative_humidity_for_aerosol_optics', label2='RH', grid=grid, typekind=MAPL_R4,_RC) + ! add_aero adds 1 to km, when creating field PLE + call add_aero(aero, label='air_pressure_for_aerosol_optics', label2='PLE', geom=geom, km=self%km, _RC) + call add_aero(aero, label='relative_humidity_for_aerosol_optics', label2='RH', geom=geom, km=self%km, _RC) ! call ESMF_StateGet (import, 'PLE', field, _RC) - ! call MAPL_StateAdd (aero, field, _RC) + ! call MAPL2_StateAdd (aero, field, _RC) ! call ESMF_StateGet (import, 'RH2', field, _RC) - ! call MAPL_StateAdd (aero, field, _RC) - call add_aero (aero, label='extinction_in_air_due_to_ambient_aerosol', label2='EXT', grid=grid, typekind=MAPL_R8,_RC) - call add_aero (aero, label='single_scattering_albedo_of_ambient_aerosol', label2='SSA', grid=grid, typekind=MAPL_R8,_RC) - call add_aero (aero, label='asymmetry_parameter_of_ambient_aerosol', label2='ASY', grid=grid, typekind=MAPL_R8,_RC) - call add_aero (aero, label='monochromatic_extinction_in_air_due_to_ambient_aerosol', & - label2='monochromatic_EXT', grid=grid, typekind=MAPL_R4,_RC) - call add_aero (aero, label='sum_of_internalState_aerosol', label2='aerosolSum', grid=grid, typekind=MAPL_R4, _RC) - call ESMF_AttributeSet (aero, name='band_for_aerosol_optics', value=0, _RC) - call ESMF_AttributeSet (aero, name='wavelength_for_aerosol_optics', value=0., _RC) + ! call MAPL2_StateAdd (aero, field, _RC) + call add_aero( & + aero, & + label='extinction_in_air_due_to_ambient_aerosol', label2='EXT', & + geom=geom, km=self%km, typekind=ESMF_TYPEKIND_R8, _RC) + call add_aero( & + aero, & + label='single_scattering_albedo_of_ambient_aerosol', label2='SSA', & + geom=geom, km=self%km, typekind=ESMF_TYPEKIND_R8, _RC) + call add_aero(aero, & + label='asymmetry_parameter_of_ambient_aerosol', label2='ASY', & + geom=geom, km=self%km, typekind=ESMF_TYPEKIND_R8, _RC) + call add_aero( & + aero, & + label='monochromatic_extinction_in_air_due_to_ambient_aerosol', label2='monochromatic_EXT', & + geom=geom, typekind=ESMF_TYPEKIND_R4,_RC) + call add_aero(aero, label='sum_of_internalState_aerosol', label2='aerosolSum', geom=geom, km=self%km, _RC) + call ESMF_InfoGetFromHost(aero, aero_info, _RC) + call ESMF_InfoSet(aero_info, key="mie_table_instance", value=instance, _RC) + call ESMF_InfoSet(aero_info, key="band_for_aerosol_optics", value=0, _RC) + call ESMF_InfoSet(aero_info, key="wavelength_for_aerosol_optics", value=0, _RC) mieTable_pointer = transfer(c_loc(self), [1]) - call ESMF_AttributeSet (aero, name='mieTable_pointer', valueList=mieTable_pointer, itemCount=size(mieTable_pointer), _RC) - call ESMF_AttributeSet (aero, name='internal_variable_name', value='SS', _RC) - call ESMF_MethodAdd (aero, label='aerosol_optics', userRoutine=aerosol_optics, _RC) - call ESMF_MethodAdd (aero, label='monochromatic_aerosol_optics', userRoutine=monochromatic_aerosol_optics, _RC) - call ESMF_MethodAdd (aero, label='get_mixR', userRoutine=get_mixR, _RC) + call ESMF_InfoSet(aero_info, key="mieTable_pointer", values=mieTable_pointer, _RC) + call ESMF_InfoSet(aero_info, key="internal_variable_name", value="SS", _RC) + ! Add callback methods + call ESMF_MethodAdd(aero, label="aerosol_optics", userRoutine=aerosol_optics, _RC) + call ESMF_MethodAdd(aero, label="monochromatic_aerosol_optics", userRoutine=monochromatic_aerosol_optics, _RC) + call ESMF_MethodAdd(aero, label="get_mixR", userRoutine=get_mixR, _RC) ! Mask to prevent emissions from the Great Lakes and the Caspian Sea !allocate(self%deep_lakes_mask(ubound(lons, 1),ubound(lons, 2)), __STAT__) !call deepLakesMask (lons, lats, real(MAPL_RADIANS_TO_DEGREES), self%deep_lakes_mask, _RC) call MAPL_StateGetPointer(internal, itemName="DEEP_LAKES_MASK", farrayPtr=deep_lakes_mask, _RC) - call deepLakesMask (lons, lats, real(MAPL_RADIANS_TO_DEGREES), deep_lakes_mask, _RC) + call MAPL_GridGet(grid, latitudes=lats, longitudes=lons, _RC) + call deepLakesMask(lons, lats, real(MAPL_RADIANS_TO_DEGREES), deep_lakes_mask, _RC) call logger%info("Initialize:: ...complete") _RETURN(_SUCCESS) @@ -890,38 +885,40 @@ end subroutine Run_data subroutine aerosol_optics(state, rc) !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc + type(ESMF_State) :: state + integer, intent(out) :: rc !Local - integer, parameter :: DP=kind(1.0d0) - real, dimension(:,:,:), pointer :: ple, rh - real(kind=DP), dimension(:,:,:), pointer :: var - real, dimension(:,:,:,:), pointer :: q, q_4d - integer, allocatable :: opaque_self(:) - type(C_PTR) :: address - type(SS2G_GridComp), pointer :: self - - character (len=ESMF_MAXSTR) :: fld_name, int_fld_name - type(ESMF_Field) :: fld - - real(kind=DP), dimension(:,:,:), allocatable :: ext_s, ssa_s, asy_s ! (lon:,lat:,lev:) - real, dimension(:,:,:), allocatable :: x - integer :: instance - integer :: n, nbins - integer :: i1, j1, i2, j2, km - integer :: band + integer, parameter :: DP=kind(1.0d0) + real, dimension(:,:,:), pointer :: ple, rh + real(kind=DP), dimension(:,:,:), pointer :: var + real, dimension(:,:,:,:), pointer :: q, q_4d + integer, allocatable :: opaque_self(:) + type(C_PTR) :: address + type(SS2G_GridComp), pointer :: self + + character(len=ESMF_MAXSTR) :: fld_name, int_fld_name + type(ESMF_Field) :: fld + type(ESMF_Info) :: info + + real(kind=DP), dimension(:,:,:), allocatable :: ext_s, ssa_s, asy_s ! (lon:,lat:,lev:) + real, dimension(:,:,:), allocatable :: x + integer :: instance + integer :: n, nbins + integer :: i1, j1, i2, j2, km + integer :: band integer :: k, status + call ESMF_InfoGetFromHost(state, info, _RC) + ! Mie Table instance/index - call ESMF_AttributeGet(state, name='mie_table_instance', value=instance, _RC) + call ESMF_InfoGet(info, key="mie_table_instance", value=instance, _RC) ! Radiation band - band = 0 - call ESMF_AttributeGet(state, name='band_for_aerosol_optics', value=band, _RC) + call ESMF_InfoGet(info, key="band_for_aerosol_optics", value=band, default=0, _RC) ! Pressure at layer edges - call ESMF_AttributeGet(state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(info, key="air_pressure_for_aerosol_optics", value=fld_name, _RC) call MAPL_StateGetPointer(state, ple, trim(fld_name), _RC) ! call MAPL_GetPointer (state, ple, 'PLE', _RC) @@ -931,7 +928,7 @@ subroutine aerosol_optics(state, rc) km = ubound(ple, 3) ! Relative humidity - call ESMF_AttributeGet(state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(info, key="relative_humidity_for_aerosol_optics", value=fld_name, _RC) call MAPL_StateGetPointer(state, rh, trim(fld_name), _RC) ! call MAPL_GetPointer (state, rh, 'RH2', _RC) @@ -942,9 +939,9 @@ subroutine aerosol_optics(state, rc) asy_s(i1:i2, j1:j2, km), & x(i1:i2, j1:j2, km), _STAT) - call ESMF_AttributeGet(state, name='internal_variable_name', value=int_fld_name, _RC) - call ESMF_StateGet (state, trim(int_fld_name), field=fld, _RC) !add as attribute - dont hard code? - call ESMF_FieldGet (fld, farrayPtr=q, _RC) + call ESMF_InfoGet(info, key="internal_variable_name", value=int_fld_name, _RC) + call ESMF_StateGet(state, trim(int_fld_name), field=fld, _RC) !add as attribute - dont hard code? + call ESMF_FieldGet(fld, farrayPtr=q, _RC) nbins = size(q,4) @@ -957,28 +954,26 @@ subroutine aerosol_optics(state, rc) end do end do - call ESMF_AttributeGet(state, name='mieTable_pointer', itemCount=n, _RC) - allocate (opaque_self(n), _STAT) - call ESMF_AttributeGet(state, name='mieTable_pointer', valueList=opaque_self, _RC) + call ESMF_InfoGet(info, key="mieTable_pointer", values=opaque_self, _RC) address = transfer(opaque_self, address) call c_f_pointer(address, self) - call mie_ (self%rad_Mie, nbins, band, q_4d, rh, ext_s, ssa_s, asy_s, _RC) + call mie_(self%rad_Mie, nbins, band, q_4d, rh, ext_s, ssa_s, asy_s, _RC) - call ESMF_AttributeGet(state, name='extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key="extinction_in_air_due_to_ambient_aerosol", value=fld_name, _RC) if (fld_name /= '') then call MAPL_StateGetPointer(state, var, trim(fld_name), _RC) var = ext_s(:,:,:) end if - call ESMF_AttributeGet(state, name='single_scattering_albedo_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key="single_scattering_albedo_of_ambient_aerosol", value=fld_name, _RC) if (fld_name /= '') then call MAPL_StateGetPointer(state, var, trim(fld_name), _RC) var = ssa_s(:,:,:) end if - call ESMF_AttributeGet(state, name='asymmetry_parameter_of_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key="asymmetry_parameter_of_ambient_aerosol", value=fld_name, _RC) if (fld_name /= '') then call MAPL_StateGetPointer(state, var, trim(fld_name), _RC) var = asy_s(:,:,:) @@ -992,21 +987,21 @@ subroutine aerosol_optics(state, rc) contains subroutine mie_(mie, nbins, band, q, rh, bext_s, bssa_s, basym_s, rc) - type(GOCART2G_Mie), intent(inout) :: mie ! mie table - integer, intent(in ) :: nbins ! number of bins - integer, intent(in ) :: band ! channel - real, intent(in ) :: q(:,:,:,:) ! aerosol mass mixing ratio, kg kg-1 - real, intent(in ) :: rh(:,:,:) ! relative humidity - real(kind=8), intent( out) :: bext_s (size(ext_s,1),size(ext_s,2),size(ext_s,3)) - real(kind=8), intent( out) :: bssa_s (size(ext_s,1),size(ext_s,2),size(ext_s,3)) - real(kind=8), intent( out) :: basym_s(size(ext_s,1),size(ext_s,2),size(ext_s,3)) - integer, intent(out) :: rc + type(GOCART2G_Mie), intent(inout) :: mie ! mie table + integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: band ! channel + real, intent(in) :: q(:,:,:,:) ! aerosol mass mixing ratio, kg kg-1 + real, intent(in) :: rh(:,:,:) ! relative humidity + real(kind=8), intent(out) :: bext_s (size(ext_s,1),size(ext_s,2),size(ext_s,3)) + real(kind=8), intent(out) :: bssa_s (size(ext_s,1),size(ext_s,2),size(ext_s,3)) + real(kind=8), intent(out) :: basym_s(size(ext_s,1),size(ext_s,2),size(ext_s,3)) + integer, intent(out) :: rc ! local - integer :: l - real :: bext (size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! extinction - real :: bssa (size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! SSA - real :: gasym(size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! asymmetry parameter + integer :: l + real :: bext (size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! extinction + real :: bssa (size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! SSA + real :: gasym(size(ext_s,1),size(ext_s,2),size(ext_s,3)) ! asymmetry parameter integer :: status bext_s = 0.0d0 @@ -1030,36 +1025,39 @@ end subroutine aerosol_optics subroutine monochromatic_aerosol_optics(state, rc) !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc + type (ESMF_State) :: state + integer, intent(out) :: rc !Local - real, dimension(:,:,:), pointer :: ple, rh - real, dimension(:,:), pointer :: var - real, dimension(:,:,:,:), pointer :: q, q_4d - integer, allocatable :: opaque_self(:) - type(C_PTR) :: address - type(SS2G_GridComp), pointer :: self - - character (len=ESMF_MAXSTR) :: fld_name - type(ESMF_Field) :: fld - - real, dimension(:,:,:), allocatable :: tau_s, tau, x ! (lon:,lat:,lev:) - integer :: instance - integer :: n, nbins, k - integer :: i1, j1, i2, j2, km, i, j - real :: wavelength + real, dimension(:,:,:), pointer :: ple, rh + real, dimension(:,:), pointer :: var + real, dimension(:,:,:,:), pointer :: q, q_4d + integer, allocatable :: opaque_self(:) + type(C_PTR) :: address + type(SS2G_GridComp), pointer :: self + + character(len=ESMF_MAXSTR) :: fld_name + type(ESMF_Field) :: fld + type(ESMF_Info) :: info + + real, dimension(:,:,:), allocatable :: tau_s, tau, x ! (lon:,lat:,lev:) + integer :: instance + integer :: n, nbins, k + integer :: i1, j1, i2, j2, km, i, j + real :: wavelength integer :: status + call ESMF_InfoGetFromHost(state, info, _RC) + ! Mie Table instance/index - call ESMF_AttributeGet (state, name='mie_table_instance', value=instance, _RC) + call ESMF_InfoGet(info, key="mie_table_instance", value=instance, _RC) ! Radiation band wavelength = 0. - call ESMF_AttributeGet (state, name='wavelength_for_aerosol_optics', value=wavelength, _RC) + call ESMF_InfoGet(info, key="wavelength_for_aerosol_optics", value=wavelength, _RC) ! Pressure at layer edges - call ESMF_AttributeGet (state, name='air_pressure_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(info, key="air_pressure_for_aerosol_optics", value=fld_name, _RC) call MAPL_StateGetPointer(state, ple, trim(fld_name), _RC) ! call MAPL_GetPointer (state, ple, 'PLE', _RC) @@ -1069,7 +1067,7 @@ subroutine monochromatic_aerosol_optics(state, rc) km = ubound(ple, 3) ! Relative humidity - call ESMF_AttributeGet (state, name='relative_humidity_for_aerosol_optics', value=fld_name, _RC) + call ESMF_InfoGet(info, key="relative_humidity_for_aerosol_optics", value=fld_name, _RC) call MAPL_StateGetPointer(state, rh, trim(fld_name), _RC) ! call MAPL_GetPointer (state, rh, 'RH2', _RC) @@ -1081,8 +1079,8 @@ subroutine monochromatic_aerosol_optics(state, rc) tau_s = 0. tau = 0. - call ESMF_StateGet (state, 'SS', field=fld, _RC) - call ESMF_FieldGet (fld, farrayPtr=q, _RC) + call ESMF_StateGet(state, 'SS', field=fld, _RC) + call ESMF_FieldGet(fld, farrayPtr=q, _RC) nbins = size(q,4) @@ -1096,9 +1094,7 @@ subroutine monochromatic_aerosol_optics(state, rc) end do end do - call ESMF_AttributeGet(state, name='mieTable_pointer', itemCount=n, _RC) - allocate (opaque_self(n), _STAT) - call ESMF_AttributeGet(state, name='mieTable_pointer', valueList=opaque_self, _RC) + call ESMF_InfoGet(info, key="mieTable_pointer", values=opaque_self, _RC) address = transfer(opaque_self, address) call c_f_pointer(address, self) @@ -1108,7 +1104,7 @@ subroutine monochromatic_aerosol_optics(state, rc) tau_s = tau_s + tau end do - call ESMF_AttributeGet (state, name='monochromatic_extinction_in_air_due_to_ambient_aerosol', value=fld_name, _RC) + call ESMF_InfoGet(info, key="monochromatic_extinction_in_air_due_to_ambient_aerosol", value=fld_name, _RC) if (fld_name /= '') then call MAPL_StateGetPointer(state, var, trim(fld_name), _RC) var = sum(tau_s, dim=3) diff --git a/ESMF/Shared/CMakeLists.txt b/ESMF/Shared/CMakeLists.txt index c4aa4053..becab5d0 100644 --- a/ESMF/Shared/CMakeLists.txt +++ b/ESMF/Shared/CMakeLists.txt @@ -3,26 +3,23 @@ esma_set_this (OVERRIDE Chem_Shared2G) set (srcs Chem_AeroGeneric.F90 ReplenishAlarm.F90 - ) +) esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL ESMF::ESMF) + DEPENDENCIES MAPL MAPL.field_bundle ESMF::ESMF +) if( EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/@GSW ) - set (gsw_ECBUILD_SYSTEM_INCLUDED TRUE) + set (gsw_ECBUILD_SYSTEM_INCLUDED TRUE) endif() if (NOT TARGET MAPL) if ( IS_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/MAPL@ ) - esma_add_subdirectories ( - MAPL - ) + esma_add_subdirectories (MAPL) endif () endif () if ( IS_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/GMAO_Shared@ ) - esma_add_subdirectories ( - GMAO_Shared - ) + esma_add_subdirectories (GMAO_Shared) endif () diff --git a/ESMF/Shared/Chem_AeroGeneric.F90 b/ESMF/Shared/Chem_AeroGeneric.F90 index e564b1b0..36167ff9 100644 --- a/ESMF/Shared/Chem_AeroGeneric.F90 +++ b/ESMF/Shared/Chem_AeroGeneric.F90 @@ -1,31 +1,29 @@ - #include "MAPL_Generic.h" !------------------------------------------------------------------------- ! NASA/GSFC, Global Modeling & Assimilation Office, Code 610.1 ! !------------------------------------------------------------------------- !BOP -! - ! !MODULE: Chem_AeroGeneric - Utilitarian subroutines used by GOCART2G children. -! -! + ! !INTERFACE: -! module Chem_AeroGeneric -! !USES: + !USES: use ESMF - use MAPL + use mapl_ErrorHandling, only: MAPL_Verify, MAPL_Assert, MAPL_Return use mapl3g_State_API, only: MAPL_StateGetPointer - use mapl3g_Field_API, only: MAPL_FieldGet -! USE Chem_MieMod2G + use mapl3g_Field_API, only: MAPL_FieldGet, MAPL_FieldCreate + use mapl3g_FieldInfo, only: FieldInfoSetInternal + use mapl3g_FieldBundle_API, only: MAPL_FieldBundleAdd + use mapl3g_VerticalStaggerLoc, only: VerticalStaggerLoc, VERTICAL_STAGGER_EDGE, VERTICAL_STAGGER_CENTER + use mapl3g_UngriddedDims, only: UngriddedDims + ! USE Chem_MieMod2G implicit none private -! -! !PUBLIC MEMBER FUNCTIONS: + !PUBLIC MEMBER FUNCTIONS: public add_aero public append_to_bundle public determine_data_driven @@ -33,398 +31,359 @@ module Chem_AeroGeneric public setZeroKlid4d public findKlid public get_mixR -! -! !DESCRIPTION: -! -! These subroutines perform repetitive tasks needed by GOCART2G children. -! -! !REVISION HISTORY: -! -! March2020 Sherman, da Silva, Darmenov, Clune - created -! -!EOP -!------------------------------------------------------------------------- -contains - -!==================================================================================== - subroutine add_aero (state, label, label2, grid, typekind, ptr, rc) + !DESCRIPTION: + ! These subroutines perform repetitive tasks needed by GOCART2G children. -! Description: Adds fields to aero state for aerosol optics calcualtions. + !REVISION HISTORY: + ! March2020 Sherman, da Silva, Darmenov, Clune - created + !EOP - implicit none - - type (ESMF_State), intent(inout) :: state - character (len=*), intent(in ) :: label - character (len=*), intent(in ) :: label2 - type (ESMF_Grid), intent(inout) :: grid - integer, intent(in ) :: typekind - real, pointer, dimension(:,:,:), optional, intent(in ) :: ptr - integer, intent( out) :: rc +contains - ! locals - type (ESMF_Field) :: field - character (len=ESMF_MAXSTR) :: field_name + subroutine add_aero(state, label, label2, geom, km, typekind, ptr, rc) + + ! Description: Adds fields to aero state for aerosol optics calcualtions. + + type(ESMF_State), intent(inout) :: state + character(len=*), intent(in) :: label + character(len=*), intent(in) :: label2 + type(ESMF_Geom), intent(in) :: geom + integer, optional, intent(in) :: km + type(ESMF_TypeKind_Flag), optional, intent(in) :: typekind + real, pointer, dimension(:,:,:), optional, intent(in) :: ptr + integer, intent(out) :: rc + + ! locals + type(ESMF_Field) :: field + type(ESMF_Info) :: info + character(len=:), allocatable :: field_name + type(ESMF_TypeKind_Flag) :: typekind_ + integer :: status + + typekind_ = ESMF_TYPEKIND_R4 + if (present(typekind)) typekind_ = typekind + + call ESMF_InfoGetFromHost(state, info, _RC) + call ESMF_InfoSet(info, key=trim(label), value=trim(label2), _RC) + + field_name = trim(label2) + if (field_name /= "") then + if (trim(field_name) == "PLE") then + _ASSERT(present(km), "missing km for a 3D field") + field = MAPL_FieldCreate( & + geom, typekind_, & + name=field_name, & + num_levels=km+1, & + vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) + else if ((trim(field_name) == "FRLAND") .or. (trim(field_name) == "monochromatic_EXT")) then + field = MAPL_FieldCreate(geom, typekind_, name=field_name, _RC) + else + _ASSERT(present(km), "missing km for a 3D field") + field = MAPL_FieldCreate( & + geom, typekind_, & + name=field_name, & + num_levels=km, & + vert_staggerloc=VERTICAL_STAGGER_CENTER, _RC) + end if + call ESMF_StateAdd(state, [field], _RC) + end if - __Iam__('add_aero') + ! if (field_name /= "") then + ! field = ptr + ! call ESMF_StateAdd(state, [field], _RC) + ! end if -!---------------------------------------------------------------------------------- -! Begin... + _RETURN(_SUCCESS) - call ESMF_AttributeSet (state, name=trim(label), value=trim(label2), __RC__) + end subroutine add_aero - call ESMF_AttributeGet (state, name=trim(label), value=field_name, __RC__) - if (field_name /= '') then - field = MAPL_FieldCreateEmpty(trim(field_name), grid, __RC__) - if (trim(field_name) == 'PLE') then - call MAPL_FieldAllocCommit (field, dims=MAPL_DimsHorzVert, location=MAPL_VLocationEdge, typekind=typekind, hw=0, __RC__) - else if ((trim(field_name) == 'FRLAND') .or. (trim(field_name) == 'monochromatic_EXT')) then - call MAPL_FieldAllocCommit(field, dims=MAPL_DimsHorzOnly, location=MAPL_VLocationCenter, typekind=MAPL_R4, hw=0, __RC__) - else - call MAPL_FieldAllocCommit (field, dims=MAPL_DimsHorzVert, location=MAPL_VLocationCenter, typekind=typekind, hw=0, __RC__) - end if - call MAPL_StateAdd (state, field, __RC__) - end if + recursive subroutine determine_data_driven(comp_name, data_driven, rc) + !ARGUMENTS: + character(len=*), intent(in) :: comp_name + logical, intent(out) :: data_driven + integer, optional, intent(out) :: rc -! if (field_name /= '') then -! field = ptr -! call MAPL_StateAdd (state, field, __RC__) -! end if + !Local + integer :: i - RETURN_(ESMF_SUCCESS) + ! Description: Determines whether gridded component is data driven or not. - end subroutine add_aero + data_driven = .false. + i = index(comp_name, 'data') + if (i > 0) then + data_driven = .true. + end if -!===================================================================================== - - recursive subroutine determine_data_driven(COMP_NAME, data_driven, RC) - - !ARGUMENTS: - integer, optional, intent( out) :: RC ! Error code: - character (len=ESMF_MAXSTR), intent(in ) :: COMP_NAME - logical, intent( out) :: data_driven - - !Local - integer :: i - -! Description: Determines whether gridded component is data driven or not. - - __Iam__('determine_data_driven') - -! Begin... - -! Is DU data driven? -! ------------------ - data_driven = .false. - - i = index(COMP_NAME, 'data') - if (i > 0) then - data_driven = .true. - end if - - RETURN_(ESMF_SUCCESS) - - end subroutine determine_data_driven - -!===================================================================================== - - subroutine append_to_bundle(varName, providerState, prefix, bundle, rc) - - implicit none - -! !ARGUMENTS: - character (len=*), intent(in ) :: varName, prefix - type (ESMF_State), intent(inout) :: providerState - type (ESMF_FieldBundle), intent(inout) :: bundle - integer, intent( out) :: rc ! return code - -! !Local - type (ESMF_Field) :: field, field2D - type (ESMF_Grid) :: grid - integer :: dimCount, i - real, pointer :: orig_ptr(:,:,:) - real, pointer :: ptr2d(:,:) - character(len=ESMF_MAXSTR) :: bin_index, varNameNew - character(:), allocatable :: units, stdname - -! Description: Adds deposition variables to deposition bundle - - __Iam__('append_to_bundle') - -! Dry deposition -! --------------- - call ESMF_StateGet (providerState, trim(prefix)//trim(varName), field, __RC__) - call MAPL_AllocateCoupling (field, __RC__) - call ESMF_FieldGet (field, dimCount=dimCount, __RC__) - - if (dimCount == 2) then ! this handles data instances - call MAPL_FieldBundleAdd (bundle, field, __RC__) - - else if (dimCount == 3) then ! this handles computational instances - call ESMF_FieldGet (field, grid=grid, __RC__) - call MAPL_StateGetPointer(providerState, itemName=trim(prefix)//trim(varName), farrayPtr=orig_ptr, _RC) - call MAPL_FieldGet(field, units=units, standard_name=stdname, _RC) - stdname=stdname(1:index(stdname, '(Bin')-1) - - if ((index(trim(varname), 'DU') > 0) .or. (index(trim(varname), 'SS') > 0)) then - do i = 1, size(orig_ptr, 3) - write (bin_index,'(A, I0.3)') '', i - ptr2d => orig_ptr(:,:,i) - field2D = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& - name=trim(varName)//trim(bin_index) , indexflag=ESMF_INDEX_DELOCAL, __RC__) - call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) - call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) - call ESMF_AttributeSet(field2d, name='UNITS', value=trim(units), _RC) - call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin '//trim(bin_index), _RC) - call MAPL_AllocateCoupling (field2D, __RC__) - call MAPL_FieldBundleAdd (bundle, field2D, __RC__) - end do - end if - - if (index(trim(varname), 'SU') > 0) then ! only use SO4, which is the 3rd index - ptr2d => orig_ptr(:,:,3) - field2D = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& - name=trim(varName)//'003' , indexflag=ESMF_INDEX_DELOCAL, __RC__) - call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) - call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) - call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) - call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin 003', _RC) - call MAPL_AllocateCoupling (field2D, __RC__) - call MAPL_FieldBundleAdd (bundle, field2D, __RC__) - end if - - if (index(trim(varname), 'CA.oc') > 0) then - do i = 1, size(orig_ptr, 3) - write (bin_index,'(A, I0.3)') '', i - ptr2d => orig_ptr(:,:,i) - varNameNew = 'OC'//varName(6:7) - field2D = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& - name=trim(varNameNew)//trim(bin_index) , indexflag=ESMF_INDEX_DELOCAL, __RC__) - call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) - call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) - call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) - call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin '//trim(bin_index), _RC) - call MAPL_AllocateCoupling (field2D, __RC__) - call MAPL_FieldBundleAdd (bundle, field2D, __RC__) - end do - end if - - if (index(trim(varname), 'CA.bc') > 0) then - do i = 1, size(orig_ptr, 3) - write (bin_index,'(A, I0.3)') '', i - ptr2d => orig_ptr(:,:,i) - varNameNew = 'BC'//varName(6:7) - field2D = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& - name=trim(varNameNew)//trim(bin_index) , indexflag=ESMF_INDEX_DELOCAL, __RC__) - call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) - call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) - call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) - call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin '//trim(bin_index), _RC) - call MAPL_AllocateCoupling (field2D, __RC__) - call MAPL_FieldBundleAdd (bundle, field2D, __RC__) - end do - end if - - else if (dimCount > 3) then - if(mapl_am_i_root()) print*,'Chem_AeroGenric::append_to_bundle does not currently support fields greater than 3 dimensions' - VERIFY_(824) - end if - - RETURN_(ESMF_SUCCESS) - - end subroutine append_to_bundle - -!=================================================================================== -!BOP -! !IROUTINE: setZeroKlid + _RETURN(_SUCCESS) + end subroutine determine_data_driven + + subroutine append_to_bundle(varname, provider_state, prefix, bundle, rc) + !ARGUMENTS: + character(len=*), intent(in) :: varname, prefix + type(ESMF_State), intent(inout) :: provider_state + type(ESMF_FieldBundle), intent(inout) :: bundle + integer, intent(out) :: rc + + !Local + type(ESMF_Field) :: field, field2d + type(ESMF_Info) :: info + type(ESMF_Geom) :: geom + real, pointer :: orig_ptr(:,:,:) + real, pointer :: ptr2d(:,:) + character(len=ESMF_MAXSTR) :: bin_index + character(:), allocatable :: varname_new, units, stdname + type(VerticalStaggerLoc) :: vert_stagger + integer :: dim_count, iter, status + + ! Description: Adds deposition variables to deposition bundle + + ! Dry deposition + call ESMF_StateGet(provider_state, trim(prefix)//trim(varname), field, _RC) + call ESMF_FieldGet(field, dimCount=dim_count, _RC) + + _ASSERT(dim_count==2 .or. dim_count==3, "only 2d and 3d fields are supported") + + select case(dim_count) + case(2) ! this handles data instances + call MAPL_FieldBundleAdd(bundle, [field], _RC) + + case(3) ! this handles computational instances + call MAPL_FieldGet(field, geom=geom, units=units, standard_name=stdname, vert_staggerloc=vert_stagger, _RC) + stdname = stdname(1:index(stdname, "(Bin")-1) + call MAPL_StateGetPointer(provider_state, itemName=trim(prefix)//trim(varname), farrayPtr=orig_ptr, _RC) + + if ((index(trim(varname), "DU") > 0) .or. (index(trim(varname), "SS") > 0)) then + do iter = 1, size(orig_ptr, 3) + write (bin_index, "(A, I0.3)") "", iter + ptr2d => orig_ptr(:,:,iter) + field2d = ESMF_FieldCreate( & + geom, & + farray=ptr2d, & + indexflag=ESMF_INDEX_DELOCAL, & + datacopyflag=ESMF_DATACOPY_REFERENCE, & + name=trim(varname)//trim(bin_index), _RC) + call ESMF_InfoGetFromHost(field2d, info, _RC) + call FieldInfoSetInternal( & + info, & + vert_staggerloc=vert_stagger, & + ungridded_dims=UngriddedDims(), & + units=units, & + standard_name=stdname//' Bin '//trim(bin_index), & + long_name="unknown", _RC) + call MAPL_FieldBundleAdd(bundle, [field2d], _RC) + end do + end if + + ! if (index(trim(varname), 'SU') > 0) then ! only use SO4, which is the 3rd index + ! ptr2d => orig_ptr(:,:,3) + ! field2d = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& + ! name=trim(varname)//'003' , indexflag=ESMF_INDEX_DELOCAL, _RC) + ! call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) + ! call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) + ! call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) + ! call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin 003', _RC) + ! call MAPL2_AllocateCoupling(field2d, _RC) + ! call MAPL2_FieldBundleAdd(bundle, field2d, _RC) + ! end if + + ! if (index(trim(varname), 'CA.oc') > 0) then + ! do iter = 1, size(orig_ptr, 3) + ! write (bin_index,'(A, I0.3)') '', iter + ! ptr2d => orig_ptr(:,:,iter) + ! varname_new = 'OC'//varname(6:7) + ! field2d = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& + ! name=trim(varname_new)//trim(bin_index) , indexflag=ESMF_INDEX_DELOCAL, _RC) + ! call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) + ! call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) + ! call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) + ! call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin '//trim(bin_index), _RC) + ! call MAPL2_AllocateCoupling(field2d, _RC) + ! call MAPL2_FieldBundleAdd(bundle, field2d, _RC) + ! end do + ! end if + + ! if (index(trim(varname), 'CA.bc') > 0) then + ! do i = 1, size(orig_ptr, 3) + ! write (bin_index,'(A, I0.3)') '', iter + ! ptr2d => orig_ptr(:,:,iter) + ! varname_new = 'BC'//varname(6:7) + ! field2d = ESMF_FieldCreate(grid=grid, datacopyflag=ESMF_DATACOPY_REFERENCE, farray=ptr2d,& + ! name=trim(varname_new)//trim(bin_index) , indexflag=ESMF_INDEX_DELOCAL, _RC) + ! call ESMF_AttributeSet(field2d, name='DIMS', value=MAPL_DimsHorzOnly, _RC) + ! call ESMF_AttributeSet(field2d, name='VLOCATION', value=MAPL_VLocationNone, _RC) + ! call ESMF_AttributeSet(field2d, name='UNITS', value=units, _RC) + ! call ESMF_AttributeSet(field2d, name='STANDARD_NAME', value=stdname//' Bin '//trim(bin_index), _RC) + ! call MAPL2_AllocateCoupling(field2d, _RC) + ! call MAPL2_FieldBundleAdd(bundle, field2d, _RC) + ! end do + ! end if + + case default + _FAIL("dim_count is other than 2 and 3") + end select + + _RETURN(_SUCCESS) + end subroutine append_to_bundle + + !BOP + !IROUTINE: setZeroKlid subroutine setZeroKlid(km, klid, int_ptr) -! !USES: - implicit NONE - -! !INPUT PARAMETERS: - integer, intent(in) :: km ! total model levels - integer, intent(in) :: klid ! index for pressure level - -! !INOUTPUT PARAMETERS: - real, dimension(:,:,:), intent(inout) :: int_ptr ! aerosol pointer - -! !DESCRIPTION: Set values to 0 where above klid -! -! !REVISION HISTORY: -! -! 25Aug2020 E.Sherman - Written -! -! !Local Variables - integer :: k - -!EOP -!---------------------------------------------------------------------------------- -! Begin... - - do k = 1, km - if (k < klid) then - int_ptr(:,:,k) = 0.0 - else if (k >= klid) then - exit - end if - end do - - end subroutine setZeroKlid -!=================================================================================== -!BOP -! !IROUTINE: setZeroKlid - subroutine setZeroKlid4d (km, klid, int_ptr) - -! !USES: - implicit NONE + !INPUT PARAMETERS: + integer, intent(in) :: km ! total model levels + integer, intent(in) :: klid ! index for pressure level -! !INPUT PARAMETERS: - integer, intent(in) :: km ! total model levels - integer, intent(in) :: klid ! index for pressure level + !INOUTPUT PARAMETERS: + real, dimension(:,:,:), intent(inout) :: int_ptr ! aerosol pointer -! !INOUTPUT PARAMETERS: - real, dimension(:,:,:,:), intent(inout) :: int_ptr ! aerosol pointer + !DESCRIPTION: Set values to 0 where above klid + !REVISION HISTORY: + ! 25Aug2020 E.Sherman - Written -! !DESCRIPTION: Set values to 0 where above klid -! -! !REVISION HISTORY: -! -! 25Aug2020 E.Sherman - Written -! -! !Local Variables - integer :: k, n + !Local Variables + integer :: k + !EOP -!EOP -!---------------------------------------------------------------------------------- -! Begin... - - do n = 1, ubound(int_ptr, 4) do k = 1, km if (k < klid) then - int_ptr(:,:,k,n) = 0.0 + int_ptr(:,:,k) = 0.0 else if (k >= klid) then exit end if end do - end do - end subroutine setZeroKlid4d + end subroutine setZeroKlid + !BOP + !IROUTINE: setZeroKlid + subroutine setZeroKlid4d (km, klid, int_ptr) -!=================================================================================== -!BOP -! !IROUTINE: findKlid + !INPUT PARAMETERS: + integer, intent(in) :: km ! total model levels + integer, intent(in) :: klid ! index for pressure level + + !INOUTPUT PARAMETERS: + real, dimension(:,:,:,:), intent(inout) :: int_ptr ! aerosol pointer + + !DESCRIPTION: Set values to 0 where above klid + !REVISION HISTORY: + ! 25Aug2020 E.Sherman - Written + + !Local Variables + integer :: k, n + !EOP + + do n = 1, ubound(int_ptr, 4) + do k = 1, km + if (k < klid) then + int_ptr(:,:,k,n) = 0.0 + else if (k >= klid) then + exit + end if + end do + end do + + end subroutine setZeroKlid4d + + !BOP + !IROUTINE: findKlid subroutine findKlid (klid, plid, ple, rc) -! !USES: - implicit NONE - -! !INPUT PARAMETERS: - integer, intent(inout) :: klid ! index for pressure lid - real, intent(in) :: plid ! pressure lid [hPa] - real, dimension(:,:,:), intent(in) :: ple ! air pressure [Pa] - -! !OUTPUT PARAMETERS: - integer, intent(out) :: rc ! return code; 0 - all is good -! 1 - bad - -! !DESCRIPTION: Finds corresponding vertical index for defined pressure lid -! -! !REVISION HISTORY: -! -! 25Aug2020 E.Sherman - Written -! -! !Local Variables - integer :: k, j, i - real :: plid_, diff, refDiff - real, allocatable, dimension(:) :: pres ! pressure at each model level [Pa] - -!EOP -!---------------------------------------------------------------------------------- -! Begin... - klid = 1 - rc = 0 - -! convert from hPa to Pa - plid_ = plid*100.0 - - allocate(pres(ubound(ple,3))) - -! find pressure at each model level - do k = 1, ubound(ple,3) - pres(k) = ple(1,1,k) - end do - -! find smallest absolute difference between plid and average pressure at each model level - refDiff = 150000.0 - do k = 1, ubound(ple,3) - diff = abs(pres(k) - plid_) - if (diff < refDiff) then - klid = k - refDiff = diff - end if - end do - -! Check to make sure that all pressures at (i,j) were the same - do j = 1, ubound(ple,2) - do i = 1, ubound(ple,1) - if (pres(klid) /= ple(i,j,klid)) then - rc = 1 - return + !INPUT PARAMETERS: + integer, intent(inout) :: klid ! index for pressure lid + real, intent(in) :: plid ! pressure lid [hPa] + real, dimension(:,:,:), intent(in) :: ple ! air pressure [Pa] + + !OUTPUT PARAMETERS: + integer, intent(out) :: rc ! return code; 0 - all is good, 1 - bad + + !DESCRIPTION: Finds corresponding vertical index for defined pressure lid + !REVISION HISTORY: + ! 25Aug2020 E.Sherman - Written + + !Local Variables + integer :: k, j, i + real :: plid_, diff, refDiff + real, allocatable, dimension(:) :: pres ! pressure at each model level [Pa] + !EOP + + klid = 1 + rc = 0 + + ! convert from hPa to Pa + plid_ = plid*100.0 + + allocate(pres(ubound(ple,3))) + + ! find pressure at each model level + do k = 1, ubound(ple,3) + pres(k) = ple(1,1,k) + end do + + ! find smallest absolute difference between plid and average pressure at each model level + refDiff = 150000.0 + do k = 1, ubound(ple,3) + diff = abs(pres(k) - plid_) + if (diff < refDiff) then + klid = k + refDiff = diff end if end do - end do + + ! Check to make sure that all pressures at (i,j) were the same + do j = 1, ubound(ple,2) + do i = 1, ubound(ple,1) + if (pres(klid) /= ple(i,j,klid)) then + rc = 1 + return + end if + end do + end do end subroutine findKlid -!=================================================================================== -!BOP -! !IROUTINE: get_mixR - subroutine get_mixR (state, rc) - -! !USES: - implicit none - -! !ARGUMENTS: - type (ESMF_State) :: state - integer, intent(out) :: rc - -! !LOCALS: - real, dimension(:,:,:), pointer :: ptr3d - real, dimension(:,:,:,:), pointer :: ptr4d - real, dimension(:,:,:), pointer :: aeroSum - character (len=ESMF_MAXSTR) :: fld_name - integer :: aeroN, i - character (len=ESMF_MAXSTR), allocatable :: aerosolNames(:) - integer :: status - -! Begin... - - call ESMF_AttributeGet(state, name='internal_variable_name', itemCount=aeroN, __RC__) - allocate (aerosolNames(aeroN), __STAT__) - call ESMF_AttributeGet(state, name='internal_variable_name', valueList=aerosolNames, __RC__) - -! Zero out previous aerosol sum value so it doesn't keep growing. - call ESMF_AttributeGet (state, name='sum_of_internalState_aerosol', value=fld_name, __RC__) - if (fld_name /= '') then - call MAPL_GetPointer (state, aeroSum, trim(fld_name), __RC__) - aeroSum = 0.0 - end if - - do i = 1, size(aerosolNames) - if ((aerosolNames(i) == 'DU') .or. (aerosolNames(i) == 'SS')) then - call MAPL_GetPointer (state, ptr4d, trim(aerosolNames(i)), __RC__) - aeroSum = sum(ptr4d, dim=4) !DU and SS only have 1 internal state variable so no need to =+ - else - call MAPL_GetPointer (state, ptr3d, trim(aerosolNames(i)), __RC__) - aeroSum = aeroSum + ptr3d - end if - end do - - end subroutine get_mixR - - -end module Chem_AeroGeneric + !BOP + !IROUTINE: get_mixR + subroutine get_mixR (state, rc) + + !ARGUMENTS: + type (ESMF_State) :: state + integer, intent(out) :: rc + + !LOCALS: + type(ESMF_Info) :: info + real, dimension(:,:,:), pointer :: ptr3d + real, dimension(:,:,:,:), pointer :: ptr4d + real, dimension(:,:,:), pointer :: aeroSum + character(len=:), allocatable :: fld_name + integer :: i + character(len=ESMF_MAXSTR), allocatable :: aerosolNames(:) + integer :: status + !EOP + + call ESMF_InfoGetFromHost(state, info, _RC) + call ESMF_InfoGet(info, key="internal_variable_name", values=aerosolNames, _RC) + + ! Zero out previous aerosol sum value so it doesn't keep growing. + call ESMF_AttributeGet (state, name="sum_of_internalState_aerosol", value=fld_name, _RC) + if (fld_name /= '') then + call MAPL_StateGetPointer(state, itemName=fld_name, farrayPtr=aeroSum, _RC) + aeroSum = 0.0 + end if + + do i = 1, size(aerosolNames) + if ((aerosolNames(i) == 'DU') .or. (aerosolNames(i) == 'SS')) then + call MAPL_StateGetPointer(state, itemName=aerosolNames(i), farrayPtr=ptr4d, _RC) + aeroSum = sum(ptr4d, dim=4) !DU and SS only have 1 internal state variable so no need to =+ + else + call MAPL_StateGetPointer(state, itemName=aerosolNames(i), farrayPtr=ptr3d, _RC) + aeroSum = aeroSum + ptr3d + end if + end do + + end subroutine get_mixR + +end module Chem_AeroGeneric