vremap_conserve_vol_mixing Subroutine

public subroutine vremap_conserve_vol_mixing(src_pressure, src_q, mol_weight, src_values, dst_pressure, dst_q, dst_values, rc)

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: src_pressure(:,:,:)
real, intent(in) :: src_q(:,:,:)
real, intent(in) :: mol_weight
real, intent(in) :: src_values(:,:,:)
real, intent(in) :: dst_pressure(:,:,:)
real, intent(in) :: dst_q(:,:,:)
real, intent(inout) :: dst_values(:,:,:)
integer, intent(out), optional :: rc

Calls

proc~~vremap_conserve_vol_mixing~~CallsGraph proc~vremap_conserve_vol_mixing vremap_conserve_vol_mixing gmap gmap proc~vremap_conserve_vol_mixing->gmap proc~mapl_return MAPL_Return proc~vremap_conserve_vol_mixing->proc~mapl_return at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception

Source Code

   subroutine vremap_conserve_vol_mixing(src_pressure, src_q, mol_weight, src_values, dst_pressure, dst_q, dst_values, rc)
      real, intent(in) :: src_pressure(:,:,:)
      real, intent(in) :: src_q(:,:,:)
      real, intent(in) :: src_values(:,:,:)
      real, intent(in) :: mol_weight
      real, intent(in) :: dst_pressure(:,:,:)
      real, intent(in) :: dst_q(:,:,:)
      real, intent(inout) :: dst_values(:,:,:)
      integer, intent(out), optional :: rc

      integer :: status
      real, allocatable :: temp_pressures_src(:,:,:), temp_values_src(:,:,:)
      real, allocatable :: temp_pressures_dst(:,:,:), temp_values_dst(:,:,:)
      real :: src_max_p
      integer :: lb_src, lb_dst, lm_src, lm_dst, ub_src, ub_dst, im, jm

      lm_src = size(src_values,3)
      lm_dst = size(dst_values,3)
      lb_src = lbound(src_pressure,3)
      lb_dst = lbound(dst_pressure,3)
      ub_src = ubound(src_pressure,3)
      ub_dst = ubound(dst_pressure,3)
      im = size(src_values,1)
      jm = size(src_values,2)

      ! src gets extra level that is zero becasue gmap persists src value in dst below surface
      src_max_p = maxval(src_pressure(:,:,ub_src))
      allocate(temp_pressures_src(im,jm,lb_src:ub_src+1))  
      allocate(temp_values_src(im,jm,lm_src+1))
      temp_pressures_src(:,:,lb_src:ub_src) = src_pressure
      temp_values_src(:,:,1:lm_src) = src_values
      temp_pressures_src(:,:,ub_src+1) = src_pressure(:,:,ub_src)+10.0
      temp_values_src(:,:,lm_src+1) = 0.0
      temp_values_src(:,:,1:lm_src) = temp_values_src(:,:,1:lm_src)*(((1.0-src_q)*(mol_weight/MAPL_AIRMW))+(src_q*mol_weight/MAPL_H2OMW))

      ! add an extra level on dst because if src is below destination we will need the extra stuff
      ! we need to make sure "extra" stuf from src gets included
      allocate(temp_pressures_dst(im,jm,lb_dst:ub_dst+1))  
      allocate(temp_values_dst(im,jm,lm_dst+1))
      temp_pressures_dst(:,:,lb_dst:ub_dst) = dst_pressure
      temp_pressures_dst(:,:,ub_dst+1) = src_max_p + 10.0

      call gmap(im, jm, lm_src+1, temp_pressures_src, temp_values_src, lm_dst+1, temp_pressures_dst, temp_values_dst)

      ! add back the "extra" level, have to convert to emission to do it
      temp_values_dst(:,:,lm_dst) = temp_values_dst(:,:,lm_dst)*(temp_pressures_dst(:,:,lm_dst+1)-temp_pressures_dst(:,:,lm_dst))/MAPL_GRAV &
         + temp_values_dst(:,:,lm_dst+1)*(temp_pressures_dst(:,:,lm_dst+2)-temp_pressures_dst(:,:,lm_dst+1))/MAPL_GRAV
      ! add convert back to mass mixing
      temp_values_dst(:,:,lm_dst) = temp_values_dst(:,:,lm_dst)*MAPL_GRAV/(temp_pressures_dst(:,:,lm_dst+1)-temp_pressures_dst(:,:,lm_dst))
      ! convert to volume mixing

      dst_values = temp_values_dst(:,:,1:lm_dst)
      dst_values = dst_values/(((1.0-dst_q)*(mol_weight/MAPL_AIRMW))+(dst_q*mol_weight/MAPL_H2OMW))

      _RETURN(_SUCCESS)
   end subroutine vremap_conserve_vol_mixing