!$Id: chemini.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. !! ========================================================================= #include SUBROUTINE CHEMINI( & xgravit ,& xrearth ,& xlatwts ,& latgcm ,& longcm ,& presnivs ,& calday ,& klon ,& nqmax ,& nqo ,& pdtphys ,& annee_ref ,& year_cur, & day_ref ,& day_ini, & start_time, & itau_phy ,& date0, & io_lon ,& io_lat ,& chemistry_couple, & init_source, init_tauinca, init_pizinca, init_cginca,init_ccm) !----------------------------------------------------------------------- ! ... Chemistry module intialization ! Didier Hauglustaine and Stacy Walters, 1999. !----------------------------------------------------------------------- USE CONST_MOD USE CONST_LMDZ USE CHEM_CONS USE CHEM_TRACNM USE INCA_DIM USE PARAM_CHEM, ONLY : flag_o3, flag_plane USE MOD_CONST_MPI_INCA USE AEROSOL_DIAG, ONLY : naero_grp, nbands #ifdef GES USE CARBONATOR #endif USE SURF_CHEM_MOD USE PRINT_INCA #ifdef STRAT USE HETCHEM #endif USE IOIPSL #ifdef XIOS USE xios USE xios_inca #endif USE INCA_DATA_PARA IMPLICIT NONE !----------------------------------------------------------------------- ! ... Dummy arguments !----------------------------------------------------------------------- REAL, INTENT(in) :: xgravit REAL, INTENT(in) :: xrearth REAL, INTENT(in) :: calday REAL, INTENT(in) :: latgcm(PLON) REAL, INTENT(in) :: longcm(PLON) REAL, INTENT(in) :: presnivs(PLEV) REAL, INTENT(in) :: xlatwts(PLON) INTEGER, INTENT(in) :: klon INTEGER, INTENT(in) :: nqmax ! nombre total de traceurs = inca + lmdz INTEGER, INTENT(in) :: nqo ! nombre de traceurs lus dans traceur.def REAL, INTENT(in) :: pdtphys INTEGER, INTENT(in) :: annee_ref, year_cur INTEGER, INTENT(in) :: day_ref, day_ini REAL, INTENT(in) :: start_time INTEGER, INTENT(in) :: itau_phy REAL,INTENT(IN) :: io_lat(jjm_glo-1/(iim_glo*(jjm_glo-1))) ! latitudes (of global grid) REAL,INTENT(IN) :: io_lon(iim_glo) ! longitudes (of global grid) REAL,INTENT(IN):: date0 LOGICAL, INTENT(IN) :: chemistry_couple REAL, DIMENSION(PLON,PCNST),INTENT(OUT) :: init_source REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_tauinca REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_pizinca REAL, DIMENSION(PLON,PLEV,naero_grp,nbands),INTENT(OUT) :: init_cginca REAL, DIMENSION(PLON,PLEV,nbands),INTENT(OUT) :: init_ccm !----------------------------------------------------------------------- ! ... Local variables !----------------------------------------------------------------------- INTEGER :: grid_id, vert_id ! axes ID INTEGER :: unit !----------------------------------------------------------------------- ! ... Function declarations !----------------------------------------------------------------------- INTEGER :: NAVU REAL :: TSECND INTEGER :: x_an, x_mois, x_jour real :: x_heure, zjulian, zjulian_start INTEGER :: ini_an, ini_mois, ini_jour REAL :: ini_heure init_source = 0. init_tauinca = 0. init_pizinca = 0. init_cginca = 0. init_ccm = 0. ! ! Initialisation de xios ! CALL conf_chem(chemistry_couple) ! ----------------------------------------------------------------------- ! initialisation des autres parametres pour le couplage avec la vegetation ! ------------------------------------------------------------------------ call INIT_SURF_CHEM_MOD !----------------------------------------------------------------------- ! ... Readin chemistry simulation specific data !----------------------------------------------------------------------- CALL CHEM_INTI() ! Initialisation de XIOS #ifdef XIOS CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian) CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure) CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start) CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure) call xios_inca_init(COMM_INCA , pdtphys, x_an, x_mois,x_jour, x_heure, & ini_an, ini_mois, ini_jour, ini_heure, io_lon, io_lat, presnivs) #endif ! lecture du restart CALL xios_chem_read_restart(init_source, init_tauinca, init_pizinca, init_cginca,init_ccm) !----------------------------------------------------------------------- ! ... Parameters initialisation !----------------------------------------------------------------------- #ifdef STRAT CALL init_hetchem #endif !----------------------------------------------------------------------- ! ... Make sure LMDz and INCA resolutions are identical !----------------------------------------------------------------------- IF ( (klon /= PLON) .OR. ( (nqmax-nqo) /= PCNST) ) THEN WRITE(lunout,*) ' [klon, plon] ', klon, PLON WRITE(lunout,*) ' [nqmax-nqo, pcnst, nqo] ', nqmax-nqo, PCNST, nqo CALL print_err(3, 'chemini', 'LMDZ-INCA resolution mismatch -- Abort.', & 'check klon,plon', 'and nqmax-nqo, pcnst') END IF CALL suphel_I !----------------------------------------------------------------------- ! ... Initialize chemistry variables !----------------------------------------------------------------------- d2r = pi / 180. r2d = 1. / d2r rearth = xrearth phi(:) = latgcm(:) * d2r lambda(:) = longcm(:) * d2r latwts(:) = xlatwts(:) !----------------------------------------------------------------------- ! ... Diagnostics initialization !----------------------------------------------------------------------- !DH call DIAGS_INTI( solsym ) #ifndef DUSS # if CLSCNT4 != 0 !----------------------------------------------------------------------- ! ... Implicit solver initialization !----------------------------------------------------------------------- call IMP_SLV_INTI() # endif #endif unit = NAVU() #ifndef DUSS #if defined(AERONLY) || defined(GES) !----------------------------------------------------------------------- ! ... Initialize photorate module !----------------------------------------------------------------------- CALL PRATE_INTI( unit ) #else !----------------------------------------------------------------------- ! ... Initialize photorate module !----------------------------------------------------------------------- CALL PRATE_INTI( unit ) !----------------------------------------------------------------------- ! ... Read time-dependent airplane emissions !----------------------------------------------------------------------- IF (flag_plane .ne. 0) then CALL AIRPL_SRC ( 'aircraft_mth.nc', 'aircraft_hour.nc' ) IF (flag_plane .eq. 3) then CALL AIRPL_SRC_HS ( 'aircraft_hs.nc' ) ENDIF ENDIF #endif #endif # ifdef SFLUX !----------------------------------------------------------------------- ! ... Read time-dependent surface flux dataset !----------------------------------------------------------------------- #ifndef DUSS CALL XIOS_SFLX_INTI () #ifdef GES CALL CARBONATOR_INTI(itau_phy,date0,pdtphys) #endif ! CALL DVEL_INTI ( 'landuse.nc' ) #ifndef AERONLY ! CALL NPP_INTI ( 'npp.nc' ) #endif #endif # endif call xios_npp_landuse_inti() !----------------------------------------------------------------------- ! ... Read time-dependent data sets !----------------------------------------------------------------------- #ifndef DUSS #if defined(AERONLY) || defined(GES) ! CALL OXYDANT_INTI ('oxydants.nc') #else #ifndef AER CALL SULF_INTI ('so4.nc') #endif if (trim(flag_o3) .eq. 'o3clim') then CALL OZCLIM_INTI ('o3clim.nc') endif if (trim(flag_o3) .eq. 'o3lin') then CALL OZLIN_INTI ('o3lin.nc') endif #ifdef STRAT CALL SAD_INTI ('sad.nc') CALL LGLIVED('lglived.dat',year_cur) #endif #endif #endif ! CALL xios_chem_read_restart() #ifdef XIOS call xios_inca_change_context("LMDZ") #endif ! CALL xios_chem_read_restart() END SUBROUTINE CHEMINI SUBROUTINE check_err(iret, name, string) USE PRINT_INCA IMPLICIT NONE !---------------------------------------------------------------------- ! ... netCDF error check !---------------------------------------------------------------------- INTEGER :: iret CHARACTER(LEN=*) :: name, string INCLUDE 'netcdf.inc' IF (iret /= NF_NOERR) THEN WRITE(lunout, *) 'netCDF error ', nf_strerror(iret), ' : ', & ' in Routine : ', name,' ', string(:LEN_TRIM(string)) WRITE(*,'("Fatal error from INCA. Read INCA output text")') flush(lunout) #ifdef CPP_PARA call MPI_ABORT(3) #endif STOP ENDIF END SUBROUTINE check_err !---------------------------------------------------------------------- ! ... Print error message !---------------------------------------------------------------------- SUBROUTINE print_err(lev,name,str1,str2,str3) !--------------------------------------------------------------------- !! The "print_err" routine !! allows to handle the messages to the user. !! !! parallel version of IOIPSL ipslerr !! !! INPUT !! !! lev : Category of message to be reported to the user !! 1 = Note to the user !! 2 = Warning to the user !! 3 = Fatal error !! name : Name of subroutine which has called ipslerr !! str1 !! str2 : Strings containing the explanations to the user !! str3 !--------------------------------------------------------------------- USE PRINT_INCA IMPLICIT NONE INTEGER :: lev CHARACTER(LEN=*) :: name,str1,str2,str3 !- CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & & (/ "NOTE TO THE USER FROM ROUTINE ", & & "WARNING FROM ROUTINE ", & & "FATAL ERROR FROM ROUTINE " /) !--------------------------------------------------------------------- IF ( (lev >= 1).AND.(lev <= 3) ) THEN WRITE(lunout,'(/,A," ",A)') TRIM(pemsg(lev)),TRIM(name) WRITE(lunout,'(3(" --> ",A,/))') TRIM(str1),TRIM(str2),TRIM(str3) ENDIF IF (lev == 3) THEN WRITE(*,'("Fatal error from INCA. Go to Read DEBUG INCA output text")') flush(lunout) #ifdef CPP_PARA CALL MPI_ABORT(lev) #endif STOP ENDIF !--------------------- END SUBROUTINE print_err