#define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if ! #include "tm5.inc" !----------------------------------------------------------------------------- ! TM5 ! !----------------------------------------------------------------------------- !BOP ! ! !MODULE: CALC_PM ! ! !DESCRIPTION: PM module to calculate particulate matter concentrations for ! user defined aerodynamic diameters. This is used for diagnostics ! purposes by some user_output_* routines. !\\ !\\ ! !INTERFACE: ! MODULE CALC_PM ! ! !USES: ! USE GO, only : gol, goErr, goPr IMPLICIT NONE PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: ! Public :: PMX_Integrate_3d,PMx_integrate_0d ! ! !PRIVATE DATA MEMBERS: ! character(len=*), parameter :: mname = 'calc_pm' Real, Parameter :: hr2 = 0.5*sqrt(2.0) ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - Revised and made suitable for 3D and stations ! 19 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! ! !REMARKS: ! (1) module used only if with_m7 is used ! !EOP !------------------------------------------------------------------------ CONTAINS !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: PMX_Integrate_0d ! ! !DESCRIPTION: This routine generates a pmx value for a given grid cell ! Arbitrary radii may be specified. ! NO3 and NH4 come from EQSAM and are considered to be in ! the accumulation mode. !\\ !\\ ! !INTERFACE: ! Subroutine PMX_Integrate_0d(region, is, js, ls, isizelimit, pmx, status) ! ! !USES: ! Use tracer_data, only : mass_dat ! I need to convert (/kg air) to (/m3 air) use chem_param, only : iso4nus,isoanus use chem_param, only : iso4ais, ibcais, ipomais, isoaais use chem_param, only : iso4acs, ibcacs, ipomacs, isoaacs, issacs, iduacs use chem_param, only : iso4cos, ibccos, ipomcos, isoacos, isscos, iducos use chem_param, only : ibcaii, ipomaii, isoaaii, iduaci use chem_param, only : iducoi, ino3_a, inh4 Use mo_aero_m7, only : nmod, cmedr2mmedr, sigma Use m7_data, only : h2o_mode, rw_mode ! To rewrite ug / cell to ug/m3 Use global_data, only : region_dat Use Meteodata, only : gph_dat ! ! !INPUT PARAMETERS: ! Integer, Intent(In) :: region real, intent(in) :: isizelimit integer, Intent(in) :: is, js, ls ! ! !OUTPUT PARAMETERS: ! Integer, Intent(out) :: status real, Intent(out) :: pmx ! units = 'kg/m3' ! ! !REVISION HISTORY: ! 7 Oct 2010 - Achim Strunk - v0 ! 19 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/PMX_Integrate_0d' Integer :: imod Real :: z, rad, sizelimit Real :: volume ! For converting mass to mass/volume Real, Dimension(nmod) :: modfrac ! Length: Number of M7 modes (7) Real, Dimension(nmod) :: lnsigma ! --- begin ------------------------------------- lnsigma = log(sigma) ! We can convert micrometers diameter to meters radius. One micrometer diameter is 5.e-7 meter radius. sizelimit = isizelimit * 5.e-7 ! initialise target value pmx = 0.0 Do imod = 1, nmod ! Calculate the median radius of the volume weighted distribution. rad = rw_mode(region,imod)%d3(is,js,ls) * cmedr2mmedr(imod) !! if( rad == 0.0 ) then ! changed to a precision depending value if( rad < 100*TINY(1.0) ) then modfrac(imod) = 1.0 ! Should not matter, because if the radius is zero, ! there are no aerosols. But in principle, it would ! mean that all aerosols are infinitely small, so ! they would fit in any PM-class. else z = ( log(sizelimit) - log(rad) ) / lnsigma(imod) modfrac(imod) = 0.5 + 0.5 * ERF(z*hr2) end if end do ! And the volume. This is the nicest and cleanest line of code of this whole module. volume = ( gph_dat(region)%data(is,js,ls+1) - gph_dat(region)%data(is,js,ls) ) * & region_dat(region)%dxyp(js) pmx = pmx + mass_dat(region)%rm(is,js,ls, iso4nus) * modfrac(1) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iso4ais) * modfrac(2) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iso4acs) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iso4cos) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ibcais ) * modfrac(2) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ibcacs ) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ibccos ) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ibcaii ) * modfrac(5) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ipomais) * modfrac(2) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ipomacs) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ipomcos) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ipomaii) * modfrac(5) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isoanus) * modfrac(1) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isoaais) * modfrac(2) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isoaacs) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isoacos) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isoaaii) * modfrac(5) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, issacs ) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, isscos ) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iduacs ) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iducos ) * modfrac(4) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iduaci ) * modfrac(6) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, iducoi ) * modfrac(7) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, ino3_a ) * modfrac(3) / volume pmx = pmx + mass_dat(region)%rm(is,js,ls, inh4 ) * modfrac(3) / volume ! Count the water !pmx = pmx + h2o_mode(region,1)%d3(is,js,ls)*modfrac(1) / volume !pmx = pmx + h2o_mode(region,2)%d3(is,js,ls)*modfrac(2) / volume !pmx = pmx + h2o_mode(region,3)%d3(is,js,ls)*modfrac(3) / volume !pmx = pmx + h2o_mode(region,4)%d3(is,js,ls)*modfrac(4) / volume status = 0 End Subroutine PMX_INTEGRATE_0D !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: PMX_Integrate_3d ! ! !DESCRIPTION: This routine uses PMX_Integrate_0d for generating a 3d ! array (over im, jm, lm) of pmx. ! Arbitrary radii may be specified. !\\ !\\ ! !INTERFACE: ! SUBROUTINE PMX_Integrate_3d( region, isizelimit, pmx, status ) ! ! !USES: ! USE DIMS, ONLY : im, jm, lm USE TM5_DISTGRID, ONLY : dgrid, Get_DistGrid, gather, scatter_i_band ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(in) :: region REAL, INTENT(in) :: isizelimit ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(out) :: status REAL, DIMENSION(:,:,:), INTENT(out) :: pmx ! ! !REVISION HISTORY: ! 7 Oct 2010 - Achim Strunk - v0 ! 19 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC CHARACTER(len=*), PARAMETER :: rname = mname//'/PMX_Integrate_3d' INTEGER :: is, js, ls, i1, i2, j1, j2 REAL :: pmxl ! reset value pmx = 0.0 CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 ) DO ls = 1, lm(region) DO js = j1, j2 DO is = i1, i2 pmxl=0.0 CALL pmx_integrate_0d( region, is, js, ls, isizelimit, pmxl, status ) IF_NOTOK_RETURN( status=1 ) !write(4444,*)pmxl,is,js,ls,ubound(pmx),lbound(pmx) pmx(is,js,ls) = pmxl !write(4444,*)pmx(is,js,ls),is,js,ls,ubound(pmx),lbound(pmx) END DO END DO ! write(5555,*)size(pmx),shape(pmx),i2,j2,lm(region),is,js,ls,isizelimit,pmxl END DO status = 0 END SUBROUTINE PMX_Integrate_3d !NOT-USED SUBROUTINE PMX_Integrate_2d( region, isizelimit, pmx, status ) !NOT-USED ! !NOT-USED ! !USES: !NOT-USED ! !NOT-USED USE DIMS, ONLY : im, jm, lm !NOT-USED USE TM5_DISTGRID, ONLY : dgrid, Get_DistGrid, gather, scatter_i_band !NOT-USED ! !NOT-USED ! !INPUT PARAMETERS: !NOT-USED ! !NOT-USED INTEGER, INTENT(in) :: region !NOT-USED REAL, INTENT(in) :: isizelimit !NOT-USED ! !NOT-USED ! !OUTPUT PARAMETERS: !NOT-USED ! !NOT-USED INTEGER, INTENT(out) :: status !NOT-USED REAL, DIMENSION(:,:), INTENT(out) :: pmx !NOT-USED ! !NOT-USED ! !REVISION HISTORY: !NOT-USED ! 7 Oct 2010 - Achim Strunk - v0 !NOT-USED ! 19 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition !NOT-USED ! !NOT-USED ! !REMARKS: !NOT-USED ! !NOT-USED !EOP !NOT-USED !------------------------------------------------------------------------ !NOT-USED !BOC !NOT-USED !NOT-USED CHARACTER(len=*), PARAMETER :: rname = mname//'/PMX_Integrate_3d' !NOT-USED INTEGER :: is, js, ls, i1, i2, j1, j2 !NOT-USED REAL :: pmxl !NOT-USED !NOT-USED ! reset value !NOT-USED pmx = 0.0 !NOT-USED !NOT-USED CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 ) !NOT-USED !NOT-USED !NOT-USED DO js = j1, j2 !NOT-USED DO is = i1, i2 !NOT-USED !NOT-USED CALL pmx_integrate_0d( region, is, js, ls, isizelimit, pmxl, status ) !NOT-USED IF_NOTOK_RETURN( status=1 ) !NOT-USED !NOT-USED pmx(is,js) = pmxl !NOT-USED END DO !NOT-USED END DO !NOT-USED !NOT-USED !NOT-USED status = 0 !NOT-USED !NOT-USED END SUBROUTINE PMX_Integrate_2d !NOT-USED !EOC END MODULE CALC_PM