!$Id: chem_hook.F90 163 2010-02-22 15:41:45Z acosce $ !! ========================================================================= !! INCA - INteraction with Chemistry and Aerosols !! !! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE) !! Unite mixte CEA-CNRS-UVSQ !! !! Contributors to this INCA subroutine: !! !! Didier Hauglustaine, LSCE, hauglustaine@cea.fr !! Stacy Walters, NCAR, stacy@ucar.edu !! !! Anne Cozic, LSCE, anne.cozic@cea.fr !! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr !! !! This software is a computer program whose purpose is to simulate the !! atmospheric gas phase and aerosol composition. The model is designed to be !! used within a transport model or a general circulation model. This version !! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts !! for emissions, transport (resolved and sub-grid scale), photochemical !! transformations, and scavenging (dry deposition and washout) of chemical !! species and aerosols interactively in the GCM. Several versions of the INCA !! model are currently used depending on the envisaged applications with the !! chemistry-climate model. !! !! This software is governed by the CeCILL license under French law and !! abiding by the rules of distribution of free software. You can use, !! modify and/ or redistribute the software under the terms of the CeCILL !! license as circulated by CEA, CNRS and INRIA at the following URL !! "http://www.cecill.info". !! !! As a counterpart to the access to the source code and rights to copy, !! modify and redistribute granted by the license, users are provided only !! with a limited warranty and the software's author, the holder of the !! economic rights, and the successive licensors have only limited !! liability. !! !! In this respect, the user's attention is drawn to the risks associated !! with loading, using, modifying and/or developing or reproducing the !! software by the user in light of its specific status of free software, !! that may mean that it is complicated to manipulate, and that also !! therefore means that it is reserved for developers and experienced !! professionals having in-depth computer knowledge. Users are therefore !! encouraged to load and test the software's suitability as regards their !! requirements in conditions enabling the security of their systems and/or !! data to be ensured and, more generally, to use and operate it in the !! same conditions as regards security. !! !! The fact that you are presently reading this means that you have had !! knowledge of the CeCILL license and that you accept its terms. !! ========================================================================= SUBROUTINE CHEMHOOK_BEGIN( & calday, & ijour, & gmtime, & oro, & lat, & lon, & area, & pfull, & pmid, & coefh, & zma, & temp, & u, & v, & rot, & ozrad, & sh, & ts, & t_air_2m, & dpth_snow, & sws, & albs, & rain_fall, & snow_fall, & ctop, & cbot, & cldfr, & nx, & ny, & mmr, & ftsol, & paprs, & cdragh, & cdragm, & pctsrf, & delt, & nstep ) !---------------------------------------------------------------------- ! ... General purpose chemistry "hook" routine ! Didier Hauglustaine and Stacy Walters, 2000. !---------------------------------------------------------------------- USE MOD_INCA_PARA USE MOD_GRID_INCA, ONLY : PLON_GLO USE CHEM_CONS USE CONST_LMDZ USE INCA_DIM USE CARBONATOR USE SPECIES_NAMES USE PARAM_CHEM USE DRYDEP_ARRAYS, ONLY : fraction_landuse USE AIRPLANE_SRC, ONLY : itrop, ttrop, ztrop USE XIOS_INCA IMPLICIT NONE !---------------------------------------------------------------------- ! ... Dummy args !---------------------------------------------------------------------- REAL, INTENT(IN) :: calday INTEGER, INTENT(in) :: ijour ! jour julien REAL, INTENT(in) :: gmtime ! input-R-temps universel dans la journee (0 a 86400 s) INTEGER, INTENT(IN) :: ctop(PLON) INTEGER, INTENT(IN) :: cbot(PLON) INTEGER, INTENT(IN) :: nx, ny REAL, INTENT(IN) :: pmid(PLON,PLEV) REAL, INTENT(IN) :: pfull(PLON,PLEV+1) REAL, INTENT(IN) :: coefh(PLON,PLEV) REAL, INTENT(IN) :: zma(PLON,PLEV) REAL, INTENT(IN) :: temp(PLON,PLEV) REAL, INTENT(IN) :: u(PLON,PLEV) REAL, INTENT(IN) :: v(PLON,PLEV) REAL, INTENT(IN) :: rot(PLON,PLEV) REAL, INTENT(IN) :: ozrad(PLON,PLEV) REAL, INTENT(IN) :: sh(PLON,PLEV) REAL, INTENT(IN) :: lat(PLON) REAL, INTENT(IN) :: lon(PLON) REAL, INTENT(IN) :: oro(PLON) REAL, INTENT(IN) :: area(PLON) REAL, INTENT(IN) :: ts(PLON) REAL, INTENT(IN) :: t_air_2m(PLON) ! air temperature near surface REAL, INTENT(IN) :: dpth_snow(PLON) REAL, INTENT(IN) :: sws(PLON) REAL, INTENT(IN) :: albs(PLON) REAL, INTENT(IN) :: rain_fall(PLON) REAL, INTENT(IN) :: snow_fall(PLON) REAL, INTENT(IN) :: mmr(PLON,PLEV,8) REAL, INTENT(IN) :: cldfr (PLON,PLEV) ! variables used in nightingale REAL, INTENT(in) :: ftsol(PLON,nbsrf) REAL, INTENT(in) :: paprs(PLON,PLEV+1) REAL, INTENT(in) :: cdragh(PLON), cdragm(PLON) REAL, INTENT(in) :: pctsrf(PLON,nbsrf) REAL, INTENT(in) :: delt ! timestep in seconds of physics INTEGER, INTENT(IN) :: nstep ! model time step !---------------------------------------------------------------------- ! ... Local arguments needed to calculate diurnal ! variation of isoprene and monoterpenes !---------------------------------------------------------------------- INTEGER :: iplon, i REAL :: sunon(PLON) ! sunrise angle in radians REAL :: sunoff(PLON) ! sunset angle in radians REAL :: zen_angle(PLON) ! solar zenith angle REAL :: loc_angle(PLON) ! "local" time angle LOGICAL :: polar_day(PLON) ! continuous daylight flag LOGICAL :: polar_night(PLON) ! continuous night flag LOGICAL :: zangtz(PLON) REAL :: tfld_glo(PLON_GLO,PLEV) REAL :: pmid_glo(PLON_GLO,PLEV) !---------------------------------------------------------------------- ! ... Local variables !---------------------------------------------------------------------- REAL :: zmid(PLON,PLEV) !----------------------------------------------------------------------- ! ... Function interface !----------------------------------------------------------------------- ! CALL xios_chem_read_restart() zmid(:,:) = zma(:PLON,:) / gravit !meters !----------------------------------------------------------------------- ! ... Tropopause Location !----------------------------------------------------------------------- CALL gather(pmid,pmid_glo) CALL bcast(pmid_glo) CALL gather(temp,tfld_glo) CALL bcast(tfld_glo) ! dans le cas dynamico il faut revoir le calcul de la tropopause ! CALL FDTROPOPAUSE ( & ! nx, & ! ny+1, & ! chemhook_begin recupere nbp_lat-1 de lmdz chemmain avait nbp_lat ! PLEV, & ! pmid_glo, & ! tfld_glo) DO i = 1, PLON itrop(i)=nint(3./4.*PLEVP) END DO DO iplon = 1, PLON ttrop(iplon) = temp(iplon,itrop(iplon)) ztrop(iplon) = zmid(iplon,itrop(iplon)) ENDDO ! appel de l'interface entre inca et orchidee IF (CoupSurfAtm) THEN CALL surf_chem_atm(pctsrf, fraction_landuse) ENDIF CALL XIOS_OXYDANT_READ (calday) ! ... Dry deposition velocities CALL MKDVEL (& oro, lat, zmid, coefh, & calday, temp, u, v, sh, & pfull, pmid, ts, & dpth_snow, sws, albs, & rain_fall, snow_fall) CALL CARBONATOR_SFLX(ijour,gmtime) ! ... Surface emissions CALL MKSFLX_P2P( & calday, oro, lat, lon, area, loc_angle, & polar_night, polar_day, sunon, sunoff, & u, v, paprs, pmid, cdragh, cdragm, temp, & sh, ftsol, ts, pctsrf) CALL CALC_PV(lat,paprs,pmid,t_air_2m,temp,rot) CALL xios_inca_change_context("inca") CALL xios_inca_send_field("pfull", pfull) CALL xios_inca_send_field("ttrop", ttrop) CALL xios_inca_send_field("ztrop", ztrop) CALL xios_inca_change_context("LMDZ") END SUBROUTINE CHEMHOOK_BEGIN SUBROUTINE CHEMHOOK_END( & dt, & pmid, & temp, & mmr, & nbtr, & paprs, & sh, & area, & zma, & phis, & rh, aps, bps, ap, bp, lafin ) !---------------------------------------------------------------------- ! ... General purpose chemistry "hook" routine ! Didier Hauglustaine, IPSL, 2000. !---------------------------------------------------------------------- USE SPECIES_NAMES USE IOIPSL USE MOD_INCA_PARA USE CHEM_CONS USE TIMING USE INCA_DIM USE CHEM_MODS USE SFLX, ONLY : eflux, dvel, dflux, aflux USE PHT_TABLES, ONLY : jrates USE XIOS_INCA USE CHEM_TRACNM USE PRINT_INCA USE RATE_INDEX_MOD USE SRF_FLUX_INT IMPLICIT NONE !---------------------------------------------------------------------- ! ... Dummy args !---------------------------------------------------------------------- INTEGER, INTENT(IN) :: nbtr REAL, INTENT(IN) :: dt REAL, INTENT(IN) :: pmid(PLON,PLEV) REAL, INTENT(IN) :: area(PLON) REAL, INTENT(IN) :: temp(PLON,PLEV) REAL, INTENT(IN) :: paprs(PLON,PLEVP) REAL, INTENT(IN) :: sh(PLON,PLEV) REAL, INTENT(INOUT) :: mmr(PLON,PLEV,8) REAL, INTENT(IN) :: zma(PLON,PLEV) REAL, INTENT(IN) :: phis(PLON) REAL, INTENT(IN) :: rh(PLON,PLEV) REAL, INTENT(IN), DIMENSION(PLEV) :: aps, bps REAL, INTENT(IN), DIMENSION(PLEV+1) :: ap, bp LOGICAL, INTENT(IN) :: lafin !---------------------------------------------------------------------- ! ... Local variables !---------------------------------------------------------------------- REAL :: pdel(PLON,PLEV) REAL, PARAMETER :: dry_mass = 28.966 !test userd INTEGER, PARAMETER :: inst=1, avgr=2 INTEGER :: k,i,j INTEGER, PARAMETER :: ilev=1 REAL :: dtinv real, dimension(PLON) :: field1d real, dimension(PLON) :: mmrpm2p5surf,mmrpm2p5asurf,mmrpm10surf,mmrpm1surf,mmrpm1asurf,vmro3surf,pmidsurf,tempsurf real, dimension(PLON) :: SOAasurf,SOAbsurf,POMMsurf,AIBCMsurf,ASBCMsurf real, dimension(PLON,PLEV) :: field2d REAL, DIMENSION(PLEV+1,2) :: Ahyb_bounds, Bhyb_bounds REAL, DIMENSION(PLEV,2) :: Ahyb_mid_bounds, Bhyb_mid_bounds character(3) :: text !----------------------------------------------------------------------- ! ... Function interface !----------------------------------------------------------------------- dtinv = 1./dt write(lunout,*) 'lafin = ', lafin call xios_inca_change_context("inca") DO k = 1, PLEV pdel(:,k) = paprs(:,k) - paprs (:,k+1) END DO !---------------------------------------------------------------------- ! ... Writing the species concentration, surface flux and deposition ! velocity and the group members concentration !----------------------------------------------------------------------- CALL xios_inca_send_field("emich4ref", flx_ch4_ant(:,1)) CALL xios_inca_send_field("emich4interp", flx_ch4_ant_interp(:,1) ) CALL outfld_xios(pmid,temp,sh,paprs(1,1),pdel,area) DO i=1,8 IF( adv_mass(i) /= 0. ) THEN field2d(:,:) = mmr(:,:,i) * dry_mass / adv_mass(i) ENDIF call xios_inca_send_field(tracnam(i), field2d) call xios_inca_send_field("Emi_"//tracnam(i), eflux(:,i)) call xios_inca_send_field("Dep_"//tracnam(i), dvel(:,i)) call xios_inca_send_field("Dflux_"//tracnam(i), dflux(:,i)) ENDDO Ahyb_bounds(1,1) = 0. Ahyb_bounds(1,2) = aps(1) Bhyb_bounds(1,1) = 1. Bhyb_bounds(1,2) = bps(1) DO i=2,PLEV Ahyb_bounds(i,1) = aps(i-1) Ahyb_bounds(i,2) = aps(i) Bhyb_bounds(i,1) = bps(i-1) Bhyb_bounds(i,2) = bps(i) ENDDO Ahyb_bounds(PLEV+1,1) = aps(PLEV) Ahyb_bounds(PLEV+1,2) = 0. Bhyb_bounds(PLEV+1,1) = bps(PLEV) Bhyb_bounds(PLEV+1,2) = 0. DO i=1, PLEV Ahyb_mid_bounds(i,1) = ap(i) Ahyb_mid_bounds(i,2) = ap(i+1) Bhyb_mid_bounds(i,1) = bp(i) Bhyb_mid_bounds(i,2) = bp(i+1) END DO CALL xios_inca_send_field("Ahyb", ap) CALL xios_inca_send_field("Bhyb", bp) CALL xios_inca_send_field("Ahyb_bounds", Ahyb_bounds) CALL xios_inca_send_field("Bhyb_bounds", Bhyb_bounds) CALL xios_inca_send_field("Ahyb_mid", aps ) CALL xios_inca_send_field("Bhyb_mid", bps) CALL xios_inca_send_field("Ahyb_mid_bounds", Ahyb_mid_bounds) CALL xios_inca_send_field("Bhyb_mid_bounds", Bhyb_mid_bounds) DO i=1,1 CALL xios_inca_send_field("hrate_"//hetname(i), hrates(:,:,i)) CALL xios_inca_send_field("wetloss_"//hetname(i), wetloss(:,:,i)) ENDDO do i=1, 2 call xios_inca_send_field("phtrate_"//trim(reacname(i)), jrates(:,:,i)) enddo DO i=1, 1 CALL xios_inca_send_field("extfrc_"//trim(extname(i)), extfrc(:,:,i)) CALL xios_inca_send_field("extfrc_"//trim(extname(i))//"_col", extfrc_col(:,i)) ENDDO CALL xios_inca_send_field("prod_light_col", prod_light_col) CALL xios_inca_send_field("ASAP_p_col", ASAP_p_col) CALL xios_inca_send_field("ASAR_p_col", ASAR_p_col) ! define surface concentrations of PM2.5, PM10 and PM1 ---- YZ edits call xios_inca_change_context("LMDZ") if (lafin) CALL chem_write_restart END SUBROUTINE CHEMHOOK_END