!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- ***s/r itf_chm_fillbus - Fill the slice workspace variable * for the chemistry. * #include "model_macros_f.h"*
subroutine itf_chm_fillbus ( F_chmbusdyn, F_chmbusper, 1 $ F_chmbusent, F_chmbusvol, $ P_chmtrp, P_chmtrm, $ F_jdo, F_step,LDIST_DIM,nk) * implicit none * integer F_step,F_jdo, LDIST_DIM, nk * real F_chmbusdyn(*), F_chmbusper(*) real F_chmbusent(*), F_chmbusvol(*) integer*8 P_chmtrp(*) integer*8 P_chmtrm(*) * *author * A. Kallaur - arqi - june 2005 * *revision * v3_30 - Kallaur A. - initial version * *object * Fill the slice workspace variable for the chemistry. * Change of units if required * *arguments * Name I/O Description *---------------------------------------------------------------- * F_chmbusdyn O - dynamic bus * F_chmbusper O - permanent bus * F_chmbusent O - entry bus * F_chmbusvol O - volatile bus * P_chmtrp I - Pointer to time t+dt chemical state fields * P_chmtrm I - Pointer to time t chemical state fields * F_jdo I - slab number index * F_step I - * nk I - NUmber of vertical levels * *implicits #include "itf_chm_bus.cdk"
#include "itf_chm_busind.cdk"
* * Local variables * integer i,ii,j,k,n,indx real tr pointer (patr, tr(LDIST_SHAPE,*)) ** * --------------------------------------------------------------- * do n=1,chmt_ntr patr = P_chmtrm(n) patr = P_chmtrp(n) do k=1,Nk do i=1,chm_ni indx = (k-1)*chm_ni+i-1 ii = i + chm_offi F_chmbusdyn(chmt_ind(2,n)+indx) = tr(ii,F_jdo,k) enddo ! i=1,chm_ni enddo ! k=1,Nk enddo ! n=1,chmt_ntr * * --------------------------------------------------------------- * return end