diff --git a/AOD_PM_mod.f90 b/AOD_PM_mod.f90 index 1ce5bd9..c320220 100644 --- a/AOD_PM_mod.f90 +++ b/AOD_PM_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/AOTnPOD_mod.f90 b/AOTnPOD_mod.f90 index 367fa6a..0034f89 100644 --- a/AOTnPOD_mod.f90 +++ b/AOTnPOD_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Advection_mod.f90 b/Advection_mod.f90 index b2b0805..14379d3 100755 --- a/Advection_mod.f90 +++ b/Advection_mod.f90 @@ -73,10 +73,10 @@ Module Advection_mod use Config_module, only : KMAX_BND,KMAX_MID,NMET, step_main, nmax, & dt_advec, dt_advec_inv, PT,Pref, KCHEMTOP, & NPROCX,NPROCY,NPROC, & - USES,uEMEP,ZERO_ORDER_ADVEC + USES,ZERO_ORDER_ADVEC use Debug_module, only: DEBUG_ADV use Convection_mod, only: convection_Eta - use EmisDef_mod, only: NSECTORS, Nneighbors, loc_frac, loc_frac_1d + use EmisDef_mod, only: NSECTORS, Nneighbors, lf, loc_frac_src, loc_frac_src_1d use GridValues_mod, only: GRIDWIDTH_M,xm2,xmd,xm2ji,xmdji,xm_i, Pole_Singular, & dhs1, dhs1i, dhs2i, & dA,dB,i_fdom,j_fdom,i_local,j_local,Eta_bnd,dEta_i,& @@ -97,7 +97,7 @@ Module Advection_mod ,neighbor,WEST,EAST,SOUTH,NORTH,NOPROC & ,MSG_NORTH2,MSG_EAST2,MSG_SOUTH2,MSG_WEST2 use PhysicalConstants_mod, only: GRAV,ATWAIR ! gravity - use uEMEP_mod, only: uEMEP_Size1, uemep_adv_x, uemep_adv_y, uemep_adv_k, uemep_diff + use LocalFractions_mod, only: lf_adv_x, lf_adv_y, lf_adv_k, lf_diff, LF_SRC_TOTSIZE, lf_Nvert implicit none private @@ -120,8 +120,6 @@ Module Advection_mod public :: alloc_adv_arrays public :: vgrid public :: vgrid_Eta - public :: advecdiff - public :: advecdiff_poles public :: advecdiff_Eta public :: vertdiff_1d ! public :: adv_var @@ -134,7 +132,7 @@ Module Advection_mod private :: preadvx3 private :: preadvy3 -!NB: vertdiffn is outside the module, because of circular dependencies with uEMEP_mod +!NB: vertdiffn is outside the module, because of circular dependencies with LocalFractions_mod ! Checks & warnings ! introduced after getting Nan when using "poor" meteo can give this too. @@ -217,20 +215,6 @@ subroutine assign_nmax(metstep) end subroutine assign_nmax !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - subroutine advecdiff - - call StopAll('advecdiff and sigma coordinates no more available') - - end subroutine advecdiff - - subroutine advecdiff_poles - - call StopAll('advecdiff_poles and sigma coordinates no more available') - - end subroutine advecdiff_poles - -! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - subroutine advecdiff_Eta !___________________________________________________________________________________ !Uses more robust options: @@ -285,7 +269,7 @@ subroutine advecdiff_Eta integer ::isum,isumtot,iproc,isec_poll1,ipoll,isec_poll real :: xn_advjktot(NSPEC_ADV),xn_advjk(NSPEC_ADV),rfac real :: dpdeta0,mindpdeta,xxdg,fac1 - real :: xn_k(uEMEP%Nsec_poll*(1+(uEMEP%dist*2+1)*(uEMEP%dist*2+1)),kmax_mid),x + real :: x real :: fluxx(NSPEC_ADV,-1:LIMAX+1) real :: fluxy(NSPEC_ADV,-1:LJMAX+1) real :: fluxk(NSPEC_ADV,KMAX_MID) @@ -298,7 +282,7 @@ subroutine advecdiff_Eta !This case can arises where there is a singularity close to the !poles in long-lat coordinates. integer,parameter :: NITERXMAX=40 - real :: tim_uemep_before,tim_uemep_after + real :: tim_lf_before,tim_lf_after xxdg=GRIDWIDTH_M*GRIDWIDTH_M/GRAV !constant used in loops @@ -314,7 +298,7 @@ subroutine advecdiff_Eta end if !Overwrite the cooefficients for vertical advection, with Eta-adpated values call vgrid_Eta - if(.not.allocated(loc_frac_1d))allocate(loc_frac_1d(0,1,1,1))!to avoid error messages + if(.not.allocated(loc_frac_src_1d))allocate(loc_frac_src_1d(0,1))!to avoid error messages if(ZERO_ORDER_ADVEC)then hor_adv0th = .true. vert_adv0th = .true. @@ -485,10 +469,10 @@ subroutine advecdiff_Eta do iterx=1,niterx(j,k) ! send/receive in x-direction - call preadvx3(110+k+KMAX_MID*j & + call preadvx3(110+k+KMAX_MID*j & ,xn_adv(1,1,j,k),dpdeta(1,j,k),u_xmj(0,j,k,1)& ,xnw,xne & - ,psw,pse,j,k,loc_frac_1d) + ,psw,pse,j,k,loc_frac_src_1d) ! x-direction call advx( & @@ -499,7 +483,7 @@ subroutine advecdiff_Eta ,dth,fac1,fluxx) do i = li0,li1 - if(USES%uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_x(fluxx,i,j,k) + if(USES%LocalFractions .and. k>KMAX_MID-lf_Nvert)call lf_adv_x(fluxx,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) @@ -524,7 +508,7 @@ subroutine advecdiff_Eta call preadvy3(520+k & ,xn_adv(1,1,1,k),dpdeta(1,1,k),v_xmi(1,0,k,1) & ,xns, xnn & - ,pss, psn,i,k,loc_frac_1d) + ,pss, psn,i,k,loc_frac_src_1d) call advy( & v_xmi(i,0,k,1),vs(i,k,1),vn(i,k,1) & @@ -534,7 +518,8 @@ subroutine advecdiff_Eta ,dth,fac1,fluxy) do j = lj0,lj1 - if(USES%uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_y(fluxy,i,j,k) + + if(USES%LocalFractions .and. k>KMAX_MID-lf_Nvert)call lf_adv_y(fluxy,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) @@ -560,10 +545,11 @@ subroutine advecdiff_Eta ! call adv_vert_fourth(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s) call advvk(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) endif - if(USES%uEMEP)then - call uemep_adv_k(fluxk,i,j) - end if + if(USES%LocalFractions)then + call lf_adv_k(fluxk,i,j) + end if + if(itersKMAX_MID-uEMEP%Nvert)call uemep_adv_y(fluxy,i,j,k) + if(USES%LocalFractions .and. k>KMAX_MID-lf_Nvert)call lf_adv_y(fluxy,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) @@ -636,7 +622,7 @@ subroutine advecdiff_Eta call preadvx3(21000+k+KMAX_MID*iterx+1000*j & ,xn_adv(1,1,j,k),dpdeta(1,j,k),u_xmj(0,j,k,1)& ,xnw,xne & - ,psw,pse,j,k,loc_frac_1d) + ,psw,pse,j,k,loc_frac_src_1d) ! x-direction call advx( & @@ -647,7 +633,7 @@ subroutine advecdiff_Eta ,dth,fac1,fluxx) do i = li0,li1 - if(USES%uEMEP .and. k>KMAX_MID-uEMEP%Nvert)call uemep_adv_x(fluxx,i,j,k) + if(USES%LocalFractions .and. k>KMAX_MID-lf_Nvert)call lf_adv_x(fluxx,i,j,k) dpdeta0=(dA(k)+dB(k)*ps(i,j,1))*dEta_i(k) psi = dpdeta0/max(dpdeta(i,j,k),1.0) @@ -675,8 +661,8 @@ subroutine advecdiff_Eta call advvk(xn_adv(1,i,j,1),dpdeta(i,j,1),Etadot(i,j,1,1),dt_s,fluxk) endif - if(USES%uEMEP)then - call uemep_adv_k(fluxk,i,j) + if(USES%LocalFractions)then + call lf_adv_k(fluxk,i,j) end if if(itersNITERXMAX)then @@ -780,7 +765,7 @@ subroutine advecdiff_Eta do j = lj0,lj1 do i = li0,li1 - if(USES%uEMEP)call uemep_diff(i,j,ds3,ds4,ndiff) + if(USES%LocalFractions)call lf_diff(i,j,ds3,ds4,ndiff) call vertdiffn(xn_adv(1,i,j,1),NSPEC_ADV,LIMAX*LJMAX,1,EtaKz(i,j,1,1),ds3,ds4,ndiff) @@ -2925,7 +2910,7 @@ end subroutine preadvx2 subroutine preadvx3(msgnr & ,xn_adv,ps3d,vel & ,xnbeg, xnend & - ,psbeg, psend,j,k,loc_frac_1d) + ,psbeg, psend,j,k,loc_frac_src_1d) ! Initialize arrays holding boundary slices @@ -2938,28 +2923,18 @@ subroutine preadvx3(msgnr & ! output real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg real,intent(out),dimension(3) :: psend,psbeg - real,intent(inout),dimension(uEMEP_Size1,0:limax+1) :: loc_frac_1d + real,intent(inout),dimension(LF_SRC_TOTSIZE,0:limax+1) :: loc_frac_src_1d ! local - integer n,i,dx,dy,isec_poll, ii, uEMEP_Size1_local - - real,dimension((NSPEC_ADV+1)*3+uEMEP_Size1) :: send_buf_w, rcv_buf_w, send_buf_e, rcv_buf_e - - uEMEP_Size1_local = 0!default: do not treat this region - - if(uEMEP_Size1>0 .and. k>KMAX_MID-uEMEP%Nvert)then - uEMEP_Size1_local = uEMEP_Size1!treat this region - do i=li0,li1 - n=0 - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=1,uEMEP%Nsec_poll - n=n+1 - loc_frac_1d(n,i) = loc_frac(isec_poll,dx,dy,i,j,k) - enddo - enddo - enddo - enddo + integer n,i,dx,dy,isec_poll, ii + + real,dimension((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE) :: send_buf_w, rcv_buf_w, send_buf_e, rcv_buf_e + + integer :: LF_SRC_TOTSIZE_eff=0 !used to avoid copying when k>KMAX_MID-lf_Nvert + + LF_SRC_TOTSIZE_eff=0 + if(LF_SRC_TOTSIZE>0 .and. k>KMAX_MID-lf_Nvert)then + LF_SRC_TOTSIZE_eff=LF_SRC_TOTSIZE endif ! Initialize arrays holding boundary slices ! send to WEST neighbor if any @@ -2983,12 +2958,12 @@ subroutine preadvx3(msgnr & send_buf_w(n) = ps3d(LIMAX+1) n=n+1 send_buf_w(n) = ps3d(LIMAX+2) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - send_buf_w(n) = loc_frac_1d(ii,1) + send_buf_w(n) = lf(ii,1,j,k) enddo - CALL MPI_ISEND( send_buf_w, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + CALL MPI_ISEND( send_buf_w, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE,& neighbor(WEST), msgnr+1000 , MPI_COMM_CALC, request_w, IERROR) end if @@ -3012,12 +2987,12 @@ subroutine preadvx3(msgnr & send_buf_e(n) = ps3d(LIMAX+li1-2) n=n+1 send_buf_e(n) = ps3d(LIMAX+li1-1) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - send_buf_e(n) = loc_frac_1d(ii,li1) + send_buf_e(n) = lf(ii,li1,j,k) enddo - CALL MPI_ISEND( send_buf_e, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + CALL MPI_ISEND( send_buf_e, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE,& neighbor(EAST), msgnr+3000, MPI_COMM_CALC, request_e, IERROR) end if @@ -3039,13 +3014,13 @@ subroutine preadvx3(msgnr & psbeg(2) = ps3d(LIMAX) psbeg(3) = ps3d(LIMAX) end if - do ii=1,uEMEP_Size1_local - loc_frac_1d(ii,li0-1)=0.0 + do ii=1,LF_SRC_TOTSIZE_eff + loc_frac_src_1d(ii,li0-1)=0.0 enddo else - CALL MPI_RECV(rcv_buf_w, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE, & + CALL MPI_RECV(rcv_buf_w, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE, & neighbor(WEST), msgnr+3000, MPI_COMM_CALC, MPISTATUS, IERROR) n=0 @@ -3068,9 +3043,9 @@ subroutine preadvx3(msgnr & n=n+1 psbeg(3) = rcv_buf_w(n) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - loc_frac_1d(ii,li0-1) = rcv_buf_w(n) + loc_frac_src_1d(ii,li0-1) = rcv_buf_w(n) enddo end if @@ -3095,12 +3070,12 @@ subroutine preadvx3(msgnr & psend(2) = ps3d(LIMAX+li1) psend(3) = ps3d(LIMAX+li1) end if - do ii=1,uEMEP_Size1_local - loc_frac_1d(ii,li1+1)=0.0 + do ii=1,LF_SRC_TOTSIZE_eff + loc_frac_src_1d(ii,li1+1)=0.0 enddo else - CALL MPI_RECV( rcv_buf_e, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE, & + CALL MPI_RECV( rcv_buf_e, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE, & neighbor(EAST), msgnr+1000, MPI_COMM_CALC, MPISTATUS, IERROR) n=0 @@ -3123,14 +3098,13 @@ subroutine preadvx3(msgnr & n=n+1 psend(3) = rcv_buf_e(n) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - loc_frac_1d(ii,li1+1) = rcv_buf_e(n) + loc_frac_src_1d(ii,li1+1) = rcv_buf_e(n) enddo end if - do ii=1,uEMEP_Size1_local - enddo + ! synchronizing sent buffers (must be done for all ISENDs!!!) if (neighbor(WEST) .ge. 0) then CALL MPI_WAIT(request_w, MPISTATUS, IERROR) @@ -3423,7 +3397,7 @@ end subroutine preadvy2 subroutine preadvy3(msgnr & ,xn_adv,ps3d,vel & ,xnbeg, xnend & - ,psbeg, psend,i_send,k,loc_frac_1d) + ,psbeg, psend,i_send,k,loc_frac_src_1d) ! Initialize arrays holding boundary slices @@ -3436,27 +3410,16 @@ subroutine preadvy3(msgnr & ! output real,intent(out),dimension(NSPEC_ADV,3) :: xnend,xnbeg real,intent(out),dimension(3) :: psend,psbeg - real,intent(inout),dimension(uEMEP_Size1,0:ljmax+1) :: loc_frac_1d + real,intent(inout),dimension(LF_SRC_TOTSIZE,0:ljmax+1) :: loc_frac_src_1d ! local - integer ii,j,dx,dy,isec_poll,n, uEMEP_Size1_local - real,dimension((NSPEC_ADV+1)*3+uEMEP_Size1) :: send_buf_n, rcv_buf_n, send_buf_s, rcv_buf_s - - uEMEP_Size1_local = 0!default: do not treat this region - - if(uEMEP_Size1>0 .and. k>KMAX_MID-uEMEP%Nvert)then - uEMEP_Size1_local = uEMEP_Size1!treat this region - do j=lj0,lj1 - n=0 - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=1,uEMEP%Nsec_poll - n=n+1 - loc_frac_1d(n,j) = loc_frac(isec_poll,dx,dy,i_send,j,k) - enddo - enddo - enddo - enddo + integer ii,j,dx,dy,isec_poll,n + real,dimension((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE) :: send_buf_n, rcv_buf_n, send_buf_s, rcv_buf_s + integer :: LF_SRC_TOTSIZE_eff !used to avoid copying when k>KMAX_MID-lf_Nvert + + LF_SRC_TOTSIZE_eff=0 + if(LF_SRC_TOTSIZE>0 .and. k>KMAX_MID-lf_Nvert)then + LF_SRC_TOTSIZE_eff=LF_SRC_TOTSIZE endif ! send to SOUTH neighbor if any @@ -3481,12 +3444,13 @@ subroutine preadvy3(msgnr & send_buf_s(n) = ps3d(i_send+LIMAX) n=n+1 send_buf_s(n) = ps3d(i_send+2*LIMAX) - do ii=1,uEMEP_Size1_local + + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - send_buf_s(n) = loc_frac_1d(ii,1) + send_buf_s(n) = lf(ii,i_send,1,k) enddo - CALL MPI_ISEND( send_buf_s, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + CALL MPI_ISEND( send_buf_s, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, request_s, IERROR) end if @@ -3511,12 +3475,13 @@ subroutine preadvy3(msgnr & send_buf_n(n) = ps3d(i_send+(lj1-2)*LIMAX) n=n+1 send_buf_n(n) = ps3d(i_send+(lj1-1)*LIMAX) - do ii=1,uEMEP_Size1_local + + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - send_buf_n(n) = loc_frac_1d(ii,lj1) + send_buf_n(n) = lf(ii,i_send,lj1,k) enddo - CALL MPI_ISEND( send_buf_n, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + CALL MPI_ISEND( send_buf_n, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE,& neighbor(NORTH), msgnr+100, MPI_COMM_CALC, request_n, IERROR) end if @@ -3542,13 +3507,14 @@ subroutine preadvy3(msgnr & psbeg(2) = psbeg(1) psbeg(3) = psbeg(1) end if - do ii=1,uEMEP_Size1_local - loc_frac_1d(ii,0)=0.0 + + do ii=1,LF_SRC_TOTSIZE_eff + loc_frac_src_1d(ii,lj0-1)=0.0 enddo else - CALL MPI_RECV( rcv_buf_s, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local) , MPI_BYTE,& + CALL MPI_RECV( rcv_buf_s, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff) , MPI_BYTE,& neighbor(SOUTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) n=0 do ii=1,NSPEC_ADV @@ -3570,9 +3536,9 @@ subroutine preadvy3(msgnr & n=n+1 psbeg(3) = rcv_buf_s(n) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - loc_frac_1d(ii,0) = rcv_buf_s(n) + loc_frac_src_1d(ii,lj0-1) = rcv_buf_s(n) enddo end if @@ -3598,13 +3564,13 @@ subroutine preadvy3(msgnr & psend(2) = psend(1) psend(3) = psend(1) end if - do ii=1,uEMEP_Size1_local - n=n+1 - loc_frac_1d(ii,lj1+1) = 0.0 + + do ii=1,LF_SRC_TOTSIZE_eff + loc_frac_src_1d(ii,lj1+1) = 0.0 enddo else - CALL MPI_RECV( rcv_buf_n, 8*((NSPEC_ADV+1)*3+uEMEP_Size1_local), MPI_BYTE,& + CALL MPI_RECV( rcv_buf_n, 8*((NSPEC_ADV+1)*3+LF_SRC_TOTSIZE_eff), MPI_BYTE,& neighbor(NORTH), msgnr+100, MPI_COMM_CALC, MPISTATUS, IERROR) n=0 do ii=1,NSPEC_ADV @@ -3626,9 +3592,9 @@ subroutine preadvy3(msgnr & n=n+1 psend(3) = rcv_buf_n(n) - do ii=1,uEMEP_Size1_local + do ii=1,LF_SRC_TOTSIZE_eff n=n+1 - loc_frac_1d(ii,lj1+1) = rcv_buf_n(n) + loc_frac_src_1d(ii,lj1+1) = rcv_buf_n(n) enddo end if @@ -3716,7 +3682,6 @@ subroutine adv_vert_zero(xn_adv,ps3d,sdot,dt_s,fluxk) xn_adv(:,k*LIMAX*LJMAX)=max(0.0,xn_adv(:,k*LIMAX*LJMAX)+(fluxk(:,k+1))*dhs1i(k+2)) ps3d(k*LIMAX*LJMAX)=max(0.0,ps3d(k*LIMAX*LJMAX)+(fluxps(k+1))*dhs1i(k+2)) - end subroutine adv_vert_zero diff --git a/AeroConstants_mod.f90 b/AeroConstants_mod.f90 index 0e3edd0..40eef60 100644 --- a/AeroConstants_mod.f90 +++ b/AeroConstants_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/AeroFunctions.f90 b/AeroFunctions.f90 index cab0806..65dbc82 100644 --- a/AeroFunctions.f90 +++ b/AeroFunctions.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Aero_Vds_mod.f90 b/Aero_Vds_mod.f90 index 7e10cd2..a174028 100644 --- a/Aero_Vds_mod.f90 +++ b/Aero_Vds_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/AerosolCalls.f90 b/AerosolCalls.f90 index 5201d30..fb003c6 100644 --- a/AerosolCalls.f90 +++ b/AerosolCalls.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -42,12 +42,13 @@ module AerosolCalls use ChemSpecs_mod use Chemfields_mod, only: PM25_water, PM25_water_rh50, & !H2O_eqsam, & !PMwater cfac - use Config_module, only: KMAX_MID, KCHEMTOP, MasterProc + use Config_module, only: KMAX_MID, KCHEMTOP, MasterProc, USES use Debug_module, only: DEBUG ! -> DEBUG%EQUIB use EQSAM4clim_ml, only : EQSAM4clim ! use EQSAM_v03d_mod, only: eqsam_v03d use MARS_mod, only: rpmares, rpmares_2900, DO_RPMARES_new use PhysicalConstants_mod, only: AVOG + use SmallUtils_mod, only: find_index use ZchemData_mod, only: xn_2d, temp, rh, pp implicit none private @@ -68,6 +69,8 @@ module AerosolCalls ! ! FINE_PM = 1, COAR_NO3 = 2, COAR_SS = 3, COAR DUST = 4,pollen = 5 + integer, private, save :: iSeaSalt ! zero if no seasalt compounds + contains !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @@ -75,10 +78,16 @@ subroutine AerosolEquilib(debug_flag) logical, intent(in) :: debug_flag ! integer, intent(in) :: i, j logical, save :: my_first_call=.true. + character(len=*),parameter:: dtxt='AeroEqui:' - if( my_first_call .and. MasterProc ) then - write(*,*) 'AerosolEquilib: chosen: ',AERO%EQUILIB - write(*,*) 'AerosolEquilib water: chosen: ',AERO%EQUILIB_WATER + if( my_first_call ) then + iSeaSalt = find_index('SeaSalt_f',species(:)%name ) + call CheckStop(USES%SEASALT.and.iSeaSalt<1,dtxt//"iSeaSalt neg") + if( MasterProc ) then + write(*,*) 'AerosolEquilib: chosen: ',AERO%EQUILIB + write(*,*) 'AerosolEquilib water: chosen: ',AERO%EQUILIB_WATER + write(*,*) 'AerosolEquilib seasalt index: ',iSeaSalt + end if end if select case ( AERO%EQUILIB ) case ( 'EMEP' ) @@ -288,8 +297,10 @@ subroutine emep2EQSAM(debug_flag) no3in(KCHEMTOP:KMAX_MID) = xn_2d(NO3_f,KCHEMTOP:KMAX_MID)*1.e12/AVOG nh4in(KCHEMTOP:KMAX_MID) = xn_2d(NH4_f,KCHEMTOP:KMAX_MID)*1.e12/AVOG ! aH2Oin(KCHEMTOP:KMAX_MID) = H2O_eqsam(i,j,KCHEMTOP:KMAX_MID) - NAin(KCHEMTOP:KMAX_MID) = xn_2d(SEASALT_F,KCHEMTOP:KMAX_MID)*0.306e12/AVOG - CLin(KCHEMTOP:KMAX_MID) = xn_2d(SEASALT_F,KCHEMTOP:KMAX_MID)*0.55e12/AVOG + if ( iSeaSalt > 0 ) then + NAin(KCHEMTOP:KMAX_MID) = xn_2d(iSeaSalt,KCHEMTOP:KMAX_MID)*0.306e12/AVOG + CLin(KCHEMTOP:KMAX_MID) = xn_2d(iSeaSalt,KCHEMTOP:KMAX_MID)*0.55e12/AVOG + end if !-------------------------------------------------------------------------- @@ -388,8 +399,8 @@ subroutine Aero_water_rh50(i,j, debug_flag) nh3in(KMAX_MID:KMAX_MID) = xn_2d(NH3,KMAX_MID:KMAX_MID)*1.e12/AVOG no3in(KMAX_MID:KMAX_MID) = xn_2d(NO3_f,KMAX_MID:KMAX_MID)*1.e12/AVOG nh4in(KMAX_MID:KMAX_MID) = xn_2d(NH4_f,KMAX_MID:KMAX_MID)*1.e12/AVOG - NAin(KMAX_MID:KMAX_MID) = xn_2d(SEASALT_F,KMAX_MID:KMAX_MID)*0.306e12/AVOG - CLin(KMAX_MID:KMAX_MID) = xn_2d(SEASALT_F,KMAX_MID:KMAX_MID)*0.55e12/AVOG + NAin(KMAX_MID:KMAX_MID) = xn_2d(iSeaSalt,KMAX_MID:KMAX_MID)*0.306e12/AVOG + CLin(KMAX_MID:KMAX_MID) = xn_2d(iSeaSalt,KMAX_MID:KMAX_MID)*0.55e12/AVOG !.. Rh = 50% and T=20C rlhum(KMAX_MID:KMAX_MID) = 0.5 @@ -465,8 +476,8 @@ subroutine Aero_water(i,j, debug_flag) nh3in(KCHEMTOP:KMAX_MID) = xn_2d(NH3,KCHEMTOP:KMAX_MID) *1.e12/AVOG no3in(KCHEMTOP:KMAX_MID) = xn_2d(NO3_f,KCHEMTOP:KMAX_MID)*1.e12/AVOG nh4in(KCHEMTOP:KMAX_MID) = xn_2d(NH4_f,KCHEMTOP:KMAX_MID)*1.e12/AVOG - NAin(KCHEMTOP:KMAX_MID) = xn_2d(SEASALT_F,KCHEMTOP:KMAX_MID)*0.306e12/AVOG - CLin(KCHEMTOP:KMAX_MID) = xn_2d(SEASALT_F,KCHEMTOP:KMAX_MID)*0.55e12/AVOG + NAin(KCHEMTOP:KMAX_MID) = xn_2d(iSeaSalt,KCHEMTOP:KMAX_MID)*0.306e12/AVOG + CLin(KCHEMTOP:KMAX_MID) = xn_2d(iSeaSalt,KCHEMTOP:KMAX_MID)*0.55e12/AVOG rlhum(KCHEMTOP:KMAX_MID) = rh(:) tmpr(KCHEMTOP:KMAX_MID) = temp(:) diff --git a/AllocInit.f90 b/AllocInit.f90 index 6b63341..d92c0c1 100644 --- a/AllocInit.f90 +++ b/AllocInit.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Aqueous_n_WetDep_mod.f90 b/Aqueous_n_WetDep_mod.f90 index 2de9fd8..c5ba9c7 100644 --- a/Aqueous_n_WetDep_mod.f90 +++ b/Aqueous_n_WetDep_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -68,13 +68,14 @@ module Aqueous_mod ,KCHEMTOP & ! -> top of chemistry, now k=2 ,dt => dt_advec & ! -> model timestep ,IOU_INST & ! Index: instantaneous values - ,WDEP_WANTED ! Which outputs wanted! -use Debug_module, only: DEBUG ! => DEBUG%AQUEOUS, DEBUG%MY_WETDEP, DEBUG%pH -use DerivedFields_mod, only: f_2d, d_2d ! Contains Wet deposition fields + ,USES, WDEP_WANTED ! Which outputs wanted! +use Debug_module, only: DEBUG ! => DEBUG%AQUEOUS, DEBUG%MY_WETDEP, DEBUG%pH +use DerivedFields_mod, only: f_2d, d_2d ! Contains Wet deposition fields use GasParticleCoeffs_mod, only: WetCoeffs, WDspec, WDmapping, nwdep -use GridValues_mod, only: gridwidth_m,xm2,dA,dB -use Io_mod, only: IO_DEBUG, datewrite -use MassBudget_mod, only : wdeploss,totwdep +use GridValues_mod, only: gridwidth_m,xm2,dA,dB,i_fdom,j_fdom +use Io_mod, only: IO_DEBUG, datewrite +use LocalFractions_mod, only: lf_wetdep +use MassBudget_mod, only : wdeploss,totwdep use MetFields_mod, only: pr, roa, z_bnd, cc3d, lwc use MetFields_mod, only: ps use OrganicAerosol_mod, only: ORGANIC_AEROSOLS @@ -732,7 +733,11 @@ subroutine WetDeposition(i,j,debug_flag) loss = xn_2d(itot,k) * ( 1.0 - lossfac(k) ) endif xn_2d(itot,k) = xn_2d(itot,k) - loss - wdeploss(iadv) = wdeploss(iadv) + loss * rho(k) + loss = loss * rho(k) ! concentration -> weight + wdeploss(iadv) = wdeploss(iadv) + loss + + if(USES%LocalFractions) call lf_wetdep(iadv, i, j, k, loss, invgridarea) + if(DEBUG%AQUEOUS.and.debug_flag.and.pr_acc(KMAX_MID)>1.0e-5) then write(*,"(a50,2i4,a,9es12.2)") "DEBUG_WDEP, k, icalc, spec", k, & icalc, trim(WDspec(icalc)%name)//':'//trim(species_adv(iadv)%name),& @@ -768,6 +773,7 @@ subroutine WetDep_Budget(i,j,invgridarea, debug_flag) iadv = f_2d(f2d)%index d_2d(f2d,i,j,IOU_INST) = wdeploss(iadv) * invgridarea + if(DEBUG%MY_WETDEP.and.debug_flag) & call datewrite("WET-PPPSPEC: "//species_adv(iadv)%name,& iadv,(/wdeploss(iadv)/)) @@ -781,7 +787,6 @@ subroutine WetDep_Budget(i,j,invgridarea, debug_flag) wdep = dot_product(wdeploss(gmap%iadv),gmap%uconv(:)) d_2d(f2d,i,j,IOU_INST) = wdep * invgridarea - if(DEBUG%MY_WETDEP.and.debug_flag)then do g=1,size(gmap%iadv) iadv=gmap%iadv(g) diff --git a/BLPhysics_mod.f90 b/BLPhysics_mod.f90 index fb50f4f..8dddb7a 100644 --- a/BLPhysics_mod.f90 +++ b/BLPhysics_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/BiDir_emep.f90 b/BiDir_emep.f90 index 749471c..7c4b722 100644 --- a/BiDir_emep.f90 +++ b/BiDir_emep.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/BiDir_module.f90 b/BiDir_module.f90 index 542a662..0ba072e 100644 --- a/BiDir_module.f90 +++ b/BiDir_module.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Biogenics_mod.f90 b/Biogenics_mod.f90 index 65263cb..1d2a64e 100644 --- a/Biogenics_mod.f90 +++ b/Biogenics_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/BoundaryConditions_mod.f90 b/BoundaryConditions_mod.f90 index 5aea5c3..7602a89 100644 --- a/BoundaryConditions_mod.f90 +++ b/BoundaryConditions_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -1060,7 +1060,7 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) !--------------------------------------------------------------------------- ! Mace Head ozone concentrations for backgroudn sectors ! from Fig 5., Derwent et al., 1998, AE Vol. 32, No. 2, pp 145-157 - integer, parameter :: MH_YEAR1 = 1990, MH_YEAR2 = 2017 + integer, parameter :: MH_YEAR1 = 1990, MH_YEAR2 = 2018 real, dimension(12,MH_YEAR1:MH_YEAR2), parameter :: macehead_year=reshape(& [35.3,36.3,38.4,43.0,41.2,33.4,35.1,27.8,33.7,36.2,28.4,37.7,& !1990 36.1,38.7,37.7,45.8,38.8,36.3,29.6,33.1,33.4,35.7,37.3,36.7,& !1991 @@ -1101,7 +1101,8 @@ subroutine GetBICData(year,month,ibc,used,bc_data,errcode) 41.4,42.9,43.5,46.4,42.4,35.1,28.6,32.6,33.8,37.1,38.1,41.1,& !2014 41.0,43.3,43.8,42.5,39.4,33.6,31.5,35.3,35.8,42.1,40.4,41.0,& !2015 40.4,42.5,43.7,43.6,42.4,29.7,27.5,28.6,32.0,37.7,40.5,42.5,& !2016 - 41.1,45.2,46.1,45.5,40.2,33.2,28.7,32.6,34.1,39.4,41.2,39.5]& !2017 + 41.1,45.2,46.1,45.5,40.2,33.2,28.7,32.6,34.1,39.4,41.2,39.5,& !2017 + 42.1,43.6,44.8,46.9,42.8,33.8,28.0,28.9,34.3,38.9,41.5,37.8]& !2018 ,[12,MH_YEAR2-MH_YEAR1+1]) real, dimension(12), parameter :: macehead_default=& ! Defaults from 1998-2010 average diff --git a/CMX_BiomassBurning_FINNv1p5.txt b/CMX_BiomassBurning_FINNv1p5.txt new file mode 100644 index 0000000..d563359 --- /dev/null +++ b/CMX_BiomassBurning_FINNv1p5.txt @@ -0,0 +1,55 @@ +# BiomassBurning mapping FINNv1.5 to EmChem19a +# Column-1 gives FINNv1 species , +# Column-2 gives the product of two numbers: +# 1) MW if needed to get to kg/day. Not needed for FINNv1 +# (Some FINN emissions are given with mass basis, kg/day, so just +# set to 1.0. Others are given as mole/day, so multiply by MW/1000 +# to get kg/day) +# 2) mass fraction of FINN emissions assign to EMEP species (usually 1.0) +# Column-3 gives EMEP species +# +# Notes +# ! FINN v1.5 GEOS-CHEM 2015 changes: excludes 1 species: +# ! and needs one less EMEP species C5H8 +# ! 'ISOP' 0.068 1.0 'C5H8' # +# ! FINN v1.5 GEOS-CHEM 2015 changes: added 8 species: +# ! and needs 3 more EMEP species = C2H4 OXYL MGLYOX +# Gas-phase species only here. See extra_mechanisms directory for e.g. +# FFireIntert for PM, BC, OM or FFireTraces for tracer ffireCO. +#----------------------------------------------------------------------------# +# Finn mw fac emep Comment + 'CO ', 0.028, 1.0, 'CO', # + 'NO ', 0.030, 1.0, 'NO', # + 'NO2 ', 0.046, 1.0, 'NO2', # + 'SO2 ', 0.064, 1.0, 'SO2', # + 'NH3 ', 0.017, 1.0, 'NH3', # + 'ACET', 0.058, 1.0, 'C2H6', # acetone + 'ALD2', 0.044, 1.0, 'CH3CHO', # + 'ALK4', 0.058, 1.0, 'NC4H10', # + 'C2H6', 0.030, 1.0, 'C2H6', # + 'C3H8', 0.044, 1.0, 'NC4H10', # + 'CH2O', 0.030, 1.0, 'HCHO', # + 'MEK ', 0.072, 1.0, 'MEK', # + 'PRPE', 0.042, 1.0, 'C3H6', # + 'C2H4', 0.028, 1.0, 'C2H4', # v1.5 new EMEP + 'GLYC', 0.060, 1.0, 'CH3CHO', # v1.5 hydroxy-acetaldehyde? HOCH2CHO + 'HAC' , 0.074, 1.0, 'ACETOL', # v1.5 hydroxy-acetone changed M to 74! + 'BENZ', 0.078, 1.0, 'BENZENE', # v1.5 new EMEP + 'TOLU', 0.092, 1.0, 'TOLUENE', # v1.5 + 'XYLE', 0.106, 1.0, 'OXYL', # v1.5 + 'MGLY' 0.072, 1.0, 'MGLYOX', # v1.5 new EMEP +# BiomassBurning mapping FINNv1.5 to ffire_OM, ffire_BC, ffire_remPPM25 +# +# FFire PM species only here, see FFireTracers for ffire_CO tracer if wanted. +# +# The tricky bit: we read in BC, OC and PM25 from FINN, but want BC, OM and +# rempPM25 for EmChem19a , CRI etc. We solve this by using FINN's +# OC to estimate OM (factor 1.7), and subtracting both BC and OM from +# PM25 to get remPM25. (ForestFire_mod will prevent zeros) +#----------------------------------------------------------------------------# +# Finn mw fac emep Comment + 'PM25', 1.000, 1.0, 'ffire_rempPM25',# ! Will need to subtract OM BC + 'OC ', 1.700, 1.0, 'ffire_OM', # ! Uses OM/OC=1.7, see above + 'BC ', 1.000, 1.0, 'ffire_BC', # + 'OC ', -1.70, 1.0, 'ffire_rempPM25',# ! Will subtract OM + 'BC ', -1.00, 1.0, 'ffire_rempPM25',# ! Will subtract BC diff --git a/CMX_BiomassBurning_GFASv1.txt b/CMX_BiomassBurning_GFASv1.txt new file mode 100644 index 0000000..e6b1e7f --- /dev/null +++ b/CMX_BiomassBurning_GFASv1.txt @@ -0,0 +1,56 @@ +#----------------------------------------------------------------------------# +# Mapping of emissions from GFASv1 to EMEP EmChem19a species +# Included by ForestFire_mod +#----------------------------------------------------------------------------# +# Column-1 gives GFASv1 species, +# Column-2 gives MW if needed to get to kg/day. Not needed for GFASv1 +# (GFAS units are [kg/m2/s]. No unit conversion is needed.) +# Column-3 gives mass fraction of GFASv1 emissions assign to EMEP species +# Column-4 gives EMEP species +# Gas-phase species only here. See extra_mechanisms directory for e.g. +# FFireIntert for PM, BC, OM or FFireTracers for tracer ffire_CO. +#----------------------------------------------------------------------------# +# GFAS mw? fac? emep comment + 'cofire ', 1.000, 1.000, 'CO', # 081.210 | Carbon Monoxide + 'ch4fire ', 1.000, 1.000, 'CH4', # 082.210 | Methane + 'h2fire ', 1.000, 1.000, 'H2', # 084.210 | Hydrogen + 'noxfire ', 1.000, 1.000, 'NO', # 085.210 | Nitrogen Oxide. Use as NO + 'so2fire ', 1.000, 1.000, 'SO2', # 102.210 | Sulfur Dioxide + 'ch3ohfire ', 1.000, 1.000, 'CH3OH', # 103.210 | Methanol + 'c2h5ohfire ', 1.000, 1.000, 'C2H5OH', # 104.210 | Ethanol + 'c2h4fire ', 1.000, 1.000, 'C2H4', # 106.210 | Ethene + 'c3h6fire ', 1.000, 1.000, 'C3H6', # 107.210 | Propene + 'c5h8fire ', 1.000, 1.000, 'C5H8', # 108.210 | Isoprene + 'toluenefire ', 1.000, 1.000, 'TOLUENE', # 110.210 | Toluene lump(C7H8+C6H6+C8H10) + 'hialkenesfire', 1.000, 1.000, 'C3H6', # 111.210 | Higher Alkenes (CnH2n, C>=4) + 'hialkanesfire', 1.000, 1.000, 'NC4H10', # 112.210 | Higher Alkanes (CnH2n+2, C>=4) + 'ch2ofire ', 1.000, 1.000, 'HCHO', # 113.210 | Formaldehyde + 'c2h4ofire ', 1.000, 1.000, 'CH3CHO', # 114.210 | Acetaldehyde + 'nh3fire ', 1.000, 1.000, 'NH3', # 116.210 | Ammonia + 'c2h6fire ', 1.000, 1.000, 'C2H6', # 118.210 | Ethane + 'c4h10fire ', 1.000, 1.000, 'NC4H10', # 238.210 | Butanes +#----------------------------------------------------------------------------# +# BiomassBurning mapping GFASv1 to EMEP's ffire_OM, ffire_BC, ffire_remPPM25 +#----------------------------------------------------------------------------# +# Column-1 gives GFASv1 species, +# Column-2 gives unitsfac +# Column-3 gives mass fraction of GFASv1 emissions assign to EMEP species +# Column-4 gives EMEP species +# Note, GFAS species are not essential in all files, but if given they need +# to be part of the POSSIBLE_GFASv1_SPECS array in EMEP's ForestFire_mod. +# +# FFire PM species only here, see FFireTracers for ffire_CO tracer if wanted. +# +# The tricky bit: we read in BC, OC, PM25 and PM10 from GFAS, but want BC, OM, +# rempPM25 and c for EmChem19a , CRI etc. We solve this by using GFAS's +# OC to estimate OM (factor 1.7), and subtracting both BC and OM from +# PM25 to get remPM25. (ForestFire_mod will prevent zeros) +#----------------------------------------------------------------------------# +# GFAS mw? fac? emep comment + 'tpmfire ', 1.000, 1.000, 'ffire_c' , # 088.210 | PM 10 + 'pm2p5fire ', 1.000, -1.000, 'ffire_c' , # 087.210 | PM 10 - PM 2.5 + 'pm2p5fire ', 1.000, 1.000, 'ffire_rempPM25', # 087.210 | PM 2.5 + 'ocfire ', 1.700, -1.000, 'ffire_rempPM25', # 090.210 | PM 2.5 - Organic Matter + 'bcfire ', 1.000, -1.000, 'ffire_rempPM25', # 091.210 | PM 2.5 - Black Carbon + 'ocfire ', 1.700, 1.000, 'ffire_OM', # 090.210 | Organic Carbon --> O.Matter (OM/OC=1.7) + 'bcfire ', 1.000, 1.000, 'ffire_BC', # 091.210 | Black Carbon diff --git a/CMX_BoundaryConditions.txt b/CMX_BoundaryConditions.txt new file mode 100644 index 0000000..4d8979d --- /dev/null +++ b/CMX_BoundaryConditions.txt @@ -0,0 +1,38 @@ +# CMX_BoundaryConditions.txt for EmChem19a +# Provides mapping betweeen default boundary and initial conditions +# (BICs) and EMEP species. A numerical factor may be applied, and a wanted +# column is also provided so that BICs may we switched off. In many cases +# one may prefer to provide results from another model as BICs; in this +# case the mapping here is not used. +# Provided as part of the default GenChem system. +# For list of possible BICs, see defBICs in BoundaruConditions_mod.f90. +# For SeaSalt and Dust, see extra_mechanisms +# +# globBC emep fac wanted +# + 'O3 ','O3 ' , 1.0, T + 'HNO3 ','HNO3 ' , 1.0, T + 'SO2 ','SO2 ' , 1.0, T + 'SO4 ','SO4 ' , 1.0, T + 'PAN ','PAN ' , 1.0, T + 'CO ','CO ' , 1.0, T + 'C2H6 ','C2H6' , 1.0, T + 'C4H10 ','NC4H10 ' , 1.0, T + 'NO ','NO ' , 1.0, T + 'NO2 ','NO2 ' , 1.0, T + 'HCHO ','HCHO ' , 1.0, T + 'CH3CHO ','CH3CHO ' , 1.0, T + 'NO3_f ','NO3_f ' , 1.0, T + 'NO3_c ','NO3_c ' , 1.0, T + 'NH4_f ','NH4_f ' , 1.0, T + 'H2O2 ','H2O2 ' , 1.0, T +# CMX_BoundaryConditions.txt for generic emep run, Sea-salt +# globBC emep fac wanted +# + 'SeaSalt_f ','SeaSalt_f', 1.0, T + 'SeaSalt_c ','SeaSalt_c', 1.0, T +# CMX_BoundaryConditions.txt for generic emep, dust +# globBC emep fac wanted +# + 'DUST_f', 'Dust_wb_f', 1.0, T #Dust + 'DUST_c', 'Dust_wb_c', 1.0, T #Dust diff --git a/CM_ChemDims_mod.f90 b/CM_ChemDims_mod.f90 index 83a1ee6..a679a80 100644 --- a/CM_ChemDims_mod.f90 +++ b/CM_ChemDims_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -25,11 +25,11 @@ !* along with this program. If not, see . !*****************************************************************************! ! Generated by GenChem.py - DO NOT EDIT -! scheme(s) EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen +! scheme(s) EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen module ChemDims_mod implicit none - character(len=*),parameter, public :: CM_schemes_ChemDims = " EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen" + character(len=*),parameter, public :: CM_schemes_ChemDims = " EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen" ! NSPEC for TOT : All reacting species @@ -45,10 +45,10 @@ module ChemDims_mod integer, public, parameter :: NSPEC_SEMIVOL=20 ! No. DRY deposition species - integer, public, parameter :: NDRYDEP_ADV = 95 + integer, public, parameter :: NDRYDEP_ADV = 96 ! No. WET deposition species - integer, public, parameter :: NWETDEP_ADV = 82 + integer, public, parameter :: NWETDEP_ADV = 83 ! No. rate coefficients integer, parameter, public :: NCHEMRATES = 101 @@ -60,6 +60,6 @@ module ChemDims_mod integer, parameter, public :: NEMIS_File = 7 ! No. emission Specss - integer, parameter, public :: NEMIS_Specs = 51 + integer, parameter, public :: NEMIS_Specs = 53 end module ChemDims_mod diff --git a/CM_ChemGroups_mod.f90 b/CM_ChemGroups_mod.f90 index d5846aa..ed2fc46 100644 --- a/CM_ChemGroups_mod.f90 +++ b/CM_ChemGroups_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -25,7 +25,7 @@ !* along with this program. If not, see . !*****************************************************************************! ! Generated by GenChem.py - DO NOT EDIT -! scheme(s) EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen +! scheme(s) EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen module ChemGroups_mod use ChemSpecs_mod ! => species indices @@ -33,7 +33,7 @@ module ChemGroups_mod implicit none private - character(len=*),parameter, public :: CM_schemes_ChemGroups = " EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen" + character(len=*),parameter, public :: CM_schemes_ChemGroups = " EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen" ! Assignment of groups from GenIn_Species.csv @@ -43,10 +43,10 @@ module ChemGroups_mod type(typ_factors), dimension(2), public, save :: chemgroups_factors type(typ_maps), dimension(1), public, save :: chemgroups_maps - integer, public, target, save, dimension (13) :: & + integer, public, target, save, dimension (12) :: & RO2_GROUP = (/ & CH3O2, C2H5O2, C4H9O2, ISRO2, ETRO2, PRRO2, OXYO2, MEKO2, & - C5DICARBO2, MACRO2, CH3CO3, TERPO2, TERPPeroxy & + C5DICARBO2, MACRO2, CH3CO3, TERPO2 & /) integer, public, target, save, dimension (2) :: & @@ -698,13 +698,13 @@ module ChemGroups_mod DDEP_RDN_GROUP = (/ NH3, NH4_f /) integer, public, target, save, dimension (2) :: & - TNO3_GROUP = (/ NO3_f, NO3_c /) + PNO3_GROUP = (/ NO3_f, NO3_c /) integer, public, target, save, dimension (2) :: & - WDEP_TNO3_GROUP = (/ NO3_f, NO3_c /) + WDEP_PNO3_GROUP = (/ NO3_f, NO3_c /) integer, public, target, save, dimension (2) :: & - DDEP_TNO3_GROUP = (/ NO3_f, NO3_c /) + DDEP_PNO3_GROUP = (/ NO3_f, NO3_c /) integer, public, target, save, dimension (11) :: & PMCOARSE_GROUP = (/ & @@ -1184,14 +1184,23 @@ module ChemGroups_mod integer, public, target, save, dimension (2) :: & DDEP_FFUELECFINE_GROUP = (/ EC_f_ffuel_new, EC_f_ffuel_age /) - integer, public, target, save, dimension (4) :: & - POLLEN_GROUP = (/ POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_RWEED, POLLEN_GRASS /) + integer, public, target, save, dimension (5) :: & + POLLEN_GROUP = (/ & + POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_ALDER, POLLEN_RWEED, & + POLLEN_GRASS & + /) - integer, public, target, save, dimension (4) :: & - WDEP_POLLEN_GROUP = (/ POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_RWEED, POLLEN_GRASS /) + integer, public, target, save, dimension (5) :: & + WDEP_POLLEN_GROUP = (/ & + POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_ALDER, POLLEN_RWEED, & + POLLEN_GRASS & + /) - integer, public, target, save, dimension (4) :: & - DDEP_POLLEN_GROUP = (/ POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_RWEED, POLLEN_GRASS /) + integer, public, target, save, dimension (5) :: & + DDEP_POLLEN_GROUP = (/ & + POLLEN_BIRCH, POLLEN_OLIVE, POLLEN_ALDER, POLLEN_RWEED, & + POLLEN_GRASS & + /) integer, public, target, save, dimension (20) :: & CSTAR_GROUP = (/ & @@ -1823,14 +1832,14 @@ subroutine Init_ChemGroups() chemgroups(192)%name="DDEP_RDN" chemgroups(192)%specs=>DDEP_RDN_GROUP - chemgroups(193)%name="TNO3" - chemgroups(193)%specs=>TNO3_GROUP + chemgroups(193)%name="PNO3" + chemgroups(193)%specs=>PNO3_GROUP - chemgroups(194)%name="WDEP_TNO3" - chemgroups(194)%specs=>WDEP_TNO3_GROUP + chemgroups(194)%name="WDEP_PNO3" + chemgroups(194)%specs=>WDEP_PNO3_GROUP - chemgroups(195)%name="DDEP_TNO3" - chemgroups(195)%specs=>DDEP_TNO3_GROUP + chemgroups(195)%name="DDEP_PNO3" + chemgroups(195)%specs=>DDEP_PNO3_GROUP chemgroups(196)%name="PMCOARSE" chemgroups(196)%specs=>PMCOARSE_GROUP diff --git a/CM_ChemRates_mod.f90 b/CM_ChemRates_mod.f90 index 54d8867..195a6d2 100644 --- a/CM_ChemRates_mod.f90 +++ b/CM_ChemRates_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -25,7 +25,7 @@ !* along with this program. If not, see . !*****************************************************************************! ! Generated by GenChem.py - DO NOT EDIT -! scheme(s) EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen +! scheme(s) EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen module ChemRates_mod use AeroConstants_mod ! => AERO%PM etc, ... @@ -38,7 +38,7 @@ module ChemRates_mod implicit none private - character(len=*),parameter, public :: CM_schemes_ChemRates = " EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen" + character(len=*),parameter, public :: CM_schemes_ChemRates = " EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen" public :: setChemRates @@ -83,29 +83,29 @@ subroutine setChemRates() rct(8,:) = ((1.0+1.4e-21*H2O*EXP(2200.0*TINV)))*2.2e-13*EXP(600.0*TINV) rct(9,:) = (((1.0+1.4e-21*H2O*EXP(2200.0*TINV))) & & *1.9e-33*EXP(980.0*TINV))*M - rct(10,:) = (IUPAC_TROE(1.0e-31*EXP(1.6*(LOG(300/TEMP))), & - & 5.0e-11*EXP(0.3*(LOG(300/TEMP))), & + rct(10,:) = (IUPAC_TROE(1.0e-31*EXP(1.6*(LOG(300*TINV))), & + & 5.0e-11*EXP(0.3*(LOG(300*TINV))), & & 0.85, & & M, & & 0.75-1.27*LOG10(0.85))) rct(11,:) = 1.4e-12*EXP(-1310.0*TINV) rct(12,:) = 1.4e-13*EXP(-2470.0*TINV) rct(13,:) = 1.7e-12*EXP(-940.0*TINV) - rct(14,:) = 2.03e-16*EXP(-4.57*(LOG(300/TEMP)))*EXP(693.0*TINV) + rct(14,:) = 2.03e-16*EXP(-4.57*(LOG(300*TINV)))*EXP(693.0*TINV) rct(15,:) = 1.8e-11*EXP(110.0*TINV) rct(16,:) = 3.45e-12*EXP(270.0*TINV) rct(17,:) = 4.5e-14*EXP(-1260.0*TINV) - rct(18,:) = (IUPAC_TROE(3.6e-30*EXP(4.1*(LOG(300/TEMP))), & - & 1.9e-12*EXP(-0.2*(LOG(300/TEMP))), & + rct(18,:) = (IUPAC_TROE(3.6e-30*EXP(4.1*(LOG(300*TINV))), & + & 1.9e-12*EXP(-0.2*(LOG(300*TINV))), & & 0.35, & & M, & & 0.75-1.27*LOG10(0.35))) - rct(19,:) = (IUPAC_TROE(1.3e-3*EXP(3.5*(LOG(300/TEMP)))*EXP(-11000.0*TINV), & - & 9.70e14*EXP(-0.1*(LOG(300/TEMP)))*EXP(-11080.0*TINV), & + rct(19,:) = (IUPAC_TROE(1.3e-3*EXP(3.5*(LOG(300*TINV)))*EXP(-11000.0*TINV), & + & 9.70e14*EXP(-0.1*(LOG(300*TINV)))*EXP(-11080.0*TINV), & & 0.35, & & M, & & 0.75-1.27*LOG10(0.35))) - rct(20,:) = (IUPAC_TROE(3.2e-30*EXP(4.5*(LOG(300/TEMP))), & + rct(20,:) = (IUPAC_TROE(3.2e-30*EXP(4.5*(LOG(300*TINV))), & & 3.0e-11, & & 0.41, & & M, & @@ -116,13 +116,13 @@ subroutine setChemRates() & 1335.0, & & 2.7e-17, & & 2199.0)) - rct(22,:) = (IUPAC_TROE(7.4e-31*EXP(2.4*(LOG(300/TEMP))), & - & 3.3e-11*EXP(0.3*(LOG(300/TEMP))), & + rct(22,:) = (IUPAC_TROE(7.4e-31*EXP(2.4*(LOG(300*TINV))), & + & 3.3e-11*EXP(0.3*(LOG(300*TINV))), & & 0.81, & & M, & & 0.75-1.27*LOG10(0.81))) rct(23,:) = 2.5e-12*EXP(260.0*TINV) - rct(24,:) = (IUPAC_TROE(1.4e-31*EXP(3.1*(LOG(300/TEMP))), & + rct(24,:) = (IUPAC_TROE(1.4e-31*EXP(3.1*(LOG(300*TINV))), & & 4.0e-12, & & 0.4, & & M, & @@ -149,8 +149,8 @@ subroutine setChemRates() rct(40,:) = 4.7e-12*EXP(345.0*TINV) rct(41,:) = (1.4e-12*EXP(-1860.0*TINV)) rct(42,:) = (7.5e-12*EXP(290.0*TINV)) - rct(43,:) = (IUPAC_TROE(3.28e-28*EXP(6.87*(LOG(300/TEMP))), & - & 1.125e-11*EXP(1.105*(LOG(300/TEMP))), & + rct(43,:) = (IUPAC_TROE(3.28e-28*EXP(6.87*(LOG(300*TINV))), & + & 1.125e-11*EXP(1.105*(LOG(300*TINV))), & & 0.3, & & M, & & 0.75-1.27*LOG10(0.3))) @@ -163,14 +163,14 @@ subroutine setChemRates() rct(46,:) = 9.8e-12*EXP(-425.0*TINV) rct(47,:) = (2.91e-13*EXP(1300.0*TINV))*0.625 rct(48,:) = (2.7e-12*EXP(360.0*TINV)) - rct(49,:) = (IUPAC_TROE(8.6e-29*EXP(3.1*(LOG(300/TEMP))), & - & 9.0e-12*EXP(0.85*(LOG(300/TEMP))), & + rct(49,:) = (IUPAC_TROE(8.6e-29*EXP(3.1*(LOG(300*TINV))), & + & 9.0e-12*EXP(0.85*(LOG(300*TINV))), & & 0.48, & & M, & & 0.75-1.27*LOG10(0.48))) rct(50,:) = 1.53e-13*EXP(1300.0*TINV) rct(51,:) = 6.82e-15*EXP(-2500.0*TINV) - rct(52,:) = (IUPAC_TROE(8.0e-27*EXP(3.5*(LOG(300/TEMP))), & + rct(52,:) = (IUPAC_TROE(8.0e-27*EXP(3.5*(LOG(300*TINV))), & & 9.0e-9*TINV, & & 0.5, & & M, & @@ -194,8 +194,8 @@ subroutine setChemRates() rct(69,:) = 4.26e-16*EXP(-1520.0*TINV) rct(70,:) = 7.0e-16*EXP(-2100.0*TINV) rct(71,:) = 1.6e-12*EXP(305.0*TINV) - rct(72,:) = (IUPAC_TROE(3.28e-28*EXP(6.87*(LOG(300/TEMP))), & - & 1.125e-11*EXP(1.105*(LOG(300/TEMP))), & + rct(72,:) = (IUPAC_TROE(3.28e-28*EXP(6.87*(LOG(300*TINV))), & + & 1.125e-11*EXP(1.105*(LOG(300*TINV))), & & 0.3, & & M, & & 0.75-1.27*LOG10(0.3)))*0.107 @@ -238,24 +238,24 @@ subroutine setChemRates() & :) rct(95,:) = 4.0e-12*FGAS(NON_C_BSOA_UG1e3, & & :) - rct(96,:) = EC_AGEING_RATE() - rct(97,:) = HYDROLYSISN2O5() - rct(98,:) = UPTAKERATE(CNO3, & + rct(96,:) = HYDROLYSISN2O5() + rct(97,:) = UPTAKERATE(CNO3, & & GAM=0.001, & & S=S_M2M3(AERO%PM, & & :)) - rct(99,:) = UPTAKERATE(CHNO3, & + rct(98,:) = UPTAKERATE(CHNO3, & & GAM=0.1, & & S=S_M2M3(AERO%DU_C, & & :)) - rct(100,:) = UPTAKERATE(CHNO3, & - & GAM=0.01, & - & S=S_M2M3(AERO%SS_C, & - & :)) - rct(101,:) = UPTAKERATE(CHO2, & + rct(99,:) = UPTAKERATE(CHNO3, & + & GAM=0.01, & + & S=S_M2M3(AERO%SS_C, & + & :)) + rct(100,:) = UPTAKERATE(CHO2, & & GAM=0.2, & & S=S_M2M3(AERO%PM, & & :)) + rct(101,:) = EC_AGEING_RATE() end subroutine setChemRates diff --git a/CM_ChemSpecs_mod.f90 b/CM_ChemSpecs_mod.f90 index 6a3d28c..a7edef8 100644 --- a/CM_ChemSpecs_mod.f90 +++ b/CM_ChemSpecs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -25,14 +25,14 @@ !* along with this program. If not, see . !*****************************************************************************! ! Generated by GenChem.py - DO NOT EDIT -! scheme(s) EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen +! scheme(s) EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen module ChemSpecs_mod use ChemDims_mod ! => NSPEC_TOT, NCHEMRATES, .... implicit none private - character(len=*),parameter, public :: CM_schemes_ChemSpecs = " EmChem19a PM_VBS_EmChem19 BVOC_IsoMT1_emis Aqueous_EmChem16x Aero2017nx ShipNOx FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert BVOC_SQT_NV Pollen" + character(len=*),parameter, public :: CM_schemes_ChemSpecs = " EmChem19a PM_VBS_EmChem19 Aqueous_EmChem16x Aero2017nx ShipNOx PM_FFireInert SeaSalt DustExtended Ash PM_WoodFFuelInert EC_ageing BVOC_SQT_NV BVOC_IsoMT1_emis Pollen" integer, public, parameter :: & @@ -120,19 +120,19 @@ module ChemSpecs_mod , SO2 = 70 integer, public, parameter :: & - TERPPeroxy = 71 & - , shipNOx = 72 & - , Dust_road_f = 73 & - , Dust_road_c = 74 & - , Dust_wb_f = 75 & - , Dust_wb_c = 76 & - , Dust_sah_f = 77 & - , Dust_sah_c = 78 & - , SQT_SOA_NV = 79 & - , POLLEN_BIRCH= 80 + shipNOx = 71 & + , Dust_road_f = 72 & + , Dust_road_c = 73 & + , Dust_wb_f = 74 & + , Dust_wb_c = 75 & + , Dust_sah_f = 76 & + , Dust_sah_c = 77 & + , SQT_SOA_NV = 78 & + , POLLEN_BIRCH= 79 & + , POLLEN_OLIVE= 80 integer, public, parameter :: & - POLLEN_OLIVE= 81 & + POLLEN_ALDER= 81 & , POLLEN_RWEED= 82 & , POLLEN_GRASS= 83 & , ASOC_ng1e2 = 84 & @@ -265,19 +265,19 @@ module ChemSpecs_mod , IXADV_APINENE = 53 & , IXADV_TERPOOH = 54 & , IXADV_SO2 = 55 & - , IXADV_TERPPeroxy = 56 & - , IXADV_shipNOx = 57 & - , IXADV_Dust_road_f = 58 & - , IXADV_Dust_road_c = 59 & - , IXADV_Dust_wb_f = 60 + , IXADV_shipNOx = 56 & + , IXADV_Dust_road_f = 57 & + , IXADV_Dust_road_c = 58 & + , IXADV_Dust_wb_f = 59 & + , IXADV_Dust_wb_c = 60 integer, public, parameter :: & - IXADV_Dust_wb_c = 61 & - , IXADV_Dust_sah_f = 62 & - , IXADV_Dust_sah_c = 63 & - , IXADV_SQT_SOA_NV = 64 & - , IXADV_POLLEN_BIRCH= 65 & - , IXADV_POLLEN_OLIVE= 66 & + IXADV_Dust_sah_f = 61 & + , IXADV_Dust_sah_c = 62 & + , IXADV_SQT_SOA_NV = 63 & + , IXADV_POLLEN_BIRCH= 64 & + , IXADV_POLLEN_OLIVE= 65 & + , IXADV_POLLEN_ALDER= 66 & , IXADV_POLLEN_RWEED= 67 & , IXADV_POLLEN_GRASS= 68 & , IXADV_ASOC_ng1e2 = 69 & @@ -508,7 +508,6 @@ subroutine define_chemicals() species(APINENE ) = Chemical("APINENE ", 136.0000, 1, 10.0000, 0.0000, 0.0000 ) species(TERPOOH ) = Chemical("TERPOOH ", 186.0000, 0, 10.0000, 0.0000, 0.0000 ) species(SO2 ) = Chemical("SO2 ", 64.0000, 0, 0.0000, 0.0000, 1.0000 ) - species(TERPPeroxy ) = Chemical("TERPPeroxy ", 0.0000, 0, 0.0000, 0.0000, 0.0000 ) species(shipNOx ) = Chemical("shipNOx ", 46.0000, 0, 0.0000, 1.0000, 0.0000 ) species(Dust_road_f ) = Chemical("Dust_road_f ", 200.0000, 0, 0.0000, 0.0000, 0.0000 ) species(Dust_road_c ) = Chemical("Dust_road_c ", 200.0000, 0, 0.0000, 0.0000, 0.0000 ) @@ -519,6 +518,7 @@ subroutine define_chemicals() species(SQT_SOA_NV ) = Chemical("SQT_SOA_NV ", 302.0000, 0, 14.0000, 0.0000, 0.0000 ) species(POLLEN_BIRCH) = Chemical("POLLEN_BIRCH", 12.0000, 0, 0.0000, 0.0000, 0.0000 ) species(POLLEN_OLIVE) = Chemical("POLLEN_OLIVE", 12.0000, 0, 0.0000, 0.0000, 0.0000 ) + species(POLLEN_ALDER) = Chemical("POLLEN_ALDER", 12.0000, 0, 0.0000, 0.0000, 0.0000 ) species(POLLEN_RWEED) = Chemical("POLLEN_RWEED", 12.0000, 0, 0.0000, 0.0000, 0.0000 ) species(POLLEN_GRASS) = Chemical("POLLEN_GRASS", 12.0000, 0, 0.0000, 0.0000, 0.0000 ) species(ASOC_ng1e2 ) = Chemical("ASOC_ng1e2 ", 12.0000, 0, 1.0000, 0.0000, 0.0000 ) diff --git a/CM_DryDep.inc b/CM_DryDep.inc index b84a6a4..037f03b 100644 --- a/CM_DryDep.inc +++ b/CM_DryDep.inc @@ -93,6 +93,7 @@ type(dep_t), public, dimension(NDRYDEP_ADV), save :: CM_DDepMap = (/ & , dep_t("SQT_SOA_NV", "PMf ", -999.0 ) & , dep_t("POLLEN_BIRCH", "POLLb ", -999.0 ) & , dep_t("POLLEN_OLIVE", "POLLo ", -999.0 ) & +, dep_t("POLLEN_ALDER", "POLLa ", -999.0 ) & , dep_t("POLLEN_RWEED", "POLLr ", -999.0 ) & , dep_t("POLLEN_GRASS", "POLLg ", -999.0 ) & /) diff --git a/CM_EmisSpecs.inc b/CM_EmisSpecs.inc index 632a0e2..a076617 100644 --- a/CM_EmisSpecs.inc +++ b/CM_EmisSpecs.inc @@ -46,8 +46,10 @@ character(len=14), save, dimension(NEMIS_Specs), public :: EMIS_Specs = (/ & , "REMPPM_C " & , "PSO4F " & , "PSO4C " & +, "SQT_SOA_NV " & , "POLLEN_BIRCH " & , "POLLEN_OLIVE " & +, "POLLEN_ALDER " & , "POLLEN_RWEED " & , "POLLEN_GRASS " & /) diff --git a/CM_Reactions1.inc b/CM_Reactions1.inc index 3af937b..5399a7c 100644 --- a/CM_Reactions1.inc +++ b/CM_Reactions1.inc @@ -221,7 +221,7 @@ !-> HO2 cont. L = L + rct(76,k) * xnew(TERPO2) & - + rct(101,k) + + rct(100,k) xnew(HO2) = (xold(HO2) + dt2 * P) / (1.0 + dt2 * L) @@ -581,7 +581,7 @@ + rcphot(IDNO3,k) !-> NO3 cont. - L = L + rct(98,k) + L = L + rct(97,k) xnew(NO3) = (xold(NO3) + dt2 * P) / (1.0 + dt2 * L) @@ -591,7 +591,7 @@ P = rct(18,k) * xnew(NO2) * xnew(NO3) L = rct(19,k) & - + rct(97,k) + + rct(96,k) xnew(N2O5) = (xold(N2O5) + dt2 * P) / (1.0 + dt2 * L) @@ -614,7 +614,7 @@ + 0.1575* rct(51,k) * xnew(C2H4) * xnew(O3) & + 0.169* rct(53,k) * xnew(C3H6) * xnew(O3) & + 0.09* rct(65,k) * xnew(C5H8) * xnew(O3) & - + 0.5* rct(101,k) * xnew(HO2) + + 0.5* rct(100,k) * xnew(HO2) L = rct(6,k) * xnew(OH) & + rcphot(IDH2O2,k) & @@ -639,15 +639,15 @@ P = rct(20,k) * xnew(NO2) * xnew(OH) & + rct(36,k) * xnew(HCHO) * xnew(NO3) & + rct(41,k) * xnew(CH3CHO) * xnew(NO3) & - + 2* rct(97,k) * xnew(N2O5) & - + rct(98,k) * xnew(NO3) & + + 2* rct(96,k) * xnew(N2O5) & + + rct(97,k) * xnew(NO3) & + rct(20,k) * xnew(shipNOx) * xnew(OH) & + 3.2e-5 * xnew(shipNOx) L = rct(21,k) * xnew(OH) & + rcphot(IDHNO3,k) & - + rct(99,k) & - + rct(100,k) + + rct(98,k) & + + rct(99,k) xnew(HNO3) = (xold(HNO3) + dt2 * P) / (1.0 + dt2 * L) @@ -1216,15 +1216,6 @@ xnew(SO2) = (xold(SO2) + dt2 * P) / (1.0 + dt2 * L) -!-> TERPPeroxy - - ! P = 0.0 - - ! L = 0.0 - - ! Nothing to do for TERPPeroxy! xnew(TERPPeroxy) = max(0.0, xold(TERPPeroxy)) - - !-> shipNOx P = rcemis(SHIPNOX,k) @@ -1291,7 +1282,8 @@ !-> SQT_SOA_NV - P = 0.00383* RCBIO(2,K) + P = rcemis(SQT_SOA_NV,k) & + + 0.00383* RCBIO(2,K) ! L = 0.0 @@ -1316,6 +1308,15 @@ xnew(POLLEN_OLIVE) = xold(POLLEN_OLIVE) + dt2 * P +!-> POLLEN_ALDER + + P = rcemis(POLLEN_ALDER,k) + + ! L = 0.0 + + xnew(POLLEN_ALDER) = xold(POLLEN_ALDER) + dt2 * P + + !-> POLLEN_RWEED P = rcemis(POLLEN_RWEED,k) diff --git a/CM_Reactions2.inc b/CM_Reactions2.inc index c08c1ee..a85e1d7 100644 --- a/CM_Reactions2.inc +++ b/CM_Reactions2.inc @@ -287,8 +287,8 @@ !-> NO3_c - P = rct(99,k) * xnew(HNO3) & - + rct(100,k) * xnew(HNO3) + P = rct(98,k) * xnew(HNO3) & + + rct(99,k) * xnew(HNO3) ! L = 0.0 @@ -434,15 +434,15 @@ P = rcemis(EC_F_WOOD_NEW,k) - L = rct(96,k) + L = rct(101,k) xnew(EC_f_wood_new) = (xold(EC_f_wood_new) + dt2 * P) / (1.0 + dt2 * L) !-> EC_f_wood_age - P = rct(96,k) * xnew(EC_f_wood_new) & - + rcemis(EC_F_WOOD_AGE,k) + P = rcemis(EC_F_WOOD_AGE,k) & + + rct(101,k) * xnew(EC_f_wood_new) ! L = 0.0 @@ -462,15 +462,15 @@ P = rcemis(EC_F_FFUEL_NEW,k) - L = rct(96,k) + L = rct(101,k) xnew(EC_f_ffuel_new) = (xold(EC_f_ffuel_new) + dt2 * P) / (1.0 + dt2 * L) !-> EC_f_ffuel_age - P = rct(96,k) * xnew(EC_f_ffuel_new) & - + rcemis(EC_F_FFUEL_AGE,k) + P = rcemis(EC_F_FFUEL_AGE,k) & + + rct(101,k) * xnew(EC_f_ffuel_new) ! L = 0.0 diff --git a/CM_WetDep.inc b/CM_WetDep.inc index 333a1aa..fddfa79 100644 --- a/CM_WetDep.inc +++ b/CM_WetDep.inc @@ -80,6 +80,7 @@ type(dep_t), public, dimension(NWETDEP_ADV), save :: CM_WDepMap = (/ & , dep_t("SQT_SOA_NV", "PMf ", -999.0 ) & , dep_t("POLLEN_BIRCH", "POLLw ", -999.0 ) & , dep_t("POLLEN_OLIVE", "POLLw ", -999.0 ) & +, dep_t("POLLEN_ALDER", "POLLw ", -999.0 ) & , dep_t("POLLEN_RWEED", "POLLw ", -999.0 ) & , dep_t("POLLEN_GRASS", "POLLw ", -999.0 ) & /) diff --git a/CellMet_mod.f90 b/CellMet_mod.f90 index 7a480e7..2ae58ff 100644 --- a/CellMet_mod.f90 +++ b/CellMet_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/CheckStop_mod.f90 b/CheckStop_mod.f90 index 5c6fc37..853e13f 100644 --- a/CheckStop_mod.f90 +++ b/CheckStop_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/ChemFields_mod.f90 b/ChemFields_mod.f90 index 7a08e2a..f6ef864 100644 --- a/ChemFields_mod.f90 +++ b/ChemFields_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/ChemFunctions_mod.f90 b/ChemFunctions_mod.f90 index dc3aaae..12dc409 100644 --- a/ChemFunctions_mod.f90 +++ b/ChemFunctions_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/CoDep_mod.f90 b/CoDep_mod.f90 index 17e7809..70d28ed 100644 --- a/CoDep_mod.f90 +++ b/CoDep_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/ColumnSource_mod.f90 b/ColumnSource_mod.f90 index 306c981..9295e7b 100644 --- a/ColumnSource_mod.f90 +++ b/ColumnSource_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Config_module.f90 b/Config_module.f90 index fac3b33..ad9d57a 100644 --- a/Config_module.f90 +++ b/Config_module.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -38,10 +38,10 @@ module Config_module use ChemGroups_mod, only: chemgroups use Debug_module, only: DEBUG, DebugCell use Io_Nums_mod, only: IO_NML, IO_LOG, IO_TMP -use OwnDataTypes_mod, only: typ_ss, uEMEP_type, Emis_id_type, emis_in,& - EmisFile_id_type, Emis_sourceFile_id_type,& +use OwnDataTypes_mod, only: typ_ss, lf_sources, lf_country_group_type, uEMEP_type, Emis_id_type, & + emis_in, EmisFile_id_type, Emis_sourceFile_id_type,& TXTLEN_NAME, TXTLEN_FILE, TXTLEN_SHORT,& - TXTLEN_DERIV, Emis_mask_type, & + TXTLEN_DERIV, Emis_mask_type, & Deriv, typ_s1ind,typ_s5ind,O3cl_t,typ_s3,typ_s4 use TimeDate_mod, only: date use Precision_mod, only: dp @@ -168,12 +168,13 @@ module Config_module ! ,ESX = .false. &! Uses ESX ,PFT_MAPS = .false. &! ,uEMEP = .false. &! make local fraction of pollutants + ,LocalFractions = .false. &! make local fraction of pollutants ! meteo related ,SOILWATER = .false. &! ,EtaCOORDINATES = .true. &! default since October 2014 ,WRF_MET_NAMES = .false. &!to read directly WRF metdata ,ZREF = .false. &! testing - ,EFFECTIVE_RESISTANCE = .false. ! Drydep method designed for shallow layer + ,EFFECTIVE_RESISTANCE = .true. ! Drydep method designed for shallow layer ! If USES%EMISTACKS, need to set: character(len=4) :: PlumeMethod = "none" !MKPS:"ASME","NILU","PVDI" @@ -245,7 +246,15 @@ module Config_module ,JUMPOVER29FEB = .false. ! When current date is 29th February, jump to next date. type(uEMEP_type), public, save :: uEMEP ! The parameters steering uEMEP -integer, public, save :: NTIMING_uEMEP = 5 !reset to zero if USES%uEMEP = F + +integer, public, parameter :: MAXSRC=1000 +type(lf_sources), public, save :: lf_src(MAXSRC) +integer, public, parameter :: Max_Country_list=100 +character(len=10), public, save :: lf_country_list(Max_Country_list)='NOTSET'!new format "uEMEP" Local Fractions. List of countries +integer, public, parameter :: Max_Country_groups=30 +type(lf_country_group_type), public, save :: lf_country_group(Max_Country_groups) +integer, public, parameter :: Max_Country_sectors=13 +integer, public, save :: lf_country_sector_list(Max_Country_sectors)=-1!new format "uEMEP" Local Fractions. List of sectors for each country integer, public, save :: & FREQ_HOURLY = 1 ! 3Dhourly netcdf special output frequency @@ -365,10 +374,9 @@ module Config_module integer, public, parameter :: & NSITES_MAX = 99 & ! Max. no surface sites allowed ,FREQ_SITE = 1 & ! Interval (hrs) between outputs - ,NSHL_SITE_MAX = 10 & ! Bosco OH NSPEC_SHL & ! No. short-lived species + ,NSHL_SITE_MAX = 10 & ! No. short-lived species ,NXTRA_SITE_MISC = 2 & ! No. Misc. met. params ( e.g. T2, d_2d) - ,NXTRA_SITE_D2D = 20 ! Bosco = +5-4 No. Misc. met. params ( e.g. T2, d_2d) -!Bosco ,NXTRA_SITE_D2D = 9+8 ! No. Misc. met. params ( e.g. T2, d_2d) + ,NXTRA_SITE_D2D = 18 ! No. params from d_2d fields integer, public, parameter :: NSONDES_MAX = 99 ! Max. no sondes allowed integer, private :: isite ! To assign arrays, if needed @@ -405,17 +413,14 @@ module Config_module !These variables must have been set in My_Derived for them to be used. character(len=24), public, parameter, dimension(NXTRA_SITE_D2D) :: & SITE_XTRA_D2D=[character(len=24):: & - "HMIX","PSURF", & ! Bosco skip: "ws_10m","rh2m",& + "HMIX", & !Hmix is interpolated in time, unlike NWP version "Emis_mgm2_BioNatC5H8","Emis_mgm2_BioNatTERP",& "Emis_mgm2_BioNatNO","Emis_mgm2_nox",& 'WDEP_PREC',&!''SNratio',& - 'met2d_uref','met2d_u10', 'met2d_v10','met2d_rh2m', & - !'met2d_SMI1', 'met2d_SMI3',& + 'met2d_ps', 'met2d_uref','met2d_u10', & !u10 seems to be wind-speed + !'met2d_v10','met2d_rh2m', & 'met2d_SMI_uppr', 'met2d_SMI_deep',& 'met2d_ustar_nwp', 'met2d_LH_Wm2', 'met2d_SH_Wm2',& - !BB 'SMI_deep','met2d_SMI_d','SMI_uppr','met2d_SMI_s',& -!Boscso Extra: +5 - !BB'USTAR_NWP', 'USTAR_DF','INVL_DF', & 'met2d_PARdbh', 'met2d_PARdif' & ] @@ -737,8 +742,9 @@ module Config_module character(len=TXTLEN_FILE), target, save, public :: RoadMapFile = 'DataDir/RoadMap.nc' character(len=TXTLEN_FILE), target, save, public :: AVG_SMI_2005_2010File = 'DataDir/AVG_SMI_2005_2010.nc' character(len=TXTLEN_FILE), target, save, public :: Soil_TegenFile = 'DataDir/Soil_Tegen.nc' -character(len=TXTLEN_FILE), target, save, public :: SitesFile = 'DataDir/sitesLL.dat' -character(len=TXTLEN_FILE), target, save, public :: SondesFile = 'DataDir/sondesLL.dat' +! default site/sond files use lat, lon and Kdown coords: +character(len=TXTLEN_FILE), target, save, public :: SitesFile = 'DataDir/sitesLLKD.dat' +character(len=TXTLEN_FILE), target, save, public :: SondesFile = 'DataDir/sondesLLKD.dat' character(len=TXTLEN_FILE), target, save, public :: GLOBAL_LAInBVOCFile = 'DataDir/GLOBAL_LAInBVOC.nc' character(len=TXTLEN_FILE), target, save, public :: EMEP_EuroBVOCFile = 'DataDir/LandInputs_Mar2011/EMEP_EuroBVOC.nc' !SEASON replace by 'jan', 'apr', 'jul' or 'oct' in readdiss @@ -780,7 +786,11 @@ subroutine Config_Constants(iolog) ,DEBUG & ! ,CONVECTION_FACTOR & ,EURO_SOILNOX_DEPSCALE & - ,uEMEP & + ,uEMEP & !old format . Avoid, will be removed in future versions + ,lf_src & !new format "uEMEP" Local Fractions + ,lf_country_list & !new format "uEMEP" Local Fractions. List of countries + ,lf_country_group & !new format "uEMEP" Local Fractions. List of group of countries + ,lf_country_sector_list & !new format "uEMEP" Local Fractions. List of sectors for each country ,INERIS_SNAP1, INERIS_SNAP2 & ! Used for TFMM time-factors ,FREQ_HOURLY & ,ANALYSIS, SOURCE_RECEPTOR, VOLCANO_SR & @@ -880,6 +890,8 @@ subroutine Config_Constants(iolog) write(*,*) trim(logtxt), IOLOG write(IO_LOG,*) trim(logtxt) ! Can't call PrintLog due to circularity end if + + USES%LocalFractions = USES%LocalFractions .or. USES%uEMEP !for backward compatibility ! Convert DEBUG%SPEC to index if(first_call)then @@ -928,6 +940,7 @@ subroutine Config_Constants(iolog) ExtraConfigFile(i) = key2str(ExtraConfigFile(i),'DataDir',DataDir) ExtraConfigFile(i) = key2str(ExtraConfigFile(i),'GRID',GRID) ExtraConfigFile(i) = key2str(ExtraConfigFile(i),'OwnInputDir',OwnInputDir) + ExtraConfigFile(i) = key2str(ExtraConfigFile(i),'EmisDir',EmisDir) if(MasterProc) then write(*,*) dtxt//'Also reading namelist ',i,trim(ExtraConfigFile(i)) write(*,*) dtxt//"LAST LINE:"//trim(LAST_CONFIG_LINE) ! for debugs @@ -948,9 +961,11 @@ subroutine Config_Constants(iolog) !EEEEEEEEEEEEEEEEEEEEEEEEE meteo = key2str(meteo,'DataDir',DataDir) + meteo = key2str(meteo,'EmisDir',EmisDir) meteo = key2str(meteo,'GRID',GRID) MetDir= key2str(meteo,'meteoYYYYMMDD.nc','./') DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'MetDir',MetDir) + DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'DataDir',DataDir) DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'GRID',GRID) DegreeDayFactorsFile=key2str(DegreeDayFactorsFile,'YYYY',startdate(1)) if(MasterProc)then @@ -1014,6 +1029,7 @@ subroutine Config_Constants(iolog) !part of a class cannot be a target (?) must therefore do this separately if(Emis_sourceFiles(i)%filename/='NOTSET')then Emis_sourceFiles(i)%filename = key2str(Emis_sourceFiles(i)%filename,'DataDir',DataDir) + Emis_sourceFiles(i)%filename = key2str(Emis_sourceFiles(i)%filename,'EmisDir',EmisDir) Emis_sourceFiles(i)%filename = key2str(Emis_sourceFiles(i)%filename,'GRID',GRID) Emis_sourceFiles(i)%filename = & key2str(Emis_sourceFiles(i)%filename,'OwnInputDir',OwnInputDir) @@ -1022,6 +1038,7 @@ subroutine Config_Constants(iolog) do i = 1, size(EmisMask) if(EmisMask(i)%filename/='NOTSET')then EmisMask(i)%filename = key2str(EmisMask(i)%filename,'DataDir',DataDir) + EmisMask(i)%filename = key2str(EmisMask(i)%filename,'EmisDir',EmisDir) EmisMask(i)%filename = key2str(EmisMask(i)%filename,'GRID',GRID) EmisMask(i)%filename = & key2str(EmisMask(i)%filename,'OwnInputDir',OwnInputDir) @@ -1031,6 +1048,7 @@ subroutine Config_Constants(iolog) if(associated(InputFiles(i)%filename))then InputFiles(i)%filename =key2str(InputFiles(i)%filename,'ZCMDIR',ZCMDIR) InputFiles(i)%filename =key2str(InputFiles(i)%filename,'DataDir',DataDir) + InputFiles(i)%filename =key2str(InputFiles(i)%filename,'EmisDir',EmisDir) InputFiles(i)%filename =key2str(InputFiles(i)%filename,'GRID',GRID) InputFiles(i)%filename = & key2str(InputFiles(i)%filename,'OwnInputDir',OwnInputDir) @@ -1047,16 +1065,16 @@ subroutine Config_Constants(iolog) write(*,*)dtxt//'Reading CH4 IBCs from:', iyr_trend, trim(fileName_CH4_ibcs) endif - if(.not. USES%uEMEP)NTIMING_uEMEP = 0 - end subroutine Config_Constants ! PRELIM. Just writes out USES so far. subroutine WriteConfig_to_RunLog(iolog) integer, intent(in) :: iolog ! for Log file NAMELIST /OutUSES/ USES - write(iolog,*) ' USES after 1st time-step' - write(iolog,nml=OutUSES) + if(MasterProc)then + write(iolog,*) ' USES after 1st time-step' + write(iolog,nml=OutUSES) + endif end subroutine WriteConfig_to_RunLog subroutine associate_File(FileName) diff --git a/Convection_mod.f90 b/Convection_mod.f90 index a2a7b0e..fcf911f 100644 --- a/Convection_mod.f90 +++ b/Convection_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Country_mod.f90 b/Country_mod.f90 index c7cd9e1..bd78361 100644 --- a/Country_mod.f90 +++ b/Country_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -341,10 +341,11 @@ module Country_mod integer, public :: IC_AOX ! Extended EMEP-ext. part of Arctic Ocean ! Divided countries put together - integer, public :: IC_RUE ! Russian Federation in the extended EMEP domain (RU+RFE+RUX, 36, 37, 38, 42, 71, 74) + integer, public :: IC_RUE ! Russian Federation in the extended EMEP domain (RU+RFE+RUX, 61=(36, 37, 38, 42), 71, 74) integer, public :: IC_KZT ! Kazakhstan (KZ+KZE, 53, 75) integer, public :: IC_UZT ! Uzbekistan (UZ+UZE, 76,78) integer, public :: IC_TMT ! Turkmenistan (TM+TME, 77,79) + integer, public :: IC_AST ! Asian areas in the EMEP domain (CAS+ARL+ARE+ASM+ASE, 80,82,83,84,85,) !b) Domain x = -16-132 y = -11-0 integer, public :: IC_NAX ! EMEP-external part of North Africa @@ -847,6 +848,9 @@ subroutine init_Country() ix=ix+1 IC_TMT=ix Country( IC_TMT ) = cc( "TMT" ,'-', 95 ,F, 95, 95, -100 , "Turkmenistan (all)" ) +ix=ix+1 +IC_AST=ix +Country( IC_AST ) = cc( "AST" ,'-', 96 ,F, 96, 96, -100 , "Asian areas in the EMEP domain" ) ! NH3Emis new land code for NMR-NH3 project ix=ix+1 diff --git a/DO3SE_mod.f90 b/DO3SE_mod.f90 index e872ba8..f8ade1a 100644 --- a/DO3SE_mod.f90 +++ b/DO3SE_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Debug_module.f90 b/Debug_module.f90 index a2bd1af..26fff1e 100644 --- a/Debug_module.f90 +++ b/Debug_module.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -69,7 +69,7 @@ module Debug_module ,SEASALT = .false. & ,SETUP_1DCHEM = .false. & ,SETUP_1DBIO = .false. & - ,SITES = .false. & + ,SITES = .false. & ! set also DEBUG%SITE below ,SOILNOX = .false. & ,SOLVER = .false. & ,STOFLUX = .false. & @@ -85,7 +85,8 @@ module Debug_module !---------------------------------------------------------- integer, dimension(2) :: IJ = [-999,-999] ! index for debugging print out character(len=20) :: SPEC = 'O3' ! default. - character(len=20) :: datetxt = '-' ! default. + character(len=20) :: datetxt = '-' ! default. + character(len=20) :: SITE = 'NOT_SET' ! e.g. Birkenes. (Full name not essential) integer :: ISPEC = -999 ! Will be set after NML end type emep_debug type(emep_debug), public, save :: DEBUG diff --git a/DefPhotolysis_mod.f90 b/DefPhotolysis_mod.f90 index 5cfdaa7..d190e39 100644 --- a/DefPhotolysis_mod.f90 +++ b/DefPhotolysis_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -62,7 +62,7 @@ module DefPhotolysis_mod integer, public, parameter :: & NRCPHOT = 17 &! Number of photolytic reactions - ,NRCPHOTextended = 18 + ,NRCPHOTextended = 20 integer, public, parameter:: NzPHODIS=20 !number of heights defined in the input files real, save, public :: zPHODIS(NzPHODIS) !heights of the input files, in km assumed constants @@ -117,6 +117,8 @@ module DefPhotolysis_mod integer, public, parameter ::& IDHONO = 18 & ! added as extended + ,IDNO3_NO = 19 & ! added + ,IDNO3_NO2 = 20 & ! added ,IDMEK = IDCH3COX & ! just name change CHECK ! ,IDCHOCHO_2CHO = IDHCOHCO & ! Just name change CHECK, TMP!!! ! ,IDCHOCHO_2CO = IDHCOHCO & ! Just name change CHECK, TMP!!! @@ -130,9 +132,9 @@ module DefPhotolysis_mod !NEEDS FIXING. Changed from ESX to try to match above, but eg NO3 is difficult integer, public, parameter :: & IDO3_O1D = 2,IDO3_O3P = 1, & !:BUG FIX RB Apr25 - IDNO3_NO = IDNO3 & - ,IDNO3_NO2 = IDNO3 & !HONO NEEDS FIXING! - ,IDHCHO_H = 6 & ! HCHO -> CO + 2 HO2 +! IDNO3_NO = IDNO3 & +! ,IDNO3_NO2 = IDNO3 & !HONO NEEDS FIXING! + IDHCHO_H = 6 & ! HCHO -> CO + 2 HO2 ,IDHCHO_H2 = 7 !& ! HCHO -> CO + H2 ! ,MCM_J18 = 18, MCM_J20 = 20 & ! ,MCM_J22 = 22 , IDMEK = 22 & @@ -424,13 +426,15 @@ subroutine setup_phot(i,j,errcode) ! adding HONO rcphot(IDHONO,:) = 0.22* rcphot(IDNO2,:) - + rcphot(IDNO3_NO,:) = 0.127 * rcphot(IDNO3,:) + rcphot(IDNO3_NO2,:) = 0.873 * rcphot(IDNO3,:) end if ! end izen < 90 (daytime) test - if(photo_out_ix>0) d_3d(photo_out_ix,i,j,1:num_lev3d,IOU_INST) = & - rcphot(IDNO2,lev3d(1:num_lev3d)) - + if(photo_out_ix>0)then + d_3d(photo_out_ix,i,j,1:num_lev3d,IOU_INST) = & + rcphot(IDNO2,max(KCHEMTOP,lev3d(1:num_lev3d))) !WARNING: rcphot defined only up to KCHEMTOP! + endif end subroutine setup_phot ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< diff --git a/DerivedFields_mod.f90 b/DerivedFields_mod.f90 index 663f550..d7a50fe 100644 --- a/DerivedFields_mod.f90 +++ b/DerivedFields_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Derived_mod.f90 b/Derived_mod.f90 index 1e71a46..b70d083 100644 --- a/Derived_mod.f90 +++ b/Derived_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -81,12 +81,13 @@ module Derived_mod ,SecEmisOut, EmisOut, SplitEmisOut, & isec2SecOutWanted use EmisGet_mod, only: nrcemis,iqrc2itot +use Functions_mod, only: Tpot_2_T ! Conversion function use GasParticleCoeffs_mod, only: DDdefs use GridValues_mod, only: debug_li, debug_lj, debug_proc, A_mid, B_mid, & dA,dB,xm2, GRIDWIDTH_M, GridArea_m2,xm_i,xm_j,glon,glat use Io_Progs_mod, only: datewrite -use MetFields_mod, only: roa,pzpbl,Kz_m2s,th,zen, ustar_nwp, u_ref,& - met, derivmet, & +use MetFields_mod, only: roa,Kz_m2s,th,zen, ustar_nwp, u_ref, hmix,& + met, derivmet, q, & ws_10m, rh2m, z_bnd, z_mid, u_mid,v_mid,ps, t2_nwp, & SoilWater_deep, SoilWater_uppr, Idirect, Idiffuse use MosaicOutputs_mod, only: nMosaic, MosaicOutput @@ -107,10 +108,11 @@ module Derived_mod use OrganicAerosol_mod, only : ORGANIC_AEROSOLS, Reset_3dOrganicAerosol use ZchemData_mod, only: Fpart ! for FSOA work use SmallUtils_mod, only: find_index, LenArray, NOT_SET_STRING, trims +use Tabulations_mod, only : tab_esat_Pa use TimeDate_mod, only: day_of_year,daynumber,current_date,& tdif_days use TimeDate_ExtraUtil_mod,only: to_stamp, date_is_reached -use uEMEP_mod, only: av_uEMEP +use LocalFractions_mod, only: lf_av use Units_mod, only: Units_Scale,Group_Units,& to_molec_cm3 ! converts roa [kg/m3] to M [molec/cm3] implicit none @@ -202,14 +204,14 @@ module Derived_mod !========================================================================= subroutine Init_Derived() integer :: alloc_err - integer :: iddefPMc, i + integer :: iddefPMc character(len=*), parameter :: dtxt='IniDeriv:' !debug label dbg0 = (DEBUG%DERIVED .and. MasterProc ) allocate(D2_O3_DAY( LIMAX, LJMAX, NTDAY)) D2_O3_DAY = 0.0 - if(USES%uEMEP .and. (uEMEP%HOUR_INST.or.uEMEP%HOUR)) HourlyEmisOut = .true. + if(USES%LocalFractions .and. (uEMEP%HOUR_INST.or.uEMEP%HOUR)) HourlyEmisOut = .true. if(dbg0) write(*,*) dtxt//"INIT STUFF" call Init_My_Deriv() !-> wanted_deriv2d, wanted_deriv3d @@ -350,7 +352,6 @@ subroutine Define_Derived() character(len=TXTLEN_IND) :: outind integer :: ind, iadv, ishl, idebug, n, igrp, iout, isec_poll - logical :: found if(dbg0) write(6,*) " START DEFINE DERIVED " ! same mol.wt assumed for PPM25 and PPMCOARSE @@ -924,7 +925,7 @@ subroutine Setups() nvoc = nvoc + 1 voc_index(nvoc) = n - voc_carbon(nvoc) = species( NSPEC_SHL+n )%carbons + voc_carbon(nvoc) = int(species( NSPEC_SHL+n )%carbons) end if end do !==================================================================== @@ -974,15 +975,16 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) ind2d_pm10=-999 ,ind3d_pm10=-999, & ind2d_pm25=-999 - integer :: imet_tmp, ind, ind_tmp, iadvDep + integer :: imet_tmp, ind, iadvDep real, pointer, dimension(:,:,:) :: met_p => null() logical, allocatable, dimension(:) :: ingrp integer :: wlen,ispc,kmax,iem - integer :: isec_poll,isec,iisec,ii,ipoll + integer :: isec_poll,isec,iisec,ii,ipoll,itemp real :: default_frac,tot_frac,loc_frac_corr character(len=*), parameter :: dtxt='Deriv:' - + real pp, temp, qsat + if(.not. date_is_reached(spinup_enddate))return ! we do not average during spinup timefrac = dt/3600.0 @@ -1200,7 +1202,7 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) case ( "HMIX", "HMIX00", "HMIX12" ) forall ( i=1:limax, j=1:ljmax ) - d_2d( n, i,j,IOU_INST) = pzpbl(i,j) + d_2d( n, i,j,IOU_INST) = hmix(i,j,1) end forall if ( dbgP ) then @@ -2025,7 +2027,17 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) case("wind_speed_3D") forall(i=1:limax,j=1:ljmax,k=1:num_lev3d) & d_3d(n,i,j,k,IOU_INST)=sqrt(u_mid(i,j,lev3d(k))**2+v_mid(i,j,lev3d(k))**2) - + case("RH_3D") !relative humidity + do k=1, num_lev3d + do j=1, ljmax + do i=1, limax + pp = A_mid(k) + B_mid(k)*ps(i,i,1) + itemp= nint(th(i,i,k,1) * Tpot_2_T(pp)) + qsat = 0.622 * tab_esat_Pa( itemp ) / pp + d_3d(n,i,j,k,IOU_INST)=min(q(i,i,k,1)/qsat,1.0) + end do + end do + end do case default if(MasterProc) write(*,*) "MET3D NOT FOUND"//trim(f_3d(n)%name)//":"//trim(f_3d(n)%subclass) d_3d(n,:,:,:,IOU_INST)=0.0 @@ -2310,8 +2322,8 @@ subroutine Derived(dt,End_of_Day,ONLY_IOU) end do !the uemep fields do not fit in the general d_3d arrays. Use ad hoc routine - if(USES%uEMEP .and. .not. present(ONLY_IOU))then - call av_uEMEP(dt,End_of_Day) + if(USES%LocalFractions .and. .not. present(ONLY_IOU))then + call lf_av(dt,End_of_Day) endif first_call = .false. diff --git a/DryDep_mod.f90 b/DryDep_mod.f90 index 45e5d6a..8c79433 100644 --- a/DryDep_mod.f90 +++ b/DryDep_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -84,6 +84,7 @@ module DryDep_mod ,NLUMAX & ! Max. no countries per grid ,LandCover ! Provides codes, SGS, LAI, etc, use LandDefs_mod, only: LandType, LandDefs, STUBBLE +use LocalFractions_mod, only: lf_drydep use LocalVariables_mod, only: Grid, L, iL & ! Grid and sub-scale Met/Veg data ,NLOCDRYDEP_MAX ! Used to store Vg use MassBudget_mod, only: totddep @@ -658,9 +659,9 @@ subroutine DryDep(i,j) if ( L%is_water ) then do icmp = 1, nddep if(USES%EFFECTIVE_RESISTANCE)then - sea_ratio(icmp) = Vg_eff(icmp)/Vg_3m(icmp) - else sea_ratio(icmp) = Vg_ref(icmp)/Vg_3m(icmp) + else + sea_ratio(icmp) = Vg_eff(icmp)/Vg_3m(icmp) endif end do else @@ -668,10 +669,10 @@ subroutine DryDep(i,j) do icmp = 1, nddep if(USES%EFFECTIVE_RESISTANCE)then Vg_ratio(icmp) = Vg_ratio(icmp) & - + L%coverage * Vg_eff(icmp)/Vg_3m(icmp) + + L%coverage * Vg_ref(icmp)/Vg_3m(icmp) else Vg_ratio(icmp) = Vg_ratio(icmp)& - + L%coverage * Vg_ref(icmp)/Vg_3m(icmp) + + L%coverage * Vg_eff(icmp)/Vg_3m(icmp) endif end do end if @@ -771,9 +772,9 @@ subroutine DryDep(i,j) do icmp = 1, nddep ! NDRYDEP_CALC if(USES%EFFECTIVE_RESISTANCE)then - vg_fac (icmp) = 1.0 - exp ( -Sub(0)%Vg_Ref(icmp) * dtz ) - else vg_fac (icmp) = 1.0 - exp ( -Sub(0)%Vg_eff(icmp) * dtz ) + else + vg_fac (icmp) = 1.0 - exp ( -Sub(0)%Vg_Ref(icmp) * dtz ) endif end do ! icmp @@ -951,7 +952,9 @@ subroutine DryDep(i,j) convfac2 = convfac * xm2(i,j) * inv_gridarea - !.. Add DepLoss to budgets if needed: + if(USES%LocalFractions) call lf_drydep(i,j,DepLoss, convfac2) + + !.. Add DepLoss to budgets if needed: call Add_MosaicOutput(debug_flag,i,j,convfac2,& itot2DDspec, fluxfrac_adv, Deploss ) diff --git a/DustProd_mod.f90 b/DustProd_mod.f90 index 08dd18e..cb5d0a2 100644 --- a/DustProd_mod.f90 +++ b/DustProd_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/EcoSystem_mod.f90 b/EcoSystem_mod.f90 index 31134b0..c5887b0 100644 --- a/EcoSystem_mod.f90 +++ b/EcoSystem_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/EmisDef_mod.f90 b/EmisDef_mod.f90 index 9d8f527..2805a0f 100755 --- a/EmisDef_mod.f90 +++ b/EmisDef_mod.f90 @@ -186,7 +186,7 @@ module EmisDef_mod integer, public, save :: NEmis_sources = 0 integer, public, save :: NEmis_3Dsources = 0 integer, public, save :: NEmisFile_sources = 0 -integer, public, save :: ix3Dmap(1000) = 0 +integer, public, save :: ix3Dmap(NEmis_sourcesMAX) = 0 real, allocatable, public, save, dimension(:,:,:):: Emis_source_2D !One 2D map for each source real, allocatable, public, save, dimension(:,:,:,:):: Emis_source_3D !One 3D map for each source integer, allocatable, public, save, dimension(:,:,:):: Emis_country_map !country indices for each gridcell @@ -232,20 +232,38 @@ module EmisDef_mod !should be defined somewhere else? real, public, allocatable, dimension(:,:,:,:,:,:), save :: & - loc_frac& ! Fraction of pollutants that are produced locally + loc_frac& ! Fraction of pollutants that are produced locally, surrounding sources ,loc_frac_hour_inst& !Houry local fractions ,loc_frac_hour& !Houry average of local fractions ,loc_frac_day& !Daily average of local fractions ,loc_frac_month& !Monthly average of local fractions ,loc_frac_full !Fullrun average of local fractions +real, public, allocatable, dimension(:,:,:,:,:), save :: & + lf_src_acc ! accumulated local fraction over time periods +real, public, allocatable, dimension(:,:,:,:,:), save :: & + lf_src_tot ! concentrations of pollutants used for Local Fractions + +real, public, allocatable, dimension(:,:,:,:,:,:), save :: emis_lf_cntry real, public, allocatable, dimension(:,:,:,:), save :: & - loc_tot_hour_inst& !all contributions + loc_frac_src & ! Fraction of pollutants that are produced locally, list of defined sources + ,lf & ! Fraction of pollutants that are produced locally, for all defined sources + ,emis_lf & ! 3D Emission defined for each source + ,lf_emis_tot & ! sum of 3D Emission defined for each pollutant used for lf + ,loc_frac_src_full & ! Fraction of pollutants that are produced locally, list of defined sources + ,lf_src_full & ! Fraction of pollutants that are produced locally, list of defined sources + ,loc_tot_hour_inst& !all contributions ,loc_tot_hour& !Hourly average of all contributions ,loc_tot_day& !Daily average of all contributions ,loc_tot_month& !Monthly average of all contributions ,loc_tot_full !Fullrun average of all contributions +real, public, allocatable, dimension(:,:,:), save :: & + loc_frac_drydep ! ddepositions per source (not fractions!) +real, public, allocatable, dimension(:,:,:), save :: & + loc_frac_wetdep ! wdepositions per source (not fractions!) real, public, allocatable, dimension(:,:,:,:), save :: & loc_frac_1d ! Fraction of pollutants without i or j and extended (0:limax+1 or 0:ljmax+1) +real, public, allocatable, dimension(:,:), save :: & + loc_frac_src_1d ! Fraction of pollutants without i or j and extended (0:limax+1 or 0:ljmax+1) integer, public, parameter:: Nneighbors = 9 !localfractions from 8 neighbors + self !Ocean variables diff --git a/EmisGet_mod.f90 b/EmisGet_mod.f90 index 261c9e7..bbb445e 100644 --- a/EmisGet_mod.f90 +++ b/EmisGet_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -593,7 +593,7 @@ subroutine Emis_init_GetCdf(EmisFile_in, EmisFile, names_in, nnames) if(EmisFile_in%source(i)%varname == cdfvarname)then nn = nn + 1 source_found(i) = 0 !mark as found - call CheckStop(NEmis_sources+nn > NEmis_sourcesMAX,"NEmis_sourcesMAX exceeded (A)") + call CheckStop(NEmis_sources+nn > NEmis_sourcesMAX,"lf: too many sources. Increase NEmis_sourcesMAX") Emis_source(NEmis_sources+nn)%ix_in=i if ( debugm0 ) write(*,*) dtxt//'var add:',trim(cdfvarname) endif @@ -603,7 +603,7 @@ subroutine Emis_init_GetCdf(EmisFile_in, EmisFile, names_in, nnames) ! into different vertical levels) do i = 1,max(1,nn) !we define a new emission source - call CheckStop(NEmis_sources+1 > NEmis_sourcesMAX,"NEmis_sourcesMAX exceeded (B)") + call CheckStop(NEmis_sources+1 > NEmis_sourcesMAX,"lf: too many sources. Please, increase NEmis_sourcesMAX") NEmis_sources = NEmis_sources + 1 Emis_source(NEmis_sources)%varname = trim(cdfvarname) Emis_source(NEmis_sources)%species = trim(cdfspecies) @@ -1493,6 +1493,7 @@ subroutine EmisSplit() call read_line(IO_EMIS,txtinput,ios) if ( ios /= 0 ) exit READ_DATA ! End of file read(unit=txtinput,fmt=*,iostat=ios) iland_icode, isec, (tmp(i),i=1, nsplit) + if( MasterProc .and. ios /= 0 ) then print *, "ERROR: EmisGet: Failure reading emispslit file" print *, "Expecting to split into nsplit=", nsplit @@ -1825,7 +1826,7 @@ subroutine make_iland_for_time(debug_tfac, indate, i, j, iland, wday, iland_time hour_iland, Country(iland)%timezone call datewrite("EmisSet DAY 24x7:", & (/ i, iland, wday, wday_loc, hour_iland /), & - (/ fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc,iland_timefac_hour) /) ) + (/ fac_ehh24x7(1,ISNAP_TRAF,hour_iland,wday_loc,iland_timefac_hour) /) ) end if end subroutine make_iland_for_time diff --git a/Emissions_mod.f90 b/Emissions_mod.f90 index b94c711..ae6391b 100644 --- a/Emissions_mod.f90 +++ b/Emissions_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -95,8 +95,8 @@ module Emissions_mod , NEmisMask, EmisMaskValues & !new format ,Emis_field, Emis_id, NEmis_id & ,NEmisFile_sources, EmisFiles,NEmis_sources, Emis_source& - , Emis_source_2D, Emis_source_3D,ix3Dmap, NEmis_3Dsources - + , Emis_source_2D, Emis_source_3D,ix3Dmap, NEmis_3Dsources& + , emis_lf, lf_emis_tot, emis_lf_cntry use EmisGet_mod, only: & EmisSplit & ,EmisGetCdf & @@ -148,6 +148,7 @@ module Emissions_mod ,Read_monthly_emis_grid_fac & ,GridTfac &!array with monthly gridded time factors ,yearly_normalize !renormalize timefactors after reset +use LocalFractions_mod, only : add_lf_emis implicit none private @@ -391,7 +392,7 @@ subroutine Init_Emissions Emis_source(ii)%species_ix = ix if(dbg)write(*,'(a,i4,a)')dtxt//' species found '// & trim(Emis_source(ii)%country_ISO), ix, ' '//trim(species(ix)%name) - if(Emis_source(ii)%include_in_local_fractions .and. USES%uEMEP )then + if(Emis_source(ii)%include_in_local_fractions .and. USES%LocalFractions )then if(me==0)write(*,*)"WARNING: local fractions will not include single species "//Emis_source(ii)%species endif else ! ix<=0 @@ -570,28 +571,43 @@ subroutine EmisUpdate real :: fac, gridyear, ccsum,emsum(NEMIS_FILE) character(len=TXTLEN_NAME) :: fmt TYPE(timestamp) :: ts1,ts2 - logical, save ::first_call=.true. + logical, save ::first_call = .true. real, allocatable, dimension(:,:) :: sumemis ! Sum of emissions per country - + logical :: writeoutsums + logical :: writeout !if something to show and writeoutsums=T + + writeoutsums = first_call .or. step_main<10 .or. DEBUG%EMISSIONS + writeout = .false. !init + ts1=make_timestamp(current_date) coming_date = current_date coming_date%seconds = coming_date%seconds + 1800!NB: end_of_validity_date is at end of period, for example 1-1-2018 for December 2017 gridyear = GRIDWIDTH_M * GRIDWIDTH_M * 3600*24*nydays*1.0E-6!kg/m2/s -> kt/year - if(first_call)then - ! sum emissions per countries - allocate(sumemis(NLAND,NEMIS_FILE)) - sumemis=0.0 - endif + do n = 1, NEmisFile_sources + if(writeoutsums .or. EmisFiles(n)%periodicity=='monthly')then + writeoutsums = .true. + ! sum emissions per countries + allocate(sumemis(NLAND,NEMIS_FILE)) + sumemis = 0.0 + emsum = 0.0 + exit + end if + end do !loop over all sources and see which one need to be reread from files do n = 1, NEmisFile_sources - if(date_is_reached(to_idate(EmisFiles(n)%end_of_validity_date,5 )))then - if(me==0 .and. (step_main<10 .or. DEBUG%EMISSIONS))& - write(*,*)'Emis: update date is reached ',& + if(date_is_reached(to_idate(EmisFiles(n)%end_of_validity_date,5 )))then + if(me==0 .and. writeoutsums)& + write(*,*)'Emis: current date has reached past update date ',& EmisFiles(n)%end_of_validity_date,EmisFiles(n)%periodicity + if(writeoutsums) writeout = .true. ! at least something to write + if(writeoutsums .and. .not.allocated(sumemis))then + allocate(sumemis(NLAND,NEMIS_FILE)) + emsum = 0.0 + endif !values are no more valid, fetch new one - if(first_call)sumemis=0.0 + if(writeoutsums)sumemis=0.0 do is = EmisFiles(n)%source_start,EmisFiles(n)%source_end if(Emis_source(is)%is3D)then ix = ix3Dmap(is) @@ -784,7 +800,7 @@ subroutine EmisUpdate endif endif - if(first_call)then + if(writeout)then ! sum emissions per countries (in ktonnes?) itot = Emis_source(is)%species_ix isec = Emis_source(is)%sector @@ -827,7 +843,7 @@ subroutine EmisUpdate endif endif - if(first_call)then + if(writeout)then CALL MPI_ALLREDUCE(MPI_IN_PLACE,sumemis,& NLAND*NEMIS_FILE,MPI_REAL8,MPI_SUM,MPI_COMM_CALC,IERROR) if(me==0)then @@ -849,12 +865,12 @@ subroutine EmisUpdate end do endif enddo - if(first_call)then + if(writeout)then fmt="(a5,i4,1x,a9,3x,30(f12.2,:))" if(me==0 .and. NEmisFile_sources>0)write(* ,fmt)'EMTAB', 999,'TOTAL ',emsum(:) - deallocate(sumemis) CALL MPI_BARRIER(MPI_COMM_CALC, IERROR)!so that print out comes out nicely endif + if (allocated(sumemis)) deallocate(sumemis) first_call=.false. @@ -1091,7 +1107,7 @@ subroutine Emissions(year) allocate(e_fact_lonlat(NSECTORS,MAXFEMISLONLAT,NEMIS_FILE)) e_fact_lonlat=1.0 if(.not.allocated(timefac))allocate(timefac(NLAND,N_TFAC,NEMIS_FILE)) - if(.not.allocated(fac_ehh24x7))allocate(fac_ehh24x7(N_TFAC,24,7,NLAND)) + if(.not.allocated(fac_ehh24x7))allocate(fac_ehh24x7(NEMIS_FILE,N_TFAC,24,7,NLAND)) if(.not.allocated(fac_emm))allocate(fac_emm(NLAND,12,N_TFAC,NEMIS_FILE)) if(.not.allocated(fac_min))allocate(fac_min(NLAND,N_TFAC,NEMIS_FILE)) if(.not.allocated(fac_edd))allocate(fac_edd(NLAND, 7,N_TFAC,NEMIS_FILE)) @@ -1151,7 +1167,7 @@ subroutine Emissions(year) CALL MPI_BCAST(fac_cemm,8*12,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(fac_emm,8*NLAND*12*N_TFAC*NEMIS_FILE,MPI_BYTE,0,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(fac_edd,8*NLAND*7*N_TFAC*NEMIS_FILE,MPI_BYTE,0,MPI_COMM_CALC,IERROR) - CALL MPI_BCAST(fac_ehh24x7,8*N_TFAC*24*7*NLAND,MPI_BYTE,0,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(fac_ehh24x7,8*NEMIS_FILE*N_TFAC*24*7*NLAND,MPI_BYTE,0,MPI_COMM_CALC,IERROR) !define fac_min for all processors forall(iemis=1:NEMIS_FILE,insec=1:N_TFAC,inland=1:NLAND) & @@ -1599,7 +1615,9 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour integer :: i_Emis_4D, iem_treated character(len=125) ::varname TYPE(timestamp) :: ts1,ts2 - + integer :: iwday + real :: daynorm, roadfac + ! Initialize ehlpcom0 = GRAV* 0.001*AVOG!0.001 = kg_to_g / m3_to_cm3 @@ -1619,7 +1637,6 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour call NewDayFactors(indate) if(USES%DEGREEDAY_FACTORS) call DegreeDayFactors(daynumber) ! => fac_emm, fac_edd !========================== - ! for ROADDUST wday=day_of_week(indate%year,indate%month,indate%day) if(wday==0)wday=7 ! Sunday -> 7 oldday = indate%day @@ -1663,14 +1680,17 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour if(DEBUG_EMISTIMEFACS.and.MasterProc) & write(*,"(a,2f8.3)") " EmisSet traffic 24x7", & - fac_ehh24x7(ISNAP_TRAF,1,4,1),fac_ehh24x7(ISNAP_TRAF,13,4,1) + fac_ehh24x7(1,ISNAP_TRAF,1,4,1),fac_ehh24x7(1,ISNAP_TRAF,13,4,1) !.......................................... if(hourchange) then totemadd(:) = 0. gridrcemis(:,:,:,:) = 0.0 SecEmisOut(:,:,:,:) = 0.0 - if(USES%ROADDUST)gridrcroadd0(:,:,:) = 0.0 + if(USES%LocalFractions) emis_lf(:,:,:,:) = 0.0 + if(USES%LocalFractions) lf_emis_tot(:,:,:,:) = 0.0 + if(USES%LocalFractions) emis_lf_cntry(:,:,:,:,:,:) = 0.0 + if(USES%ROADDUST) gridrcroadd0(:,:,:) = 0.0 !.......................................... ! Process each grid: do j = 1,ljmax @@ -1701,8 +1721,8 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour do iem = 1, NEMIS_FILE tfac = timefac(iland_timefac,sec2tfac_map(isec),iem) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) - + * fac_ehh24x7(iem,sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) + if(debug_tfac.and.iem==1) & write(*,"(a,3i4,f8.3)")"EmisSet DAY TFAC:",isec,sec2tfac_map(isec),hour_iland,tfac @@ -1718,7 +1738,7 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! we make use of a baseload even for SNAP2 tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) + * fac_ehh24x7(iem,sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) if(debug_tfac .and. indate%hour==12 .and. iem==1) & write(*,"(a,3i3,2i4,7f8.3)") "SNAPHDD tfac ", & @@ -1741,6 +1761,9 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour totemadd(itot) = totemadd(itot) & + tmpemis(iqrc) * dtgrid * xmd(i,j) end do ! f + + if(USES%LocalFractions) call add_lf_emis(s,i,j,iem,isec,iland) + end do ! iem ! Assign to height levels 1-KEMISTOP @@ -1796,18 +1819,18 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour hour_iland = 1 if(wday_loc==0)wday_loc=7 ! Sunday -> 7 if(wday_loc>7 )wday_loc=1 - end if - + end if + + roadfac = 1.0 if(ANY(iland==(/IC_FI,IC_NO,IC_SE/)).and. & ! Nordic countries ANY(indate%month==(/3,4,5/)))then ! spring road dust - tfac = fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc,iland_timefac_hour)*2.0 ! Doubling in Mar-May (as in TNO model) - else - tfac = fac_ehh24x7(ISNAP_TRAF,hour_iland,wday_loc,iland_timefac_hour) + roadfac=2.0 end if do iem = 1, NROAD_FILES - s = tfac * roaddust_emis_pot(i,j,icc,iem) - if(DEBUG%ROADDUST.and.debug_proc.and.i==DEBUG_li.and.j==DEBUG_lj)& + tfac = fac_ehh24x7(iem, ISNAP_TRAF,hour_iland,wday_loc,iland_timefac_hour) + s = tfac * roadfac * roaddust_emis_pot(i,j,icc,iem) + if(DEBUG%ROADDUST.and.debug_proc.and.i==DEBUG_li.and.j==DEBUG_lj)& write(*,*)"DEBUG ROADDUST! iem,tfac,icc,roaddust_emis_pot,s", & iem,tfac,icc,roaddust_emis_pot(i,j,icc,iem),s @@ -1856,17 +1879,34 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour if(isec>0)then call CheckStop(iqrc<=0,"emitted sector species must belong to one of the splitted species") iem = iqrc2iem(iqrc) + + if(Emis_source(n)%periodicity == 'monthly')then + !make normalization factor for daily fac + iland_timefac = find_index(Country(iland)%timefac_index,Country(:)%icode) + iwday = mod(wday-indate%day+35, 7) + 1 !note both indate%day and wday start at 1 + daynorm = 0.0 + do i = 1, nmdays(indate%month) + daynorm = daynorm + fac_edd(iland_timefac,iwday,isec,iem) + iwday = iwday + 1 + if(iwday>7)iwday = 1 + enddo + daynorm = nmdays(indate%month)/daynorm + endif + do j = 1,ljmax - do i = 1,limax - + do i = 1,limax if(Emis_source(n)%periodicity == 'yearly' .or. Emis_source(n)%periodicity == 'monthly')then !we need to apply hourly factors call make_iland_for_time(debug_tfac, indate, i, j, iland, wday, iland_timefac,hour_iland,wday_loc,iland_timefac_hour) - tfac = fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) + tfac = fac_ehh24x7(iem,sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) if(Emis_source(n)%periodicity == 'yearly')then - !apply monthly factor on top of hourly factors + !apply monthly and daily factor on top of hourly factors tfac = tfac * timefac(iland_timefac,sec2tfac_map(isec),iem) - endif + endif + if(Emis_source(n)%periodicity == 'monthly')then + !apply daily factors, with renormalization to conserve monthly sums + tfac = tfac * fac_edd(iland_timefac,wday,isec,iem) * daynorm + endif else !not monthly or yearly emissions, timefactors must be included in emission values tfac = 1.0 @@ -1879,6 +1919,9 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Add up emissions in ktonne totemadd(itot) = totemadd(itot) & + s * dtgrid * xmd(i,j) + + if(USES%LocalFractions .and. me==0) write(*,*)'WARNING: single emitted species not implemented in uEMEP yet' + ! Assign to height levels 1-KEMISTOP do k=KEMISTOP,KMAX_MID gridrcemis(iqrc,k,i,j) = gridrcemis(iqrc,k,i,j) & @@ -1898,6 +1941,20 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour iem=find_index(Emis_source(n)%species,EMIS_FILE(:)) call CheckStop(iem<0, "did not recognize species "//trim(Emis_source(n)%species)) call CheckStop(Emis_source(n)%sector<=0," sector must be defined for "//trim(Emis_source(n)%varname)) + + if(Emis_source(n)%periodicity == 'monthly')then + !make normalization factor for daily fac + iland_timefac = find_index(Country(iland)%timefac_index,Country(:)%icode) + iwday = mod(wday-indate%day+35, 7) + 1 + daynorm = 0.0 + do i = 1, nmdays(indate%month) + daynorm = daynorm + fac_edd(iland_timefac,iwday,isec,iem) + iwday = iwday + 1 + if(iwday>7)iwday = 1 + enddo + daynorm = nmdays(indate%month)/daynorm + endif + do f = 1,emis_nsplit(iem) itot = iemsplit2itot(f,iem) call CheckStop(itot<0, "did not recognize split "//trim(Emis_source(n)%species)) @@ -1907,11 +1964,15 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour if(Emis_source(n)%periodicity == 'yearly' .or. Emis_source(n)%periodicity == 'monthly')then !we need to apply hourly factors call make_iland_for_time(debug_tfac, indate, i, j, iland, wday, iland_timefac,hour_iland,wday_loc,iland_timefac_hour) - tfac = fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) + tfac = fac_ehh24x7(iem,sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) if(Emis_source(n)%periodicity == 'yearly')then - !apply monthly factor on top of hourly factors + !apply monthly and daily factor on top of hourly factors tfac = tfac * timefac(iland_timefac,sec2tfac_map(isec),iem) endif + if(Emis_source(n)%periodicity == 'monthly')then + !apply daily factors, with renormalization to conserve monthly sums + tfac = tfac * fac_edd(iland_timefac,wday,isec,iem) * daynorm + endif else !not monthly or yearly emissions, timefactors must be included in emission values tfac = 1.0 @@ -1921,13 +1982,14 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour !Degree days - only SNAP-2 if(USES%DEGREEDAY_FACTORS .and. & - sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors) then + sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors .and. & + (Emis_source(n)%periodicity == 'yearly' .or. Emis_source(n)%periodicity == 'monthly')) then oldtfac = tfac ! If INERIS_SNAP2 set, the fac_min will be zero, otherwise ! we make use of a baseload even for SNAP2 tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) + * fac_ehh24x7(iem,sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) if(debug_tfac .and. indate%hour==12 .and. iem==1) & write(*,"(a,3i3,2i4,7f8.3)") "SNAPHDD tfac ", & @@ -1944,6 +2006,8 @@ subroutine EmisSet(indate) ! emission re-set every time-step/hour ! Add up emissions in ktonne totemadd(itot) = totemadd(itot) + s * dtgrid * xmd(i,j) + if(USES%LocalFractions) call add_lf_emis(s,i,j,iem,isec,iland) + ! Assign to height levels 1-KEMISTOP do k=KEMISTOP,KMAX_MID gridrcemis(iqrc,k,i,j) = gridrcemis(iqrc,k,i,j) & diff --git a/ExternalBICs_mod.f90 b/ExternalBICs_mod.f90 index 8fa523a..36a0d73 100644 --- a/ExternalBICs_mod.f90 +++ b/ExternalBICs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/FastJ_mod.f90 b/FastJ_mod.f90 index 592db25..0f38d5b 100644 --- a/FastJ_mod.f90 +++ b/FastJ_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/ForestFire_mod.f90 b/ForestFire_mod.f90 index c938cf2..f972cde 100644 --- a/ForestFire_mod.f90 +++ b/ForestFire_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -208,6 +208,7 @@ subroutine Config_Fire() integer :: ios, ne, n, k character(len=*), parameter :: dtxt='BB:Config' + if(.not.first_call) return if(DEBUG%FORESTFIRE.and.MasterProc) write(*,*) dtxt//" selects ",BBMAP select case(BBMAP) @@ -339,6 +340,7 @@ subroutine Fire_Emis(daynumber) real :: rdemis(LIMAX,LJMAX) ! Emissions read from file integer :: i,j,nstart, alloc_err, iBB, n logical, save :: first_call = .true. + logical :: was_first_call integer, save :: nn_old=-1 real :: fac, to_kgm2s @@ -353,7 +355,16 @@ subroutine Fire_Emis(daynumber) integer :: yyyy, mm, dd, hh character(len=*), parameter :: dtxt='BB:Fire_Emis:' - if(first_call) call Config_Fire() + ! copy current flag: + was_first_call = first_call + ! first? + if( first_call ) then + ! allocate arrays etc: + call Config_Fire() + ! reset flag: + first_call = .false. + end if ! first + debug_me=DEBUG%FORESTFIRE .and. debug_proc debug_ff=debug_level(BBverbose) debug_nc=debug_level(BBverbose-1) @@ -419,7 +430,7 @@ subroutine Fire_Emis(daynumber) if(debug_me) then write(*,'(a,5i5)') dtxt// "newFFrec WAS set ", yyyy,mm,dd, dn1, dn2 write(*,*) dtxt//'Starting MODE=',trim(BBMODE),& - date2string(" YYYY-MM-DD",[yyyy,mm,dd]),first_call,debug_ff,debug_nc + date2string(" YYYY-MM-DD",[yyyy,mm,dd]),was_first_call,debug_ff,debug_nc write(*,*) dtxt//' Interp= ', trim(bbinterp), dn1, dn2, nstart end if @@ -507,13 +518,13 @@ subroutine Fire_Emis(daynumber) species(iemep)%molwt, sum( BiomassBurningEmis(ind,:,:) ) call PrintLog(dtxt//":: Assigns "//trim(FF_poll),& - first_call.and.MasterProc) + was_first_call.and.MasterProc) if(debug_me) sum_emis(ind)=sum_emis(ind)+& sum(BiomassBurningEmis(ind,:,:)) else ! BBfound false call PrintLog(dtxt//":: Skips "//trim(FF_poll),& - first_call.and.MasterProc) + was_first_call.and.MasterProc) end if ! BBfound end do ! BB_DEFS @@ -521,8 +532,6 @@ subroutine Fire_Emis(daynumber) call CheckNC(nf90_close(ncFileID),dtxt//"close:"//trim(fname)) ncFileID=closedID - first_call = .false. - ! For cases where REMPPM25 s derived as the difference between PM25 and ! (BC+1.7*OC) we need some safety: diff --git a/Functions_mod.f90 b/Functions_mod.f90 index 99c0c2f..7b8825f 100644 --- a/Functions_mod.f90 +++ b/Functions_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/GasParticleCoeffs_mod.f90 b/GasParticleCoeffs_mod.f90 index 8072e77..2590de5 100644 --- a/GasParticleCoeffs_mod.f90 +++ b/GasParticleCoeffs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Gravset_mod.f90 b/Gravset_mod.f90 index 90c4f80..7bde1b6 100644 --- a/Gravset_mod.f90 +++ b/Gravset_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/GridValues_mod.f90 b/GridValues_mod.f90 index 20a230d..d6f07ec 100644 --- a/GridValues_mod.f90 +++ b/GridValues_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -41,12 +41,12 @@ Module GridValues_mod !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC use CheckStop_mod, only: CheckStop,StopAll,check=>CheckNC -use Functions_mod, only: great_circle_distance +use Functions_mod, only: great_circle_distance, StandardAtmos_km_2_kPa use Io_Nums_mod, only: IO_LOG,IO_TMP use MetFields_mod use Config_module, only: & KMAX_BND, KMAX_MID, & ! vertical extent - MasterProc,NPROC,IIFULLDOM,JJFULLDOM,RUNDOMAIN, JUMPOVER29FEB,& + MasterProc,NPROC,IIFULLDOM,JJFULLDOM,RUNDOMAIN, JUMPOVER29FEB,NPROCX,NPROCY,& PT,Pref,NMET,MANUAL_GRID,& startdate,NPROCX,NPROCY,Vertical_levelsFile,& EUROPEAN_settings, GLOBAL_settings,USES,FORCE_PFT_MAPS_FALSE @@ -111,6 +111,8 @@ Module GridValues_mod public :: remake_vertical_levels_interpolation_coeff public :: Read_KMAX +public :: z2level_stdatm + private :: Alloc_GridFields private :: GetFullDomainSize private :: find_poles @@ -3056,7 +3058,7 @@ subroutine set_EuropeanAndGlobal_Config() implicit none real:: x1,x2,x3,x4,y1,y2,y3,y4,lon,lat,ir,jr character(len=*), parameter :: dtxt='EurGlobSettings:' - + integer :: EastProc if(EUROPEAN_settings == 'NOTSET')then !No value set in config input, use grid to see if it covers Europe !Test approximatively if any European country is included in rundomain @@ -3069,11 +3071,9 @@ subroutine set_EuropeanAndGlobal_Config() EUROPEAN_settings = 'YES' else - ! define middle point of middle subdomain - if(me==NPROC/2)then - lon = glon(limax/2,ljmax/2) - lat = glat(limax/2,ljmax/2) - endif + ! define middle point of middle subdomain (only values from me=NPROC/2 will be used) + lon = glon(limax/2,ljmax/2) + lat = glat(limax/2,ljmax/2) CALL MPI_BCAST(lon,8,MPI_BYTE,NPROC/2,MPI_COMM_CALC,IERROR) CALL MPI_BCAST(lat,8,MPI_BYTE,NPROC/2,MPI_COMM_CALC,IERROR) @@ -3102,20 +3102,32 @@ subroutine set_EuropeanAndGlobal_Config() GLOBAL_settings = 'YES' !default if(MasterProc)write(*,*)dtxt//'Assuming GLOBAL_settings because rundomain extends below 19 degrees latitudes' else - !find if the point with lon = -40 and lat = 45 is within the domain - call lb2ij(-40.0,45.0,ir,jr) - if(ir>=RUNDOMAIN(1).and.ir<=RUNDOMAIN(2).and.jr>=RUNDOMAIN(3).and.jr<=RUNDOMAIN(4))then - GLOBAL_settings = 'YES' !default - if(MasterProc)write(*,*)dtxt//'Assuming GLOBAL_settings because rundomain contains lon=-40 at lat=45' - else - !find if the point with lon = 92 and lat = 45 is within the domain - call lb2ij(92.0,45.0,ir,jr) + !test the Eastern point at approximatively middle in the Y direction + EastProc = NPROCY/2 *NPROCX+NPROCX-1 + lon = glon(li1,ljmax/2) + lat = glat(li1,ljmax/2) + CALL MPI_BCAST(lon,8,MPI_BYTE,EastProc,MPI_COMM_CALC,IERROR) + CALL MPI_BCAST(lat,8,MPI_BYTE,EastProc,MPI_COMM_CALC,IERROR) + x1=-32;x2=90;x3=x2;x4=x1;y1=30;y2=y1;y3=70;y4=y3 + if(.not. inside_1234(x1,x2,x3,x4,y1,y2,y3,y4,lon,lat) )then + GLOBAL_settings = 'YES' + if(MasterProc)write(*,18) dtxt//'assuming GLOBAL_settings: lon lat ',lon,lat,' outside Europe' + else + !find if the point with lon = -40 and lat = 45 is within the domain + call lb2ij(-40.0,45.0,ir,jr) if(ir>=RUNDOMAIN(1).and.ir<=RUNDOMAIN(2).and.jr>=RUNDOMAIN(3).and.jr<=RUNDOMAIN(4))then GLOBAL_settings = 'YES' !default - if(MasterProc)write(*,*)dtxt//'Assuming GLOBAL_settings because rundomain contains lon=92 at lat=45' - else - if(MasterProc)write(*,*)dtxt//'Not assuming GLOBAL_settings' - endif + if(MasterProc)write(*,*)dtxt//'Assuming GLOBAL_settings because rundomain contains lon=-40 at lat=45' + else + !find if the point with lon = 92 and lat = 45 is within the domain + call lb2ij(92.0,45.0,ir,jr) + if(ir>=RUNDOMAIN(1).and.ir<=RUNDOMAIN(2).and.jr>=RUNDOMAIN(3).and.jr<=RUNDOMAIN(4))then + GLOBAL_settings = 'YES' !default + if(MasterProc)write(*,*)dtxt//'Assuming GLOBAL_settings because rundomain contains lon=92 at lat=45' + else + if(MasterProc)write(*,*)dtxt//'Not assuming GLOBAL_settings' + endif + endif endif endif endif @@ -3171,4 +3183,30 @@ subroutine set_EuropeanAndGlobal_Config() end subroutine set_EuropeanAndGlobal_Config +subroutine z2level_stdatm(z, z_topo, lev) + !convert height z in meters to the corresponding level + !uses meteo topology file to find model height of surface + !assumes standard atmosphere for converting between meter height and pressure + !returns lowest level for all heights below top of lowest level. + real, intent(in) :: z, z_topo + integer, intent(out) :: lev + + integer :: k + real :: P_at_z, P + real :: Psurf_topo !surface pressure assuming standard atmosphere and altitude given by topo + Psurf_topo = StandardAtmos_km_2_kPa(z_topo/1000.0)*1000.0 + P_at_z = StandardAtmos_km_2_kPa(z/1000.0)*1000.0 + + !loop through levels until correct pressure is found, starting at top + lev = KMAX_MID + do k = 1, KMAX_MID + P=A_bnd(k)+Psurf_topo*B_bnd(k) + if(P>P_at_z)then + !we are above top of layer k + lev = k + exit + endif + enddo +end subroutine z2level_stdatm + end module GridValues_mod diff --git a/InterpolationRoutines_mod.f90 b/InterpolationRoutines_mod.f90 index ee232a9..214b08b 100644 --- a/InterpolationRoutines_mod.f90 +++ b/InterpolationRoutines_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Io_Progs_mod.f90 b/Io_Progs_mod.f90 index 23c6045..74e4485 100644 --- a/Io_Progs_mod.f90 +++ b/Io_Progs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/LandDefs_mod.f90 b/LandDefs_mod.f90 index 1a86f63..a633dba 100644 --- a/LandDefs_mod.f90 +++ b/LandDefs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/LandPFT_mod.f90 b/LandPFT_mod.f90 index 92ac585..f641448 100644 --- a/LandPFT_mod.f90 +++ b/LandPFT_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Landuse_mod.f90 b/Landuse_mod.f90 index 62a3f48..99fa5ea 100644 --- a/Landuse_mod.f90 +++ b/Landuse_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/LocalFractions_mod.f90 b/LocalFractions_mod.f90 new file mode 100644 index 0000000..b0c0813 --- /dev/null +++ b/LocalFractions_mod.f90 @@ -0,0 +1,1722 @@ +! +!*****************************************************************************! +!* +!* Copyright (C) 2007-2020 met.no +!* +!* Contact information: +!* Norwegian Meteorological Institute +!* Box 43 Blindern +!* 0313 OSLO +!* NORWAY +!* email: emep.mscw@met.no +!* http://www.emep.int +!* +!* This program is free software: you can redistribute it and/or modify +!* it under the terms of the GNU General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* This program 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 +!* GNU General Public License for more details. +!* +!* You should have received a copy of the GNU General Public License +!* along with this program. If not, see . +!*****************************************************************************! +module LocalFractions_mod +! +! all subroutines for Local Fractions +! +use CheckStop_mod, only: CheckStop,StopAll +use Chemfields_mod, only: xn_adv, cfac +use ChemDims_mod, only: NSPEC_ADV, NSPEC_SHL,NEMIS_File +use ChemSpecs_mod, only: species_adv,species +use Config_module, only: KMAX_MID, KMAX_BND,USES, uEMEP, lf_src, IOU_HOUR& + , IOU_HOUR_INST,IOU_INST,IOU_YEAR,IOU_MON,IOU_DAY& + ,IOU_HOUR,IOU_HOUR_INST, IOU_MAX_MAX & + ,MasterProc,dt_advec, RUNDOMAIN, runlabel1 & + ,HOURLYFILE_ending, MAXSRC, Max_Country_list, Max_Country_sectors & + ,lf_country_group, Max_Country_groups& + ,lf_country_sector_list,lf_country_list +use Country_mod, only: MAXNLAND,NLAND,Country& + ,IC_TMT,IC_TM,IC_TME,IC_ASM,IC_ASE,IC_ARE,IC_ARL,IC_CAS,IC_UZT,IC_UZ& + ,IC_UZE,IC_KZT,IC_KZ,IC_KZE,IC_RU,IC_RFE,IC_RUX,IC_RUE,IC_AST + +use DefPhotolysis_mod, only: IDNO2 +use EmisDef_mod, only: lf, emis_lf, lf_emis_tot, emis_lf_cntry, loc_frac_src_1d,& + lf_src_acc,lf_src_tot,lf_src_full,loc_tot_full, NSECTORS,EMIS_FILE, & + loc_frac_drydep, loc_frac_wetdep, & + nlandcode,landcode,sec2hfac_map, sec2split_map,& + ISNAP_DOM,secemis, roaddust_emis_pot,KEMISTOP,& + NEmis_sources, Emis_source_2D, Emis_source +use EmisGet_mod, only: nrcemis, iqrc2itot, emis_nsplit,nemis_kprofile, emis_kprofile,& + make_iland_for_time,itot2iqrc,iqrc2iem, emisfrac +use GridValues_mod, only: dA,dB,xm2, dhs1i, glat, glon, projection, extendarea_N,i_fdom,j_fdom +use MetFields_mod, only: ps,roa,EtaKz +use MPI_Groups_mod +use NetCDF_mod, only: Real4,Out_netCDF,LF_ncFileID_iou +use OwnDataTypes_mod, only: Deriv, Npoll_lf_max, Nsector_lf_max, MAX_lf_country_group_size, & + TXTLEN_NAME, TXTLEN_FILE +use Par_mod, only: me,LIMAX,LJMAX,MAXLIMAX,MAXLJMAX,gi0,gj0,li0,li1,lj0,lj1,GIMAX,GJMAX +use PhysicalConstants_mod, only : GRAV, ATWAIR +use SmallUtils_mod, only: find_index +!use Chemsolver_mod, only: Dchem +use TimeDate_mod, only: date, current_date,day_of_week +use TimeDate_ExtraUtil_mod,only: date2string +use My_Timing_mod, only: Add_2timing, Code_timer, NTIMING +use ZchemData_mod,only: rct, rcphot, xn_2d, rcemis + +!(dx,dy,i,j) shows contribution of pollutants from (i+dx,j+dy) to (i,j) + +implicit none +!external advection_mod_mp_vertdiffn_k + +private + +integer ::IC_AST_EXTRA = 324567,IC_RUT_EXTRA = 324568 !sum of countries which are not defined as countries +integer ::IC_BIC_EXTRA = 324569 + +public :: lf_init +public :: lf_out +public :: lf_av +public :: lf_adv_x +public :: lf_adv_y +public :: lf_adv_k +public :: lf_diff +public :: lf_chem +public :: lf_aero_pre, lf_aero_pos +public :: lf_drydep, lf_wetdep +public :: lf_emis +public :: add_lf_emis + +real, allocatable, save ::loc_poll_to(:,:,:,:,:) + +logical, public, save :: COMPUTE_LOCAL_TRANSPORT=.false. +integer , private, save :: lf_Nvertout = 1!number of vertical levels to save in output +integer, public, save :: NTIMING_lf=9 +real, private :: tim_after,tim_before +integer, public, save :: Ndiv_coarse=1, Ndiv_rel=1, Ndiv2_coarse=1 +integer, public, save :: Nsources=0 +integer, public, save :: lf_Nvert=0 + + +integer, public, save :: LF_SRC_TOTSIZE +integer, public, save :: iotyp2ix(IOU_MAX_MAX) +integer, public, save :: av_fac(IOU_MAX_MAX) +integer, public, save :: Niou_ix = 0 ! number of time periods to consider (hourly, monthly, full ...) +integer, public, save :: Npoll = 0 !Number of different pollutants to consider +integer, private, parameter :: MAXIPOLL=16 +integer, public, save :: iem2ipoll(NEMIS_File,MAXIPOLL) !internal indices of pollutants for that emis file +integer, public, save :: ipoll2iqrc(MAXIPOLL)=-1 !-1 for primary pollutant +integer, private, save :: iem2Nipoll(NEMIS_File) !number of pollutants for that emis file +logical :: old_format=.false. !temporary, use old format for input and output +integer, private, save :: isrc_O3=-1, isrc_NO=-1, isrc_NO2=-1, isrc_VOC=-1 +integer, private, save :: isrc_SO2=-1, isrc_SO4=-1, isrc_NH4=-1, isrc_NH3=-1 +integer, private, save :: ix_O3=-1, ix_NO2=-1, ix_NO=-1, ix_CH3CO3=-1, ix_HO2=-1 +integer, private, save :: ix_SO4=-1, ix_SO2=-1, ix_H2O2=-1, ix_OH=-1 +integer, private, save :: ix_NH4=-1, ix_NH3=-1 +integer, private, save :: ix_NO3=-1, ix_HNO3=-1 +integer, private, save :: isrc_EC_f_ffuel_new=-1, isrc_EC_f_ffuel_age=-1, isrc_EC_f_wood_new=-1, isrc_EC_f_wood_age=-1 +integer, private, save :: isrc_EC_f_new=-1, isrc_EC_f_age=-1 +integer, private, save :: ix_EC_f_ffuel_new=-1, ix_EC_f_ffuel_age=-1 +integer, private, save :: ix_EC_f_new=-1, ix_EC_f_age=-1 +integer, private, save :: ix_EC_f_wood_new=-1, ix_EC_f_wood_age=-1 +real, allocatable, private, save :: lf_NH4(:), lf_NH3(:) +integer, private, save :: country_ix_list(Max_Country_list) +integer, private, save :: Ncountry_lf=0 +integer, private, save :: Ncountry_group_lf=0 +integer, private, save :: Ncountrysectors_lf=0 +integer, private, save :: Ndrydep_lf=0 +integer, private, save :: Nwetdep_lf=0 + +contains + + subroutine lf_init + integer :: i, ic, ix, itot, iqrc, iem, iemis, isec, ipoll, ixnh3, ixnh4, size, IOU_ix, isrc + integer :: found + character(len=TXTLEN_NAME) :: iem2names(NEMIS_File,MAXIPOLL) !name of that pollutant + + call Code_timer(tim_before) + ix=0 + if(USES%uEMEP)then + !Temporary: we keep compatibilty with lf input + old_format=.true. + lf_src(:)%dist = uEMEP%dist !Temporary + lf_src(:)%Nvert = uEMEP%Nvert !Temporary + do i=1,4 + lf_src(:)%DOMAIN(i) = uEMEP%DOMAIN(i) !Temporary + if(lf_src(1)%DOMAIN(i)<0)lf_src(:)%DOMAIN(i) = RUNDOMAIN(i) + if(me==0)write(*,*)i,' DOMAIN ',lf_src(1)%DOMAIN(i) + enddo + lf_src(:)%YEAR=uEMEP%YEAR + lf_src(:)%MONTH=uEMEP%MONTH + lf_src(:)%MONTH_ENDING=uEMEP%MONTH_ENDING + lf_src(:)%DAY=uEMEP%DAY + lf_src(:)%HOUR=uEMEP%HOUR + lf_src(:)%HOUR_INST=uEMEP%HOUR_INST + do isrc=1,Npoll_lf_max + if(uEMEP%poll(isrc)%emis=='none')then + call CheckStop(isrc==1,"init_uEMEP: no pollutant specified") + exit + else + do isec=1,Nsector_lf_max + if(uEMEP%poll(isrc)%sector(isec)<0)then + call CheckStop(isec==0,"init_uEMEP: nosector specified for "//uEMEP%poll(isrc)%emis) + exit + else + ix=ix+1 + lf_src(ix)%species = uEMEP%poll(isrc)%emis + lf_src(ix)%sector = uEMEP%poll(isrc)%sector(isec) + endif + enddo + endif + enddo + else + !separate value do not work properly yet + lf_src(:)%dist = lf_src(1)%dist !Temporary + do i=1,4 + lf_src(:)%DOMAIN(i) = lf_src(1)%DOMAIN(i) !Temporary + enddo + lf_src(:)%YEAR=lf_src(1)%YEAR + lf_src(:)%MONTH=lf_src(1)%MONTH + lf_src(:)%MONTH_ENDING=lf_src(1)%MONTH_ENDING + lf_src(:)%DAY=lf_src(1)%DAY + lf_src(:)%HOUR=lf_src(1)%HOUR + lf_src(:)%HOUR_INST=lf_src(1)%HOUR_INST + endif + + lf_Nvert = lf_src(1)%Nvert !Temporary + Nsources = 0 + do i = 1, MAXSRC + if(lf_src(i)%species /= 'NONE') Nsources = Nsources + 1 + enddo + + ipoll=0 + iem2ipoll = -1 + iem2Nipoll = 0 + do isrc = 1, Nsources + !for now only one Ndiv possible for all sources + if(lf_src(isrc)%type == 'relative')then + lf_src(isrc)%Npos = (2*lf_src(isrc)%dist+1)*(2*lf_src(isrc)%dist+1) + Ndiv_rel = max(Ndiv_rel,2*lf_src(isrc)%dist+1) + endif + if(lf_src(isrc)%type == 'coarse')then + Ndiv_coarse = max(Ndiv_coarse,2*lf_src(isrc)%dist+1) + lf_src(isrc)%Npos = (2*lf_src(isrc)%dist+1)*(2*lf_src(isrc)%dist+1) + Ndiv2_coarse = max(Ndiv2_coarse,Ndiv_coarse*Ndiv_coarse) + endif + if(lf_src(isrc)%type == 'country')then + if(lf_country_list(1)/= 'NOTSET' .or. lf_country_group(1)%name/= 'NOTSET')then + !list of countries/sectors instead of single country + Ncountry_lf=0 + do i = 1, Max_Country_list + if(lf_country_list(i) == 'NOTSET') exit + Ncountry_lf=Ncountry_lf+1 + ix = find_index(trim(lf_country_list(i)) ,Country(:)%code, first_only=.true.) + if(ix<0 .and. lf_country_list(i) =='AST')then + ix = IC_AST_EXTRA + else if(ix<0 .and. lf_country_list(i) =='RUT')then + ix = IC_RUT_EXTRA + else if(ix<0 .and. lf_country_list(i) =='BIC')then + ix = IC_BIC_EXTRA + endif + call CheckStop(ix<0,'country '//trim(lf_country_list(i))//' not defined. ') + country_ix_list(i) = ix + if(MasterProc)write(*,*)'include '//trim(lf_src(isrc)%species)//' from ',trim(lf_country_list(i)) + enddo + Ncountry_group_lf=0 + do i = 1, Max_Country_groups + if(lf_country_group(i)%name == 'NOTSET') exit + Ncountry_group_lf = Ncountry_group_lf+1 + do ic = 1, MAX_lf_country_group_size + if(lf_country_group(i)%list(ic) == 'NOTSET') exit + + ix = find_index(trim(lf_country_group(i)%list(ic)) ,Country(:)%code, first_only=.true.) + if(ix<0 .and. lf_country_list(i) =='AST')then + ix = IC_AST_EXTRA + else if(ix<0 .and. lf_country_list(i) =='RUT')then + ix = IC_RUT_EXTRA + else if(ix<0 .and. lf_country_list(i) =='BIC')then + ix = IC_BIC_EXTRA + endif + call CheckStop(ix<0,'country '//trim(lf_country_group(i)%list(ic))//' not defined. ') + lf_country_group(i)%ix(ic) = ix + if(MasterProc)write(*,*)'include '//trim(lf_src(isrc)%species)//' from '//& + trim(lf_country_group(i)%list(ic))//' as '//trim(lf_country_group(i)%name) + enddo + enddo + Ncountrysectors_lf=0 + do i = 1, Max_Country_sectors + if(lf_country_sector_list(i) < 0) exit + Ncountrysectors_lf=Ncountrysectors_lf+1 + if(MasterProc)write(*,*)'country sector ',lf_country_sector_list(i) + enddo + lf_src(isrc)%Npos = (Ncountry_lf+Ncountry_group_lf)*Ncountrysectors_lf + if(MasterProc)write(*,*)lf_src(isrc)%Npos,' countries x sectors' + else + lf_src(isrc)%Npos = 1 + ix = find_index(trim(lf_src(isrc)%country_ISO) ,Country(:)%code, first_only=.true.) + call CheckStop(ix<0,'country '//trim(lf_src(isrc)%country_ISO)//' not defined. ') + lf_src(isrc)%country_ix = ix + lf_src(isrc)%Npos = 1 + endif + endif + if(lf_src(isrc)%country_ISO /= 'NOTSET')then + lf_src(isrc)%type = 'country' + ix = find_index(trim(lf_src(isrc)%country_ISO) ,Country(:)%code, first_only=.true.) + if(ix<0)then + if(me==0)write(*,*)'LF: WARNING: country '//trim(lf_src(isrc)%country_ISO)//' not defined. ' + endif + lf_src(isrc)%country_ix = ix + if(MasterProc)write(*,*)isrc,' country '//trim(lf_src(isrc)%country_ISO)//' '//trim(lf_src(isrc)%species) + endif + + do i=1,4 + lf_src(isrc)%DOMAIN(i) = max(RUNDOMAIN(i),lf_src(isrc)%DOMAIN(i)) + enddo + + iem=find_index(lf_src(isrc)%species ,EMIS_FILE(1:NEMIS_FILE)) + if(iem<1)then + !defined as single species (NO, NO2, O3..) + lf_src(isrc)%Nsplit = 1 + ix=find_index(lf_src(isrc)%species ,species(:)%name) + if(ix<0)then + ix=find_index(lf_src(isrc)%species ,species(:)%name, any_case=.true.) !NB: index among all species also short lived + if(me==0 .and. ix>0)then + write(*,*)'WARNING: '//trim(lf_src(isrc)%species)//' not found, replacing with '//trim(species(ix)%name) + lf_src(isrc)%species=trim(species(ix)%name) + endif + endif + call CheckStop( ix<1, "Local Fractions did not find corresponding pollutant: "//trim(lf_src(isrc)%species) ) + iem=-1 + lf_src(isrc)%species_ix = ix !NB: index among all species + lf_src(isrc)%ix(1) = ix - NSPEC_SHL !NB: index among advected species + lf_src(isrc)%mw(1) = species_adv(lf_src(isrc)%ix(1))%molwt + lf_src(isrc)%iqrc = itot2iqrc(ix) !negative if not among emitted species + if(lf_src(isrc)%iqrc>0) iem = iqrc2iem(lf_src(isrc)%iqrc) + lf_src(isrc)%iem = iem + if(trim(species(ix)%name)=='O3')isrc_O3=isrc + if(trim(species(ix)%name)=='NO')isrc_NO=isrc + if(trim(species(ix)%name)=='NO2')isrc_NO2=isrc + if(trim(species(ix)%name)=='O3')ix_O3=lf_src(isrc)%ix(1)!shortcut + if(trim(species(ix)%name)=='NO')ix_NO=lf_src(isrc)%ix(1)!shortcut + if(trim(species(ix)%name)=='NO2')ix_NO2=lf_src(isrc)%ix(1)!shortcut + if(trim(species(ix)%name)=='SO4')isrc_SO4=isrc + if(trim(species(ix)%name)=='SO2')isrc_SO2=isrc + if(trim(species(ix)%name)=='SO4')ix_SO4=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='SO2')ix_SO2=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='NH4_f')isrc_NH4=isrc + if(trim(species(ix)%name)=='NH3')isrc_NH3=isrc + if(trim(species(ix)%name)=='NH4_f')ix_NH4=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='NH3')ix_NH3=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_new')isrc_EC_f_ffuel_new=isrc + if(trim(species(ix)%name)=='EC_f_new')ix_EC_f_ffuel_new=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_age')isrc_EC_f_ffuel_age=isrc + if(trim(species(ix)%name)=='EC_f_age')ix_EC_f_ffuel_age=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_ffuel_new')isrc_EC_f_ffuel_new=isrc + if(trim(species(ix)%name)=='EC_f_ffuel_new')ix_EC_f_ffuel_new=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_ffuel_age')isrc_EC_f_ffuel_age=isrc + if(trim(species(ix)%name)=='EC_f_ffuel_age')ix_EC_f_ffuel_age=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_wood_new')isrc_EC_f_wood_new=isrc + if(trim(species(ix)%name)=='EC_f_wood_new')ix_EC_f_wood_new=lf_src(isrc)%ix(1) + if(trim(species(ix)%name)=='EC_f_wood_age')isrc_EC_f_wood_age=isrc + if(trim(species(ix)%name)=='EC_f_wood_age')ix_EC_f_wood_age=lf_src(isrc)%ix(1) + else + !species defines as primary emitted + lf_src(isrc)%iem = iem + lf_src(isrc)%Nsplit=emis_nsplit(iem) + do i=1,lf_src(isrc)%Nsplit + iqrc=sum(emis_nsplit(1:iem-1)) + i + itot=iqrc2itot(iqrc) + ix=itot-NSPEC_SHL + lf_src(isrc)%ix(i)=ix + lf_src(isrc)%mw(i)=species_adv(ix)%molwt +! if(lf_src(isrc)%species=="pm25")then +! ix=find_index('EC_f_ffuel_new', species(:)%name) +! call CheckStop( ix<1, "Local Fractions did not find ") +! ix_EC_f_ffuel_new = ix - NSPEC_SHL!shortcut +! ix=find_index('EC_f_ffuel_age', species(:)%name) +! call CheckStop( ix<1, "Local Fractions did not find ") +! ix_EC_f_ffuel_age = ix - NSPEC_SHL!shortcut +! ix=find_index('isrc_EC_f_wood_new', species(:)%name) +! call CheckStop( ix<1, "Local Fractions did not find ") +! ix_isrc_EC_f_wood_new = ix - NSPEC_SHL!shortcut +! ix=find_index('isrc_EC_f_wood_age', species(:)%name) +! call CheckStop( ix<1, "Local Fractions did not find ") +! ix_isrc_EC_f_wood_age = ix - NSPEC_SHL!shortcut +! endif + if(lf_src(isrc)%species=="voc")then + isrc_VOC = isrc + ix=find_index('CH3CO3', species(:)%name) + call CheckStop( ix<1, "Local Fractions did not find CH3CO3 ") + ix_CH3CO3 = ix - NSPEC_SHL!shortcut + ix=find_index('HO2', species(:)%name) + call CheckStop( ix<1, "Local Fractions did not find HO2 ") + ix_HO2= ix!shortcut !NB: index as short lived + endif + if(lf_src(isrc)%species=="nox")then + ix=find_index("NO2",species_adv(:)%name) + call CheckStop(ix<0,'Index for NO2 not found') + lf_src(isrc)%mw(i)=species_adv(ix)%molwt + endif + if(lf_src(isrc)%species=="sox")then + ix=find_index("SO2",species_adv(:)%name) + call CheckStop(ix<0,'Index for SO2 not found') + lf_src(isrc)%mw(i)=species_adv(ix)%molwt + endif + if(lf_src(isrc)%species=="nox" .and. (lf_src(isrc)%DryDep .or. lf_src(isrc)%WetDep))then + ix=find_index("NO3",species_adv(:)%name) + call CheckStop(ix<0,'Index for NO3 not found') + ix_NO3=ix + ix=find_index("HNO3",species_adv(:)%name) + call CheckStop(ix<0,'Index for HNO3 not found') + ix_HNO3=ix + endif + + if(lf_src(isrc)%species=="nh3")then + lf_src(isrc)%Nsplit = 0 + ixnh4=find_index("NH4_F",species_adv(:)%name , any_case=.true.) + ixnh3=find_index("NH3",species_adv(:)%name) + do ix=1,NSPEC_ADV + if(ix/=ixnh4.and.ix/=ixnh3)cycle!not reduced nitrogen + if(species_adv(ix)%nitrogens>0)then + lf_src(isrc)%Nsplit = lf_src(isrc)%Nsplit + 1 + lf_src(isrc)%ix(lf_src(isrc)%Nsplit) = ix + lf_src(isrc)%mw(lf_src(isrc)%Nsplit) = species_adv(ixnh3)%molwt !use NH3 mw also for NH4 + endif + enddo + endif + end do + + endif + if(ix_SO2>0)then + !need some more indices + ix_O3=find_index('O3' ,species(:)%name, any_case=.true.) - NSPEC_SHL !NB: index among advected species + ix_OH=find_index('OH' ,species(:)%name, any_case=.true.) !NB: index among all species + ix_H2O2=find_index('H2O2' ,species(:)%name, any_case=.true.) !NB: index among all species + endif + if(iem>0)then + !emitted species + found=0 + do i=1,iem2Nipoll(iem) + if(iem2names(iem,i)==lf_src(isrc)%species)then + found=1 + lf_src(isrc)%poll = iem2ipoll(iem,i) + endif + enddo + if(found==0)then + !add a new pollutant for that emis file + iem2Nipoll(iem)=iem2Nipoll(iem)+1 + ipoll = ipoll + 1 + call CheckStop(ipoll>MAXIPOLL,"Error: increase MAXIPOLL in LocalFractions_mod") + iem2names(iem, iem2Nipoll(iem)) = trim(lf_src(isrc)%species) + iem2ipoll(iem, iem2Nipoll(iem)) = ipoll + lf_src(isrc)%poll = ipoll + Npoll = ipoll + endif + if(lf_src(isrc)%iqrc>0)ipoll2iqrc(lf_src(isrc)%poll)=lf_src(isrc)%iqrc!single species + else + !single species not emitted (like O3) + ipoll = ipoll + 1 + lf_src(isrc)%poll = ipoll + Npoll = ipoll + call CheckStop(ipoll>MAXIPOLL,"Error: increase MAXIPOLL in LocalFractions_mod") + endif + + if(MasterProc)then + if(lf_src(isrc)%iem>0)then + write(*,*)'lf pollutant : ',lf_src(isrc)%species,' ref index ',lf_src(isrc)%poll,' emitted as ',EMIS_FILE(lf_src(isrc)%iem) + else + write(*,*)'lf pollutant : ',lf_src(isrc)%species,' ref index ',lf_src(isrc)%poll,' not treated as emitted species' + endif + write(*,*)'lf number of species in '//trim(lf_src(isrc)%species)//' group: ',lf_src(isrc)%Nsplit + write(*,"(A,30(A,F6.2))")'including:',('; '//trim(species_adv(lf_src(isrc)%ix(i))%name)//', mw ',lf_src(isrc)%mw(i),i=1,lf_src(isrc)%Nsplit) + write(*,"(A,30I4)")'sector:',lf_src(isrc)%sector + !write(*,"(A,30I4)")'ix:',(lf_src(isrc)%ix(i),i=1,lf_src(isrc)%Nsplit) + end if + end do + if(isrc_O3>0 .and. (isrc_NO2<0 .or. isrc_NO<0))then + if(me==0)write(*,*)'WARNING: O3 tracking requires NO2 and NO' + stop!may be relaxed in future + endif + if(isrc_SO2>0 .and. (isrc_SO4<0))then + if(me==0)write(*,*)'WARNING: SO2 tracking requires SO4' + stop!may be relaxed in future + endif + + av_fac=0.0 + + Ndrydep_lf=0 + Nwetdep_lf=0 + LF_SRC_TOTSIZE = 0 + do isrc = 1, Nsources + if(lf_src(isrc)%drydep) Ndrydep_lf = Ndrydep_lf + lf_src(isrc)%Npos + if(lf_src(isrc)%wetdep) Nwetdep_lf = Nwetdep_lf + lf_src(isrc)%Npos + lf_src(isrc)%start = LF_SRC_TOTSIZE + 1 + lf_src(isrc)%end = LF_SRC_TOTSIZE + lf_src(isrc)%Npos + LF_SRC_TOTSIZE = LF_SRC_TOTSIZE + lf_src(isrc)%Npos + if(me==0)then + write(*,*)isrc,' ',trim(lf_src(isrc)%species)," start ",lf_src(isrc)%start," end ",lf_src(isrc)%end,LF_SRC_TOTSIZE + endif + enddo + + allocate(lf(LF_SRC_TOTSIZE,LIMAX,LJMAX,KMAX_MID-lf_Nvert+1:KMAX_MID)) + lf=0.0 + + isrc=1!for now all must be the same + if(lf_src(isrc)%HOUR)then + Niou_ix = Niou_ix + 1 + iotyp2ix(IOU_HOUR)=Niou_ix + endif + if(lf_src(isrc)%HOUR_INST)then + !Niou_ix = Niou_ix + 1 !should not be accumulated + iotyp2ix(IOU_HOUR_inst) = -1; !should not be accumulated + endif + if(lf_src(isrc)%DAY)then + Niou_ix = Niou_ix + 1 + iotyp2ix(IOU_DAY)=Niou_ix + endif + if(lf_src(isrc)%MONTH)then + Niou_ix = Niou_ix + 1 + iotyp2ix(IOU_MON)=Niou_ix + endif + if(lf_src(isrc)%YEAR)then + Niou_ix = Niou_ix + 1 + iotyp2ix(IOU_YEAR)=Niou_ix + endif + + if(isrc_NH4>0)then + allocate(lf_NH4(KMAX_MID-lf_Nvert+1:KMAX_MID)) + allocate(lf_NH3(KMAX_MID-lf_Nvert+1:KMAX_MID)) + endif + + allocate(lf_src_acc(LF_SRC_TOTSIZE,LIMAX,LJMAX,KMAX_MID-lf_Nvertout+1:KMAX_MID,Niou_ix)) + lf_src_acc = 0.0 + allocate(lf_src_tot(LIMAX,LJMAX,KMAX_MID-lf_Nvertout+1:KMAX_MID,Npoll,Niou_ix)) + lf_src_tot = 0.0 + allocate(loc_frac_src_1d(LF_SRC_TOTSIZE,0:max(LIMAX,LJMAX)+1)) + loc_frac_src_1d=0.0 + allocate(emis_lf(LIMAX,LJMAX,KMAX_MID-lf_Nvert+1:KMAX_MID,Nsources)) + emis_lf = 0.0 + allocate(lf_emis_tot(LIMAX,LJMAX,KMAX_MID-lf_Nvert+1:KMAX_MID,Npoll)) + lf_emis_tot = 0.0 + if(Ncountry_lf*Ncountrysectors_lf>0)then + allocate(emis_lf_cntry(LIMAX,LJMAX,KMAX_MID-lf_Nvert+1:KMAX_MID,Ncountry_lf+Ncountry_group_lf,Ncountrysectors_lf,Nsources)) + emis_lf_cntry=0.0 + else + allocate(emis_lf_cntry(1,1,1,1,1,1))!So can be set to zero etc. without compiler complaining + endif + if(Ndrydep_lf>0)then + allocate(loc_frac_drydep(LIMAX,LJMAX,Ndrydep_lf)) + loc_frac_drydep=0.0 + else + allocate(loc_frac_drydep(1,1,1)) + endif + if(Nwetdep_lf>0)then + allocate(loc_frac_wetdep(LIMAX,LJMAX,Nwetdep_lf)) + loc_frac_wetdep=0.0 + else + allocate(loc_frac_wetdep(1,1,1)) + endif + +! call Add_2timing(NTIMING-10,tim_after,tim_before,"lf: init") negligible + +end subroutine lf_init + + +subroutine lf_out(iotyp) + integer, intent(in) :: iotyp + character(len=200) ::filename, varname + real :: xtot,scale,invtot,t1,t2 + integer ::i,j,k,n,n1,dx,dy,ix,iix,isec,iisec,isec_poll,ipoll,isec_poll1,isrc,iou_ix,iter,iddep,iwdep + integer ::ndim,kmax,CDFtype,dimSizes(10),chunksizes(10) + integer ::ndim_tot,dimSizes_tot(10),chunksizes_tot(10) + character (len=20) ::dimNames(10),dimNames_tot(10) + type(Deriv) :: def1 ! definition of fields for local fraction + type(Deriv) :: def2 ! definition of fields for totals + type(Deriv) :: def3 ! definition of dry and wet dep fields + logical ::overwrite, create_var_only + logical,save :: first_call(10)=.true. + real,allocatable ::tmp_out(:,:,:)!allocate since it may be heavy for the stack TEMPORARY + real,allocatable ::tmp_out_cntry(:,:,:)!allocate since it may be heavy for the stack TEMPORARY + type(date) :: onesecond = date(0,0,0,0,1) + character(len=TXTLEN_FILE),save :: oldhourlyname = 'NOTSET' + character(len=TXTLEN_FILE),save :: oldhourlyInstname = 'NOTSET' + character(len=TXTLEN_FILE),save :: oldmonthlyname + real :: fracsum(LIMAX,LJMAX) + logical :: pollwritten(Npoll_lf_max) + integer :: ncFileID + + call Code_timer(tim_before) + + if(iotyp==IOU_HOUR_INST .and. lf_src(1)%HOUR_INST)then + fileName = trim(runlabel1)//'_uEMEP_hourInst'//date2string(trim(HOURLYFILE_ending),current_date,-1.0) + if(oldhourlyInstname/=fileName)then + first_call(iotyp) = .true. + oldhourlyInstname = fileName + endif + else if(iotyp==IOU_HOUR .and. lf_src(1)%HOUR)then + fileName = trim(runlabel1)//'_uEMEP_hour'//date2string(trim(HOURLYFILE_ending),current_date,-1.0) + if(oldhourlyname/=fileName)then + first_call(iotyp) = .true. + oldhourlyname = fileName + endif + else if(iotyp==IOU_DAY .and. lf_src(1)%DAY)then + fileName=trim(runlabel1)//'_uEMEP_day.nc' + else if(iotyp==IOU_MON .and. lf_src(1)%MONTH)then + if(lf_src(1)%MONTH_ENDING /= "NOTSET")then + fileName=trim(runlabel1)//'_uEMEP_month'//date2string(trim(lf_src(1)%MONTH_ENDING),current_date,-1.0) + if(oldmonthlyname/=fileName)then + first_call(iotyp) = .true. + oldmonthlyname = fileName + endif + else + fileName=trim(runlabel1)//'_uEMEP_month.nc' + endif + else if(iotyp==IOU_YEAR .and. lf_src(1)%YEAR)then + fileName=trim(runlabel1)//'_uEMEP_full.nc' + else + return + endif + ncFileID=LF_ncFileID_iou(iotyp) + + ndim=5 + ndim_tot=3 + kmax=lf_Nvertout + scale=1.0 + CDFtype=Real4 + ! dimSizes(1)=uEMEP%Nsec_poll + ! dimNames(1)='sector' + dimSizes(1)=2*lf_src(1)%dist+1 + dimNames(1)='x_dist' + dimSizes(2)=2*lf_src(1)%dist+1 + dimNames(2)='y_dist' + + isrc=1!temporary + dimSizes(3)=min(GIMAX,lf_src(isrc)%DOMAIN(2)-lf_src(isrc)%DOMAIN(1)+1) + dimSizes(4)=min(GJMAX,lf_src(isrc)%DOMAIN(4)-lf_src(isrc)%DOMAIN(3)+1) + + dimSizes_tot(1)=min(GIMAX,lf_src(isrc)%DOMAIN(2)-lf_src(isrc)%DOMAIN(1)+1) + dimSizes_tot(2)=min(GJMAX,lf_src(isrc)%DOMAIN(4)-lf_src(isrc)%DOMAIN(3)+1) + + select case(projection) + case('Stereographic') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case('lon lat') + dimNames(3)='lon' + dimNames(4)='lat' + dimNames_tot(1)='lon' + dimNames_tot(2)='lat' + case('Rotated_Spherical') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case('lambert') + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + case default + dimNames(3)='i' + dimNames(4)='j' + dimNames_tot(1)='i' + dimNames_tot(2)='j' + end select + + dimSizes(5)=kmax + dimNames(5)='klevel' + dimSizes_tot(3)=kmax + dimNames_tot(3)='klevel' + def1%class='uEMEP' !written + def1%avg=.false. !not used + def1%index=0 !not used + def1%scale=1.0 !not used + def1%name=trim(varName) + def1%unit='' + def2=def1 + def2%unit='ug/m3' + def3=def1 + def3%unit='mg/m2' + chunksizes=1 + !chunksizes(1)=dimSizes(1) !slower!! + !chunksizes(2)=dimSizes(2) !slower!! + chunksizes(3)=MAXLIMAX + chunksizes(4)=MAXLJMAX + chunksizes(5)=dimSizes(5) + chunksizes_tot=1 + chunksizes_tot(1)=MAXLIMAX + chunksizes_tot(2)=MAXLJMAX + chunksizes_tot(3)=dimSizes_tot(3) + + allocate(tmp_out(max(Ndiv2_coarse,Ndiv_rel*Ndiv_rel),LIMAX,LJMAX)) !NB; assumes KMAX=1 TEMPORARY + allocate(tmp_out_cntry(LIMAX,LJMAX,(Ncountry_lf+Ncountry_group_lf)*Ncountrysectors_lf)) + + iou_ix = iotyp2ix(iotyp) + + !first loop only create all variables before writing into them (faster for NetCDF) + do iter=1,2 + if(iter==1 .and. .not. first_call(iotyp))cycle + + overwrite=.false. !only used once per file + if(iter==1)overwrite=.true.!only create all variables before writing into them + create_var_only=.false. + if(iter==1)create_var_only=.true.!only create all variables before writing into them + + pollwritten = .false. + iddep = 0 + iwdep = 0 + do isrc = 1, Nsources + isec=lf_src(isrc)%sector + ipoll=lf_src(isrc)%poll + if(.not. pollwritten(ipoll))then !one pollutant may be used for several sources + def2%name=trim(lf_src(isrc)%species) + if(iter==1 .and. me==0)write(*,*)' poll '//trim(lf_src(isrc)%species),ipoll + scale=1.0/av_fac(iotyp) + call Out_netCDF(iotyp,def2,ndim_tot,kmax,lf_src_tot(1,1,KMAX_MID-lf_Nvertout+1,ipoll,iou_ix),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes_tot,ncFileID_given=ncFileID) + pollwritten(ipoll) = .true. + overwrite=.false. + endif + + if(iter==2)then + fracsum=0.0 + tmp_out=0.0 + if(lf_src(isrc)%type == 'country')tmp_out_cntry=0.0 + do k = KMAX_MID-lf_Nvertout+1,KMAX_MID + do j=1,ljmax + do i=1,limax + invtot=1.0/(lf_src_tot(i,j,k,ipoll,iou_ix)+1.E-20) + n1=0 + if(lf_src(isrc)%type == 'country')then + invtot=1.0/av_fac(iotyp) !could also output fractions? + do n=lf_src(isrc)%start, lf_src(isrc)%end + n1=n1+1 + tmp_out_cntry(i,j,n1) = tmp_out_cntry(i,j,n1) + lf_src_acc(n,i,j,k,iou_ix)*invtot ! sum over all k + !if(tmp_out_cntry(i,j,n1)<1.e-18)tmp_out_cntry(i,j,n1)=0.0 + if(isnan(tmp_out_cntry(i,j,n1)).or. tmp_out_cntry(i,j,n1)>1.e19)then + write(*,*)'tmp_out_cntry is nan ',tmp_out_cntry(i,j,n1),lf_src_acc(n,i,j,k,iou_ix),invtot,trim(lf_src(isrc)%species) + stop + endif + enddo + else + do n=lf_src(isrc)%start, lf_src(isrc)%end + n1=n1+1 + tmp_out(n1,i,j) = tmp_out(n1,i,j) + lf_src_acc(n,i,j,k,iou_ix)*invtot ! sum over all k + fracsum(i,j)=fracsum(i,j)+lf_src_acc(n,i,j,k,iou_ix)*invtot ! sum over all n and k + enddo + endif + enddo + enddo + enddo + endif + + if(lf_src(isrc)%type == 'country')then + n1=0 + do i=1,Ncountry_lf+Ncountry_group_lf + do j=1,Ncountrysectors_lf + n1=n1+1 + !single cell source + isec=lf_country_sector_list(j) + if(i<=Ncountry_lf)then + write(def2%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_sec',isec,'_'//trim(lf_country_list(i)) + if(isec==0) write(def2%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_'//trim(lf_country_list(i)) + else + !country group + write(def2%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_sec',isec,'_'//trim(lf_country_group(i-Ncountry_lf)%name) + if(isec==0) write(def2%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_'//trim(lf_country_group(i-Ncountry_lf)%name) + endif + if(me==0 .and. iter==2)write(*,*)'writing '//trim(def2%name) + def2%unit='ug/m3' + scale=1.0 + call Out_netCDF(iotyp,def2,ndim_tot,1,tmp_out_cntry(1,1,n1),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes_tot,ncFileID_given=ncFileID) + if(lf_src(isrc)%drydep)then + write(def3%name,"(A)")'DDEP_'//trim(def2%name) + def3%unit='mg/m2' + if(isrc==isrc_SO4 .or. isrc==isrc_SO2 .or. lf_src(isrc)%species=="sox")def3%unit='mgS/m2' + if(isrc==isrc_NH3 .or. isrc==isrc_NH4 .or. lf_src(isrc)%species=="nh3")def3%unit='mgN/m2' + + iddep=iddep+1 + call Out_netCDF(iotyp,def3,ndim_tot,1,loc_frac_drydep(1,1,iddep),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes_tot,ncFileID_given=ncFileID) + + endif + if(lf_src(isrc)%wetdep)then + write(def3%name,"(A)")'WDEP_'//trim(def2%name) + def3%unit='mg/m2' + if(isrc==isrc_SO4 .or. isrc==isrc_SO2 .or. lf_src(isrc)%species=="sox")def3%unit='mgS/m2' + if(isrc==isrc_NH3 .or. isrc==isrc_NH4 .or. lf_src(isrc)%species=="nh3")def3%unit='mgN/m2' + + iwdep=iwdep+1 + call Out_netCDF(iotyp,def3,ndim_tot,1,loc_frac_wetdep(1,1,iwdep),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes_tot,ncFileID_given=ncFileID) + + endif + enddo + enddo + else + if(old_format)then + !for backward compatibility + write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_sec',isec,'_local_fraction' + if(isec==0) write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_local_fraction' + else + write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_sec',isec,'_fraction_'//trim(lf_src(isrc)%type) + if(isec==0) write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_fraction_'//trim(lf_src(isrc)%type) + write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_sec',isec,'_fraction_'//trim(lf_src(isrc)%type) + if(isec==0) write(def1%name,"(A,I2.2,A)")trim(lf_src(isrc)%species)//'_fraction_'//trim(lf_src(isrc)%type) + endif + scale=1.0 + call Out_netCDF(iotyp,def1,ndim,kmax,tmp_out,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes,ncFileID_given=ncFileID) + overwrite=.false. + if(isrc==1)then + def1%name=trim(lf_src(isrc)%species)//'_fracsum' + call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=lf_src(isrc)%DOMAIN,& + fileName_given=trim(fileName),overwrite=overwrite,create_var_only=create_var_only,chunksizes=chunksizes_tot,ncFileID_given=ncFileID) + endif + endif + enddo + enddo + deallocate(tmp_out) + + do ipoll=1,Npoll + do k = KMAX_MID-lf_Nvertout+1,KMAX_MID + do j=1,ljmax + do i=1,limax + lf_src_tot(i,j,k,ipoll,iou_ix) = 0.0 + enddo + enddo + enddo + enddo + + +! reset the cumulative arrays + do isrc = 1, Nsources + do k = KMAX_MID-lf_Nvertout+1,KMAX_MID + do j=1,ljmax + do i=1,limax + do n=lf_src(isrc)%start, lf_src(isrc)%end + lf_src_acc(n,i,j,k,iou_ix)=0 + enddo + enddo + enddo + enddo + enddo + + !reset the cumulative counters + av_fac(iotyp)=0 + + LF_ncFileID_iou(iotyp) = ncFileID !to use next time + + first_call(iotyp)=.false. + + call Add_2timing(NTIMING-2,tim_after,tim_before,"lf: output") + +! CALL MPI_BARRIER(MPI_COMM_CALC, I) + +!stop +end subroutine lf_out + +subroutine lf_av(dt,End_of_Day) + real, intent(in) :: dt ! time-step used in integrations + logical, intent(in) :: End_of_Day ! e.g. 6am for EMEP sites + real :: xtot + integer ::i,j,k,n,dx,dy,ix,iix,ipoll,isec_poll1, iou_ix, isrc + integer ::isec_poll + logical :: pollwritten(Npoll_lf_max) + + call Code_timer(tim_before) + if(.not. lf_src(1)%HOUR.and.& + .not. lf_src(1)%DAY .and.& + .not. lf_src(1)%MONTH .and.& + .not. lf_src(1)%YEAR )return + + !do the averaging + do iou_ix = 1, Niou_ix + pollwritten = .false. + do isrc=1,Nsources + ipoll = lf_src(isrc)%poll + do k = KMAX_MID-lf_Nvertout+1,KMAX_MID + do j=1,ljmax + do i=1,limax + xtot=0.0 + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + if(lf_src(isrc)%type=='country')then + !3m height cfac correction + xtot=xtot+(xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix))/ATWAIR& + *roa(i,j,k,1)*1.E9* cfac(ix,i,j) !for ug/m3 + ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 + else + xtot=xtot+(xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix))/ATWAIR& + *roa(i,j,k,1)*1.E9 !for ug/m3 + ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 + endif + end do + if(.not. pollwritten(ipoll))then !one pollutant may be used for several sources + lf_src_tot(i,j,k,ipoll,iou_ix) = lf_src_tot(i,j,k,ipoll,iou_ix) + xtot + endif + do n=lf_src(isrc)%start, lf_src(isrc)%end + lf_src_acc(n,i,j,k,iou_ix)=lf_src_acc(n,i,j,k,iou_ix)+xtot*lf(n,i,j,k) + end do + enddo + enddo + enddo + pollwritten(ipoll) = .true. + enddo + enddo + + av_fac=av_fac+1 + + call Add_2timing(NTIMING-9,tim_after,tim_before,"lf: averaging") + +end subroutine lf_av + +subroutine lf_adv_x(fluxx,i,j,k) + real, intent(in)::fluxx(NSPEC_ADV,-1:LIMAX+1) + integer, intent(in)::i,j,k + real ::x,xn,xx,f_in,inv_tot + integer ::n,ii,iix,ix,dx,dy,isrc + + if(i==li0)then + !copy small part (could be avoided, but simpler to copy) + !note that the right hand side of the lf equations must contain unupdated values, therefore values for j-1 must be buffered + do ii=li0,li1 + do n=1,LF_SRC_TOTSIZE + loc_frac_src_1d(n,ii) = lf(n,ii,j,k) + enddo + enddo + endif + + call Code_timer(tim_before) + do isrc=1,Nsources + xn=0.0 + x=0.0 + xx=0.0 + !positive x or xx means incoming, negative means outgoing + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + xn=xn+xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix) + x=x-xm2(i,j)*fluxx(ix,i)*lf_src(isrc)%mw(iix)!flux through "East" face (Right) + xx=xx+xm2(i,j)*fluxx(ix,i-1)*lf_src(isrc)%mw(iix)!flux through "West" face (Left) + end do + !NB: here xn already includes the fluxes. Remove them! + xn=xn-xx-x + xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. all outgoing flux + f_in=max(0.0,x)+max(0.0,xx)!positive part. all incoming flux + inv_tot=1.0/(xn+f_in+1.e-40)!incoming dilutes + + x =max(0.0,x)*inv_tot!factor due to flux through "East" face (Right) + xx=max(0.0,xx)*inv_tot!factor due to flux through "West" face (Left) + xn = xn * inv_tot + !often either x or xx is zero + if(lf_src(isrc)%type=='coarse' .or. lf_src(isrc)%type=='country')then + if(x>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n,i+1)*x + enddo + if(xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k) + loc_frac_src_1d(n,i-1)*xx + enddo + endif + else if (xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n,i-1)*xx + enddo + endif + else if(lf_src(isrc)%type=='relative')then + if(x>1.E-20)then + n = lf_src(isrc)%start + do dy=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn ! when dx=-lf_src(isrc)%dist there are no local fractions to transport + n=n+1 + do dx=-lf_src(isrc)%dist+1,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n-1,i+1)*x + n=n+1 + enddo + enddo + + if(xx>1.E-20)then + n = lf_src(isrc)%start + do dy=-lf_src(isrc)%dist,lf_src(isrc)%dist + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist-1 + lf(n,i,j,k) = lf(n,i,j,k) + loc_frac_src_1d(n+1,i-1)*xx + n=n+1 + enddo + n=n+1! when dx=lf_src(isrc)%dist there are no local fractions to transport + enddo + endif + else if (xx>1.E-20)then + n = lf_src(isrc)%start + do dy=-lf_src(isrc)%dist,lf_src(isrc)%dist + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist-1 + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n+1,i-1)*xx + n=n+1 + enddo + lf(n,i,j,k) = lf(n,i,j,k)*xn! when dx=lf_src(isrc)%dist there are no local fractions to transport + n=n+1 + enddo + else + !nothing to do if no incoming fluxes + endif + else + if(me==0)write(*,*)'LF type not recognized)' + stop + endif + enddo + + call Add_2timing(NTIMING-8,tim_after,tim_before,"lf: adv_x") + +end subroutine lf_adv_x + +subroutine lf_adv_y(fluxy,i,j,k) + real, intent(in)::fluxy(NSPEC_ADV,-1:LJMAX+1) + integer, intent(in)::i,j,k + real ::x,xn,xx,f_in,inv_tot + integer ::n,jj,iix,ix,dx,dy,isrc + + if(j==lj0)then + !copy small part (could be avoided, but simpler to copy) + !note that the right hand side of the lf equations must contain unupdated values, therefore values for i-1 must be buffered + do jj=lj0,lj1 + do n=1,LF_SRC_TOTSIZE + loc_frac_src_1d(n,jj) = lf(n,i,jj,k) + enddo + enddo + endif + + call Code_timer(tim_before) + do isrc=1,Nsources + xn=0.0 + x=0.0 + xx=0.0 + !positive x or xx means incoming, negative means outgoing + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + xn=xn+xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix) + x=x-xm2(i,j)*fluxy(ix,j)*lf_src(isrc)%mw(iix)!flux through "North" face (Up) + xx=xx+xm2(i,j)*fluxy(ix,j-1)*lf_src(isrc)%mw(iix)!flux through "South" face (Bottom) + end do + !NB: here xn already includes the fluxes. Remove them! + xn=xn-xx-x + xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. all outgoing flux + f_in=max(0.0,x)+max(0.0,xx)!positive part. all incoming flux + inv_tot=1.0/(xn+f_in+1.e-40)!incoming dilutes + + x =max(0.0,x)*inv_tot!factor due to flux through "East" face (Right) + xx=max(0.0,xx)*inv_tot!factor due to flux through "West" face (Left) + xn = xn * inv_tot + if(lf_src(isrc)%type=='coarse' .or. lf_src(isrc)%type=='country')then + !often either x or xx is zero + if(x>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n,j+1)*x + enddo + if(xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k) + loc_frac_src_1d(n,j-1)*xx + enddo + endif + else if (xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n,j-1)*xx + enddo + endif + else if(lf_src(isrc)%type=='relative')then + if(x>1.E-20)then + n = lf_src(isrc)%start + dy = -lf_src(isrc)%dist + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn + n=n+1 + enddo + do dy=-lf_src(isrc)%dist+1,lf_src(isrc)%dist + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n-Ndiv_rel,j+1)*x + n=n+1 + enddo + enddo + if(xx>1.E-20)then + n = lf_src(isrc)%start + do dy=-lf_src(isrc)%dist,lf_src(isrc)%dist-1 + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k) + loc_frac_src_1d(n+Ndiv_rel,j-1)*xx + n=n+1 + enddo + enddo + endif + else if (xx>1.E-20)then + n = lf_src(isrc)%start + do dy=-lf_src(isrc)%dist,lf_src(isrc)%dist-1 + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_1d(n+Ndiv_rel,j-1)*xx + n=n+1 + enddo + enddo + dy=lf_src(isrc)%dist + do dx=-lf_src(isrc)%dist,lf_src(isrc)%dist + lf(n,i,j,k) = lf(n,i,j,k)*xn + n=n+1 + enddo + else + !nothing to do if no incoming fluxes + endif + + else + if(me==0)write(*,*)'LF type not recognized)' + stop + endif + + enddo + call Add_2timing(NTIMING-7,tim_after,tim_before,"lf: adv_y") + +end subroutine lf_adv_y + +subroutine lf_adv_k(fluxk,i,j) + real, intent(in)::fluxk(NSPEC_ADV,KMAX_MID) + integer, intent(in)::i,j + real ::x,xn,xx,f_in,inv_tot + integer ::n,k,iix,ix,dx,dy,isrc + real loc_frac_src_km1(LF_SRC_TOTSIZE,KMAX_MID-lf_Nvert+2:KMAX_MID) + + call Code_timer(tim_before) + !need to be careful to always use non-updated values on the RHS + do k = KMAX_MID-lf_Nvert+2,KMAX_MID + do n = 1, LF_SRC_TOTSIZE + loc_frac_src_km1(n,k)=lf(n,i,j,k-1) !NB: k is shifted by 1 in loc_frac_src_km1 + enddo + enddo + !loc_frac_src_km1(:,KMAX_MID-lf_Nvert+1)=0.0!Assume zero local fractions coming from above + + do k = KMAX_MID-lf_Nvert+1,KMAX_MID!k is increasing-> can use k+1 to access non-updated value + do isrc=1,Nsources + xn=0.0 + x=0.0 + xx=0.0 + !positive x or xx means incoming, negative means outgoing + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + xn=xn+xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix) + if(k1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn +lf(n,i,j,k+1)*x + enddo + if(xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k) + loc_frac_src_km1(n,k)*xx + enddo + endif + else if (xx>1.E-20)then + do n = lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = lf(n,i,j,k)*xn + loc_frac_src_km1(n,k)*xx + enddo + else + !nothing to do if no incoming fluxes + endif + enddo + + end do + + call Add_2timing(NTIMING-6,tim_after,tim_before,"lf: adv_k") + end subroutine lf_adv_k + + subroutine lf_diff(i,j,ds3,ds4,ndiff) + + implicit none + interface + subroutine vertdiffn(xn_k,NSPEC,Nij,KMIN_in,SigmaKz,ds3,ds4,ndiff) + real,intent(inout) :: xn_k(NSPEC,0:*)!dummy + real,intent(in):: SigmaKz(*)!dummy + real,intent(in):: ds3(*),ds4(*)!dummy + integer,intent(in):: NSPEC,ndiff,Nij,KMIN_in + end subroutine vertdiffn + end interface + + real, intent(in) :: ds3(2:KMAX_MID),ds4(2:KMAX_MID) + integer, intent(in) :: i,j,ndiff + real :: xn_k(LF_SRC_TOTSIZE + Npoll,KMAX_MID),x + integer ::isec_poll1,isrc + integer ::k,n,ix,iix,dx,dy + !how far diffusion should take place above lf_Nvert. + ! KUP = 2 gives less than 0.001 differences in locfrac, except sometimes over sea, because + !ship emission are higher up and need to come down to diminish locfrac + integer, parameter :: KUP = 2 + + call Code_timer(tim_before) + xn_k = 0.0 + do k = 1,KMAX_MID + do isrc=1,Nsources + x=0.0 + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + !assumes mixing ratios units, but weight by mass + x=x+xn_adv(ix,i,j,k)*lf_src(isrc)%mw(iix) + end do + if(k>KMAX_MID-lf_Nvert)then ! lf zero above + do n=lf_src(isrc)%start, lf_src(isrc)%end + xn_k(n,k)=x*lf(n,i,j,k) + enddo + endif + xn_k(LF_SRC_TOTSIZE+lf_src(isrc)%poll,k) = x + enddo + enddo + + call vertdiffn(xn_k,LF_SRC_TOTSIZE+Npoll,1,KMAX_MID-lf_Nvert-KUP,EtaKz(i,j,1,1),ds3,ds4,ndiff) + + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + do isrc=1,Nsources + x = 1.0/(xn_k(LF_SRC_TOTSIZE+lf_src(isrc)%poll,k)+1.E-30) + do n=lf_src(isrc)%start, lf_src(isrc)%end + lf(n,i,j,k) = xn_k(n,k)*x + enddo + enddo + end do + call Add_2timing(NTIMING-5,tim_after,tim_before,"lf: diffusion") + +end subroutine lf_diff + +subroutine lf_chem(i,j) + !track through chemical reactions + integer, intent(in) ::i,j + real :: VOC,HO2,O3,NO,NO2,d_O3,d_NO,d_NO2,d_VOC, k1,k2,J_phot,invt,inv + real :: SO4,SO2, d_SO2, d_SO4 + integer :: k, n, n_O3,n_NO,n_NO2,n_VOC,nsteps,nsteps1,nsteps2 + integer :: n_SO2,n_SO4, n_EC_new, n_EC + real :: k_OH, k_H2O2, k_O3 + real :: d_age + + call Code_timer(tim_before) + + if(isrc_EC_f_new>0)then + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + ! d_age = amount that has been transformed from EC_f_new to EC_f_age + d_age = rct(80,k)*xn_adv(ix_EC_f_new,i,j,k) *dt_advec + inv = 1.0/( xn_adv(ix_EC_f_age,i,j,k) + d_age + 1.0E-20) + n_EC_new = lf_src(isrc_EC_f_new)%start + do n_EC=lf_src(isrc_EC_f_age)%start, lf_src(isrc_EC_f_age)%end + lf(n_EC,i,j,k) = (lf(n_EC,i,j,k)*xn_adv(ix_EC_f_age,i,j,k) + d_age*lf(n_EC_new,i,j,k)) * inv + n_EC_new = n_EC_new + 1 + enddo + enddo + endif + + if(isrc_EC_f_ffuel_new >0)then + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + ! d_age = amount that has been transformed from EC_f_ffuel_new to EC_f_ffuel_age + d_age = rct(96,k)*xn_adv(ix_EC_f_ffuel_new,i,j,k) *dt_advec + inv = 1.0/( xn_adv(ix_EC_f_ffuel_age,i,j,k) + d_age + 1.0E-20) + n_EC_new = lf_src(isrc_EC_f_ffuel_new)%start + do n_EC=lf_src(isrc_EC_f_ffuel_age)%start, lf_src(isrc_EC_f_ffuel_age)%end + lf(n_EC,i,j,k) = (lf(n_EC,i,j,k)*xn_adv(ix_EC_f_ffuel_age,i,j,k) + d_age*lf(n_EC_new,i,j,k)) * inv + n_EC_new = n_EC_new + 1 + enddo + enddo + endif + if(isrc_EC_f_wood_new >0)then + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + d_age = rct(96,k)*xn_adv(ix_EC_f_wood_new,i,j,k) *dt_advec + inv = 1.0/( xn_adv(ix_EC_f_wood_age,i,j,k) + d_age + 1.0E-20) + n_EC_new = lf_src(isrc_EC_f_wood_new)%start + do n_EC=lf_src(isrc_EC_f_wood_age)%start, lf_src(isrc_EC_f_wood_age)%end + lf(n_EC,i,j,k) = (lf(n_EC,i,j,k)*xn_adv(ix_EC_f_wood_age,i,j,k) + d_age*lf(n_EC_new,i,j,k)) * inv + n_EC_new = n_EC_new + 1 + enddo + enddo + endif + if(isrc_SO2>0)then + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + SO4 = xn_2d(NSPEC_SHL+ix_SO4,k) + n_SO4 = lf_src(isrc_SO4)%start + stop + !SO4 produced by SO2 , without emitted SO4: + !d_SO4 = max(0.0,Dchem(NSPEC_SHL+ix_SO4,k,i,j)-rcemis(NSPEC_SHL+ix_SO4,k))*dt_advec + inv = 1.0/(SO4 + 1.0E-20) + + do n_SO2=lf_src(isrc_SO2)%start, lf_src(isrc_SO2)%end + lf(n_SO4,i,j,k) = (lf(n_SO4,i,j,k)*(SO4-d_SO4)+d_SO4*lf(n_SO2,i,j,k)) * inv + n_SO4 = n_SO4 + 1 + enddo + + enddo + + endif + if(isrc_O3<=0)return + !the source index must give three values, stored at isrc_O3, isrc_NO and isrc_NO2 + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + !xn_adv is proportional to concentrations (~kg/m3) units in advection routines, (in mass mixing ratio otherwise). + !xn_2d is in units of molecules/cm3, and defined also with short lived + !units do not matter for local fractions, as long as all units are the same. +! if(allocated(Dchem))then +! !if(me==0.and. i==5 .and.j==5)write(*,*)'DCHEM ',Dchem(NSPEC_SHL+ix_SO2,k,i,j)*0.5*dt_advec,xn_2d(NSPEC_SHL+ix_SO2,k) +! NO = max(0.0,xn_2d(NSPEC_SHL+ix_NO,k)+Dchem(NSPEC_SHL+ix_NO,k,i,j)*0.5*dt_advec)! put value at approximatively average value during chem timestep +! NO2 = max(0.0,xn_2d(NSPEC_SHL+ix_NO2,k)+Dchem(NSPEC_SHL+ix_NO2,k,i,j)*0.5*dt_advec)! put value at approximatively average value during chem timestep +! else + NO = xn_2d(NSPEC_SHL+ix_NO,k) + NO2 = xn_2d(NSPEC_SHL+ix_NO2,k) +! endif + O3 = xn_2d(NSPEC_SHL+ix_O3,k) + VOC = xn_2d(NSPEC_SHL+ix_CH3CO3,k) + HO2 = xn_2d(ix_HO2,k) !NB: ix_HO2 is already short lived index + k1 = rct(11,k) * dt_advec + !CH3CO3 + HO2 -> 0.162*O3 + 0.384*CH3CO3H + 0.454 OH + 0.454 CH3O2 + 0.162 CH3COOH ? + k2 = 0.162* rct(45,k) * HO2 * dt_advec + d_VOC = VOC*k2/(1 + k2) + d_VOC=0.0 + n_O3 = lf_src(isrc_O3)%start + n_NO = lf_src(isrc_NO)%start + + J_phot=rcphot(IDNO2,k)*dt_advec + !NO2 photodecomposition: NO2+hv->NO+O3 (we skip OP) + !d_NO2 = -J_phot*NO2 + d_NO2 = NO2*J_phot/(1 + J_phot) + !if(i==5 .and. j==5 .and. k==20 .and. me>300 .and. me>400 )write(*,*)d_VOC,d_NO2,rct(1,k),rct(10,k)*NO + + !NO+O3->NO2+O2 + !d_NO = k1*O3*NO + if(NO10.0)then + write(*,*)'O3 is nan before chem',O3,NO2,NO,VOC, d_NO2 , d_VOC + stop + endif + if(isnan(lf(n_NO,i,j,k)))then + write(*,*)'NO is nan before chem',O3,NO2,NO,VOC + stop + endif + if(isnan(lf(n_NO2,i,j,k)) .or. lf(n_NO2,i,j,k)>10.0)then + write(*,*)'NO2 is nan before chem',O3,NO2,NO,VOC + stop + endif + lf(n_O3,i,j,k) = (lf(n_O3,i,j,k)*O3 + d_NO2*lf(n_NO2,i,j,k) -d_NO*lf(n_NO,i,j,k) + d_VOC*lf(n_VOC,i,j,k) )/(O3 + d_NO2 - d_NO + d_VOC + 1.0) + + if(isnan(lf(n_O3,i,j,k)) .or. lf(n_O3,i,j,k)>10.0)then + write(*,*)'O3 is nan after chem ',lf(n_O3,i,j,k),lf(n_NO2,i,j,k),O3,NO2,NO,VOC, d_NO2 , d_VOC + stop + endif + + lf(n_NO,i,j,k) = (lf(n_NO,i,j,k)*NO + d_NO2*lf(n_NO2,i,j,k) )/(NO + d_NO2 + 1.0) + + lf(n_NO2,i,j,k) = (lf(n_NO2,i,j,k)*(NO2-d_NO2) + d_NO*lf(n_NO,i,j,k) + d_NO*lf(n_O3,i,j,k) )/(NO2 - d_NO2 + d_NO + d_NO + 1.0) + if(isnan(lf(n_NO,i,j,k)) .or. lf(n_NO,i,j,k)>10.0)then + write(*,*)'NO is nan after chem ',lf(n_NO,i,j,k),O3,NO2,NO,VOC + stop + endif + if(isnan(lf(n_NO2,i,j,k)) .or. lf(n_NO2,i,j,k)>10.0)then + write(*,*)'NO2 is nan after chem ',lf(n_NO2,i,j,k),O3,NO2,NO,VOC,d_NO2 , d_NO + stop + endif + + n_O3 = n_O3 + 1 + n_VOC = n_VOC + 1 + n_NO = n_NO + 1 + enddo + enddo + + enddo + call Add_2timing(NTIMING-3,tim_after,tim_before,"lf: chemistry") +end subroutine lf_chem + +subroutine lf_aero_pre(i,j) !called just before AerosolEquilib + integer, intent(in) ::i,j + integer :: k + !save concentrations, to see changes + if(isrc_NH4<0)return; + call Code_timer(tim_before) + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + lf_NH4(k) = xn_2d(NSPEC_SHL+ix_NH4,k) + lf_NH3(k) = xn_2d(NSPEC_SHL+ix_NH3,k) + enddo + call Add_2timing(NTIMING-3,tim_after,tim_before,"lf: chemistry") + +end subroutine lf_aero_pre + +subroutine lf_aero_pos (i,j) !called just after AerosolEquilib + integer, intent(in) ::i,j + real :: d_NH4, d_NH3, NH4, NH3, inv + integer :: n_NH3, n_NH4, k + + if(isrc_NH4<0)return; + call Code_timer(tim_before) + do k = KMAX_MID-lf_Nvert+1,KMAX_MID + + NH3 = xn_2d(NSPEC_SHL+ix_NH3,k) + NH4 = xn_2d(NSPEC_SHL+ix_NH4,k) + d_NH4 = NH4 - lf_NH4(k) + d_NH3 = NH3 - lf_NH3(k) + + if(d_NH4>0.0 .and. d_NH3<0.0)then + !NH3 has been transformed into NH4 + n_NH3 = lf_src(isrc_NH3)%start + inv = 1.0/(NH4+d_NH4) + do n_NH4=lf_src(isrc_NH4)%start, lf_src(isrc_NH4)%end + lf(n_NH4,i,j,k) = (lf(n_NH4,i,j,k)*NH4 + d_NH4*lf(n_NH3,i,j,k)) * inv + n_NH3 = n_NH3 + 1 + enddo + else if(d_NH4<0.0 .and. d_NH3>0.0)then + !NH4 has been transformed into NH3 + n_NH3 = lf_src(isrc_NH3)%start + inv = 1.0/(NH3+d_NH3) + do n_NH4=lf_src(isrc_NH4)%start, lf_src(isrc_NH4)%end + lf(n_NH3,i,j,k) = (lf(n_NH3,i,j,k)*NH3 + d_NH3*lf(n_NH4,i,j,k)) * inv + n_NH3 = n_NH3 + 1 + enddo + else + !N is not conserved or concentrations are constant + endif + enddo + call Add_2timing(NTIMING-3,tim_after,tim_before,"lf: chemistry") + +end subroutine lf_aero_pos + +subroutine lf_drydep(i,j,DepLoss, fac) + integer, intent(in) :: i,j + real, intent(in) :: fac + real, intent(in), dimension(NSPEC_ADV) :: DepLoss + integer :: n,ix,iix,idep, idep0, isrc + real :: ffac + integer :: istart,iend + idep0=0 + idep=0 + call Code_timer(tim_before) + + do isrc=1,Nsources + if(.not. lf_src(isrc)%DryDep)cycle + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + ffac = fac*1.e6*lf_src(isrc)%mw(iix) !(units ok?) + istart = lf_src(isrc)%start + iend = lf_src(isrc)%end + if(isrc==isrc_SO4 .or. isrc==isrc_SO2 .or. lf_src(isrc)%species=="sox")ffac = ffac*32.0/64.0 !SO2->S + if(isrc==isrc_NH3 .or. isrc==isrc_NH4 .or. lf_src(isrc)%species=="nh3")ffac = ffac* 14.0/17.0!NH3->N + if(isrc==isrc_NO .or. isrc==isrc_NO2 .or. lf_src(isrc)%species=="nox")ffac = ffac*14.0/46.0 !NO2->N + + if( ix==ix_SO4 ) then + !take directly local fractions from SO4 instead of sox + istart = lf_src(isrc_SO4)%start + iend= lf_src(isrc_SO4)%end + endif + if( ix==ix_SO2 ) then + !take directly local fractions from SO2 instead of sox + istart = lf_src(isrc_SO2)%start + iend= lf_src(isrc_SO2)%end + endif + + if( ix==ix_NH4 ) then + istart = lf_src(isrc_NH4)%start + iend= lf_src(isrc_NH4)%end + endif + if( ix==ix_NH3 ) then + istart = lf_src(isrc_NH3)%start + iend= lf_src(isrc_NH3)%end + endif + + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_drydep(i,j,idep) = loc_frac_drydep(i,j,idep) + lf(n,i,j,KMAX_MID)*DepLoss(ix)*ffac + enddo + if(lf_src(isrc)%species=="nox" .and. iix==lf_src(isrc)%Nsplit)then + !we add also depositions of NO3 and HNO3 + ix=ix_NO3 + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_drydep(i,j,idep) = loc_frac_drydep(i,j,idep) + lf(n,i,j,KMAX_MID)*DepLoss(ix)*ffac + enddo + ix=ix_HNO3 + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_drydep(i,j,idep) = loc_frac_drydep(i,j,idep) + lf(n,i,j,KMAX_MID)*DepLoss(ix)*ffac + enddo + endif + enddo + idep0 = idep + enddo + call Add_2timing(NTIMING-3,tim_after,tim_before,"lf: chemistry") +end subroutine lf_drydep + +subroutine lf_wetdep(iadv, i,j,k_in,loss, fac) + integer, intent(in) :: iadv, i,j,k_in + real, intent(in) :: loss, fac + integer :: n,ix,iix,idep, idep0, isrc, k + real :: ffac + integer :: istart,iend + idep0=0 + idep=0 + k = max(k_in,KMAX_MID-lf_Nvert+1) ! for scavenging above the lf window, we assume same fraction as highest level available + call Code_timer(tim_before) + + do isrc=1,Nsources + if(.not. lf_src(isrc)%WetDep) cycle + do iix=1,lf_src(isrc)%Nsplit + ix=lf_src(isrc)%ix(iix) + if(ix /= iadv) cycle + ffac = fac*1.e6*lf_src(isrc)%mw(iix) + istart = lf_src(isrc)%start + iend = lf_src(isrc)%end + if(isrc==isrc_SO2 .or. lf_src(isrc)%species=="sox") ffac = ffac*32.0/64.0 !SO2->S + if(isrc==isrc_SO4) ffac = ffac*32.0/96.0 !SO4->S + if(isrc==isrc_NH3 .or. lf_src(isrc)%species=="nh3") ffac = ffac* 14.0/17.0 !NH3->N + if(isrc==isrc_NH4) ffac = ffac* 14.0/18.0 !NH4->N + if(isrc==isrc_NO .or. isrc==isrc_NO2 .or. lf_src(isrc)%species=="nox") ffac = ffac*14.0/46.0 !NO2->N + + if( ix==ix_SO4 ) then + !take directly local fractions from SO4 instead of sox + istart = lf_src(isrc_SO4)%start + iend= lf_src(isrc_SO4)%end + endif + if( ix==ix_SO2 ) then + !take directly local fractions from SO2 instead of sox + istart = lf_src(isrc_SO2)%start + iend= lf_src(isrc_SO2)%end + endif + + if( ix==ix_NH4 ) then + istart = lf_src(isrc_NH4)%start + iend= lf_src(isrc_NH4)%end + endif + if( ix==ix_NH3 ) then + istart = lf_src(isrc_NH3)%start + iend= lf_src(isrc_NH3)%end + endif + + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_wetdep(i,j,idep) = loc_frac_wetdep(i,j,idep) + lf(n,i,j,k)*loss*ffac + enddo + if(lf_src(isrc)%species=="nox" .and. iix==lf_src(isrc)%Nsplit)then + !we add also depositions of NO3 and HNO3 + ix=ix_NO3 + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_wetdep(i,j,idep) = loc_frac_wetdep(i,j,idep) + lf(n,i,j,k)*loss*ffac + enddo + ix=ix_HNO3 + idep=idep0 + do n = istart, iend + idep=idep+1 + loc_frac_wetdep(i,j,idep) = loc_frac_wetdep(i,j,idep) + lf(n,i,j,k)*loss*ffac + enddo + endif + enddo + idep0 = idep0 + lf_src(isrc)%end-lf_src(isrc)%start+1 + enddo + call Add_2timing(NTIMING-3,tim_after,tim_before,"lf: chemistry") +end subroutine lf_wetdep + +subroutine lf_emis(indate) +!include emission contributions to local fractions + +!NB: should replace most of the stuff and use gridrcemis instead! + + implicit none + type(date), intent(in) :: indate ! Gives year..seconds + integer :: i, j, k, n ! coordinates, loop variables + integer :: icc, ncc ! No. of countries in grid. + integer :: isec ! loop variables: emission sectors + integer :: iem ! loop variable over 1..NEMIS_FILE + + ! Save daytime value between calls, initialise to zero + integer, save, dimension(MAXNLAND) :: daytime(1:MAXNLAND) = 0 ! 0=night, 1=day + integer, save, dimension(MAXNLAND) :: localhour(1:MAXNLAND) = 1 ! 1-24 local hour in the different countries + integer :: hourloc ! local hour + real, dimension(NRCEMIS) :: tmpemis ! local array for emissions + real :: s ! source term (emis) before splitting + integer ::icc_lf, iqrc, itot + integer, save :: wday , wday_loc ! wday = day of the week 1-7 + integer ::ix,iy,iix, iiix,dx, dy, isec_poll, iisec_poll, isec_poll1, isrc, ic, is + real::dt_lf, xtot, x + real :: lon + integer :: jmin,jmax,imin,imax,n0 + + call Code_timer(tim_before) + + do j = lj0,lj1 + do i = li0,li1 + ix=(gi0+i-2)/((GIMAX+Ndiv_coarse-1)/Ndiv_coarse)+1 !i coordinate in coarse domain + iy=(gj0+j-2)/((GJMAX+Ndiv_coarse-1)/Ndiv_coarse)+1 !j coordinate in coarse domain + do isrc=1,Nsources + iem = lf_src(isrc)%iem + isec = lf_src(isrc)%sector + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + if(lf_src(isrc)%iqrc<0)then + if(lf_emis_tot(i,j,k,lf_src(isrc)%poll)<1.E-20)cycle + else + if(emis_lf(i,j,k,isrc)<1.E-20)cycle + endif + xtot=0.0 + do iix=1,lf_src(isrc)%Nsplit + iiix=lf_src(isrc)%ix(iix) + xtot=xtot+(xn_adv(iiix,i,j,k)*lf_src(isrc)%mw(iix))*(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV + end do + if(lf_src(isrc)%type=='country' .and. (Ncountry_lf>0 .or. Ncountry_group_lf>0))then + n0=lf_src(isrc)%start + do ic=1,Ncountry_lf + do is=1,Ncountrysectors_lf + lf(n0,i,j,k)=(lf(n0,i,j,k)*xtot+emis_lf_cntry(i,j,k,ic,is,isrc))/(xtot+lf_emis_tot(i,j,k,lf_src(isrc)%poll)+1.e-20) + n0=n0+1 + enddo + enddo + do ic=Ncountry_lf+1,Ncountry_lf+Ncountry_group_lf + do is=1,Ncountrysectors_lf + lf(n0,i,j,k)=(lf(n0,i,j,k)*xtot+emis_lf_cntry(i,j,k,ic,is,isrc))/(xtot+lf_emis_tot(i,j,k,lf_src(isrc)%poll)+1.e-20) + n0=n0+1 + enddo + enddo + cycle !only one fraction per country + else if(lf_src(isrc)%type=='relative' .or. lf_src(isrc)%type=='coarse')then + !Country constraints already included in emis_lf + if(lf_src(isrc)%type=='relative') n0 = lf_src(isrc)%start + (lf_src(isrc)%Npos - 1)/2 !"middle" point is dx=0 dy=0 + if(lf_src(isrc)%type=='coarse') n0 = lf_src(isrc)%start+ix-1+(iy-1)*Ndiv_coarse + lf(n0,i,j,k)=(lf(n0,i,j,k)*xtot+emis_lf(i,j,k,isrc))/(xtot+lf_emis_tot(i,j,k,lf_src(isrc)%poll)+1.e-20) + else + if(me==0)write(*,*)'LF type not recognized)' + stop + endif + do n = lf_src(isrc)%start, lf_src(isrc)%end + if(n==n0)cycle !counted above + lf(n,i,j,k)=(lf(n,i,j,k)*xtot)/(xtot+lf_emis_tot(i,j,k,lf_src(isrc)%poll)+1.e-20)!fractions are diluted + enddo + enddo + enddo + end do ! i + end do ! j + + call Add_2timing(NTIMING-4,tim_after,tim_before,"lf: emissions") + +end subroutine lf_emis + +subroutine add_lf_emis(s,i,j,iem,isec,iland) + real, intent(in) :: s + integer, intent(in) :: i,j,iem,isec,iland + integer :: n, isrc, k, ipoll,ic,is,ig + real :: emis + integer :: ngroups, ig2ic(Max_Country_groups) + + call Code_timer(tim_before) + + do n=1,iem2Nipoll(iem) + ipoll = iem2ipoll(iem,n) + if(ipoll2iqrc(ipoll)>0)then + !only extract that single pollutant + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + lf_emis_tot(i,j,k,ipoll) = lf_emis_tot(i,j,k,ipoll) + s * emisfrac(ipoll2iqrc(ipoll),sec2split_map(isec),iland)& + * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) * dt_advec!total over all sectors and countries for each pollutant + enddo + else + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + lf_emis_tot(i,j,k,ipoll) = lf_emis_tot(i,j,k,ipoll) + s * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) * dt_advec!total for each pollutant + enddo + endif + enddo + + do isrc = 1, Nsources + if(lf_src(isrc)%iem /= iem) cycle + if(Ncountry_lf>0)then + !has to store more detailed info + do ic=1,Ncountry_lf + if(country_ix_list(ic)==IC_TMT.and.(iland==IC_TM.or.iland==IC_TME))then + else if(country_ix_list(ic)==IC_AST.and.(iland==IC_ASM.or.iland==IC_ASE.or.iland==IC_ARE.or.iland==IC_ARL.or.iland==IC_CAS))then + else if(country_ix_list(ic)==IC_UZT.and.(iland==IC_UZ.or.iland==IC_UZE))then + else if(country_ix_list(ic)==IC_KZT.and.(iland==IC_KZ.or.iland==IC_KZE))then + else if(country_ix_list(ic)==IC_RUE.and.(iland==IC_RU.or.iland==IC_RFE.or.iland==IC_RUX))then + else if(country_ix_list(ic)/=iland)then + cycle + endif + do is=1,Ncountrysectors_lf + if(lf_country_sector_list(is)/=isec .and. lf_country_sector_list(is)/=0)cycle + emis = s * dt_advec + if(lf_src(isrc)%iqrc>0)emis = emis *emisfrac(lf_src(isrc)%iqrc,sec2split_map(isec),iland) + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + emis_lf_cntry(i,j,k,ic,is,isrc)=emis_lf_cntry(i,j,k,ic,is,isrc) + emis * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) + enddo + enddo + enddo + end if + if(Ncountry_group_lf>0)then + !has to store more detailed info + ngroups = 0 + do ic=1,Ncountry_group_lf + !find all groups that include iland + if(any(lf_country_group(ic)%ix(:)==iland))then + ngroups = ngroups + 1 + ig2ic(ngroups) = ic + Ncountry_lf + endif + enddo + do ig = 1, ngroups + ic = ig2ic(ig) ! index for country_group + do is=1,Ncountrysectors_lf + if(lf_country_sector_list(is)/=isec .and. lf_country_sector_list(is)/=0)cycle + emis = s * dt_advec + if(lf_src(isrc)%iqrc>0)emis = emis *emisfrac(lf_src(isrc)%iqrc,sec2split_map(isec),iland) + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + emis_lf_cntry(i,j,k,ic,is,isrc)=emis_lf_cntry(i,j,k,ic,is,isrc) + emis * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) + enddo + enddo + enddo + endif + if(lf_src(isrc)%iqrc>0 .and. (Ncountry_lf>0.or.Ncountry_group_lf>0))then + !sum of all emissions for that species from all countries and sectors + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + emis_lf(i,j,k,isrc) = emis_lf(i,j,k,isrc) + s * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) & + * emisfrac(lf_src(isrc)%iqrc,sec2split_map(isec),iland) *dt_advec + enddo + + else + if(lf_src(isrc)%sector /= isec .and. lf_src(isrc)%sector /= 0) cycle + if(lf_src(isrc)%country_ix>0 .and. lf_src(isrc)%country_ix/=iland) cycle + if(lf_src(isrc)%iqrc>0)then + !single pollutant, part of emitted group of pollutant + ipoll = lf_src(isrc)%poll + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + emis_lf(i,j,k,isrc) = emis_lf(i,j,k,isrc) + s * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) & + * emisfrac(lf_src(isrc)%iqrc,sec2split_map(isec),iland) *dt_advec + enddo + else + do k=max(KEMISTOP,KMAX_MID-lf_Nvert+1),KMAX_MID + emis_lf(i,j,k,isrc) = emis_lf(i,j,k,isrc) + s * emis_kprofile(KMAX_BND-k,sec2hfac_map(isec)) * dt_advec + enddo + endif + endif + enddo + call Add_2timing(NTIMING-4,tim_after,tim_before,"lf: emissions") + +end subroutine add_lf_emis + +end module LocalFractions_mod diff --git a/LocalVariables_mod.f90 b/LocalVariables_mod.f90 index 33a34d5..8aff74e 100644 --- a/LocalVariables_mod.f90 +++ b/LocalVariables_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/MARS_mod.f90 b/MARS_mod.f90 index d9c8990..a989bd4 100755 --- a/MARS_mod.f90 +++ b/MARS_mod.f90 @@ -64,25 +64,25 @@ module MARS_mod integer, private, save :: MAXNNN1 = 0 integer, private, save :: MAXNNN2 = 0 !ds real MWNO3 ! molecular weight for NO3 - real, private, parameter :: MWNO3 = 62.0049 + real, private, parameter :: MWNO3 = 62.0!049 !ds real MWHNO3 ! molecular weight for HNO3 - real, private, parameter :: MWHNO3 = 63.01287 + real, private, parameter :: MWHNO3 = 63.0!1287 !ds real MWSO4 ! molecular weight for SO4 - real, private, parameter :: MWSO4 = 96.0576 + real, private, parameter :: MWSO4 = 96.0!576 !ds real MWHSO4 ! molecular weight for HSO4 - real, private, parameter :: MWHSO4 = MWSO4 + 1.0080 + real, private, parameter :: MWHSO4 = MWSO4 + 1.0!080 !ds real MH2SO4 ! molecular weight for H2SO4 - real, private, parameter :: MH2SO4 = 98.07354 + real, private, parameter :: MH2SO4 = 98.0!7354 !ds real MWNH3 ! molecular weight for NH3 - real, private, parameter :: MWNH3 = 17.03061 + real, private, parameter :: MWNH3 = 17.0!3061 !ds real MWNH4 ! molecular weight for NH4 - real, private, parameter :: MWNH4 = 18.03858 + real, private, parameter :: MWNH4 = 18.0!3858 contains real function poly4 (a,x) @@ -481,15 +481,15 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & !..iamodels3 merge NH3/NH4 , HNO3,NO3 here TSO4 = MAX( 0.0, SO4 / MWSO4 ) TSO4 = MAX( FLOOR, TSO4 ) !GEOS added - TNO3 = MAX( 0.0, (NO3 / MWNO3 + HNO3 / MWHNO3) ) - TNH4 = MAX( 0.0, (NH3 / MWNH3 + NH4 / MWNH4) ) + TNO3 = MAX( 0.0, (NO3 / MWNO3 + HNO3 / MWHNO3) ) !in number of molecules per volume. conserved + TNH4 = MAX( 0.0, (NH3 / MWNH3 + NH4 / MWNH4) ) !in number of molecules per volume. conserved !2/25/99 IJA -! TMASSNH3 = MAX(0.0, NH3 + (MWNH3 / MWNH4) * NH4 ) +! TMASSNH3 = MAX(0.0, NH3 + (MWNH3 / MWNH4) * NH4 ) !total mass in units of "as NH3" ! TMASSHNO3 = MAX(0.0, NO3 + (MWHNO3 / MWNO3) * NO3 ) - TMASSNH3 = MAX(0.0, NH3 + NH4 ) - TMASSHNO3 = MAX(0.0, HNO3 + NO3 ) + TMASSNH3 = MAX(0.0, NH3 + NH4 ) !NB: do not use as it is not conserved!! in kg per volume + TMASSHNO3 = MAX(0.0, HNO3 + NO3 ) !NB: do not use as it is not conserved!! in kg per volume !...now set humidity index fRH as a percent @@ -644,7 +644,6 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & DO_RATIO_Low_2=.true. TSO4_HighA=TSO4*Ratio/RATIO_High TSO4_LowA=TSO4*Ratio/RATIO_Low -! High_Factor=(RATIO-RATIO_Low)/(RATIO_High-RATIO_Low) High_Factor=(RATIO*RATIO_High-RATIO_Low*RATIO_High)/(RATIO*RATIO_High-RATIO*RATIO_Low) end if @@ -719,11 +718,12 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & ASO4_High = TSO4_HighA * MWSO4 ANO3_High = NO3 ANH4_High = YNH4 * MWNH4 - GNH3_High = TMASSNH3 - ANH4 + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 if( GNH3 < 0.0 ) then print *, " NEG GNH3", TWOSO4, ANH4, TMASSNH3 call CheckStop("NEG GNH3") end if + ! RETURN goto 333 END IF @@ -738,21 +738,15 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & XNO3 = MIN( XXQ / AA, CC / XXQ ) END IF -!2/25/99 IJA + AH2O_High = 1000.0 * WH2O YNH4 = TWOSO4 + XNO3 ASO4_High = TSO4_HighA * MWSO4 - !dsSAFE ANO3 = XNO3 * MWNO3 - ANO3_High = min(XNO3 * MWNO3, TMASSHNO3 ) - !dsSAFE ANH4 = YNH4 * MWNH4 ! ds should be safe as NH4/SO4 >2, but anyway: - ANH4_High = min(YNH4 * MWNH4, TMASSNH3 ) ! ds should be safe as NH4/SO4 >2, but anyway: - GNH3_High = TMASSNH3 - ANH4_High - GNO3_High = TMASSHNO3 - ANO3_High - ! if( GNH3 < 0.0 .or. GNO3 < 0.0 ) then - ! print *, " NEG GNH3 GNO3", TWOSO4, ANH4, TMASSNH3, ANO3, TMASSHNO3 - ! call CheckStop("NEG GNH3 GNO3") - ! end if -! RETURN + ANO3_High = min(XNO3 , TNO3 ) * MWNO3 + ANH4_High = min(YNH4 , TNH4 )* MWNH4 ! ds should be safe as NH4/SO4 >2, but anyway: + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 + GNO3_High = max(FLOOR,(TNO3 - XNO3))* MWHNO3 + goto 333 END IF @@ -801,15 +795,12 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & GNO3_High = HNO3 ASO4_High = TSO4_HighA * MWSO4 ANO3_High = NO3 - !ANH4 = YNH4 * MWNH4 - ANH4_High = min( YNH4 * MWNH4, TMASSNH3) ! ds added "min" - GNH3_High = TMASSNH3 - ANH4_High - + ANH4_High = min(YNH4 , TNH4 )* MWNH4 ! ds should be safe as NH4/SO4 >2, but anyway: + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 !WRITE( 10, * ) ' COMPLEX ROOTS ' ! RETURN goto 333 END IF -! 2/25/99 IJA ! Deal with degenerate case (yoj) @@ -839,9 +830,8 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & GNO3_High = HNO3 ASO4_High = TSO4_HighA * MWSO4 ANO3_High = NO3 - !ds ANH4 = YNH4 * MWNH4 - ANH4_High = min( YNH4 * MWNH4, TMASSNH3) ! ds added "min" - GNH3_High = TMASSNH3 - ANH4_High + ANH4_High = min(YNH4 , TNH4 )* MWNH4 ! ds should be safe as NH4/SO4 >2, but anyway: + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 if( DEBUG%EQUIB .and. debug_flag ) WRITE( *, * ) ' TWO NEG ROOTS ' ! RETURN goto 333 @@ -901,13 +891,12 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & IF ( EROR <= TOLER1 ) THEN !!! WRITE( 11, * ) RH, STION, GAMS( 1, 1 ),GAMS( 1, 2 ), GAMS( 1, 3 ), !!! & GAMS( 2, 1 ), GAMS( 2, 2 ), GAMS( 2, 3 ), PHIBAR -! 2/25/99 IJA ASO4_High = TSO4_HighA * MWSO4 - ANO3_High = min(XNO3 * MWNO3,TMASSHNO3) - ANH4_High = min( YNH4 * MWNH4, TMASSNH3 ) - GNO3_High = TMASSHNO3 - ANO3_High - GNH3_High = TMASSNH3 - ANH4_High + ANO3_High = min(XNO3 , TNO3 ) * MWNO3 + ANH4_High = min( YNH4 , TNH4 )* MWNH4 + GNO3_High = max(FLOOR,(TNO3 - XNO3))* MWHNO3 + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 AH2O_High = 1000.0 * WH2O ! RETURN @@ -924,11 +913,11 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & ANO3_High = NO3 XNO3 = NO3 / MWNO3 YNH4 = TWOSO4 -! ANH4 = YNH4 * MWNH4 - ANH4_High = min( YNH4 * MWNH4, TMASSNH3 ) ! ds pw added "min" + ANH4_High = min(YNH4 , TNH4 )* MWNH4 ! ds should be safe as NH4/SO4 >2, but anyway: CALL AWATER ( fRH, TSO4_HighA, YNH4, XNO3, AH2O_High) GNO3_High = HNO3 - GNH3_High = TMASSNH3 - ANH4_High + GNH3_High = max(FLOOR,(TNH4 - YNH4))*MWNH3 + ! RETURN goto 333 @@ -957,9 +946,8 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & ! 2/25/99 IJA ASO4_Low = TSO4_LowA * MWSO4 ANH4_Low = TNH4 * MWNH4 - !dsSAFE ANO3 = NO3 - ANO3_Low = min( NO3, TMASSHNO3 ) - GNO3_Low = TMASSHNO3 - ANO3_Low + ANO3_Low = min( NO3, TNO3*MWNO3 ) + GNO3_Low = max(FLOOR,TNO3 - ANO3_Low/MWNO3)*MWHNO3 GNH3_Low = FLOOR AH2O_Low = 1.0E3 *WH2O @@ -1063,10 +1051,8 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & MNA = MAX( 0.0, MNA ) MNA = MIN( MNA, TNO3 / max(WH2O,FLOOR) ) XNO3 = MNA * WH2O - !ds ANO3 = MNA * WH2O * MWNO3 - ANO3_Low = min( TMASSHNO3, MNA * WH2O * MWNO3) -! 2/25/99 IJA - GNO3_Low = TMASSHNO3 - ANO3_Low + ANO3_Low = min( MNA * WH2O, TNO3 )*MWNO3 + GNO3_Low = max(FLOOR,TNO3 - ANO3_Low/MWNO3)*MWHNO3 !GEOS added: ASO4_Low = MSO4 * WH2O * MWSO4 !pw added after [rjp, 12/12/01] @@ -1134,7 +1120,7 @@ subroutine rpmares ( SO4, HNO3, NO3, NH3, NH4, RH, TEMP, & GNO3_Low = HNO3 ANO3_Low = NO3 ASO4_Low = TSO4 * MWSO4 ! PW after [rjp, 12/17/01] - + CALL AWATER ( fRH, TSO4_LowA, TNH4, TNO3, AH2O_Low ) ! RETURN goto 111 @@ -1761,13 +1747,13 @@ SUBROUTINE RPMARES_new( SO4, GNO3, GNH3, RH, TEMP,& ! Molecular weights REAL*8, PARAMETER :: MWNACL = 58.44277d0 ! NaCl - REAL*8, PARAMETER :: MWNO3 = 62.0049d0 ! NO3 - REAL*8, PARAMETER :: MWHNO3 = 63.01287d0 ! HNO3 - REAL*8, PARAMETER :: MWSO4 = 96.0576d0 ! SO4 - REAL*8, PARAMETER :: MWHSO4 = MWSO4 + 1.0080d0 ! HSO4 - REAL*8, PARAMETER :: MH2SO4 = 98.07354d0 ! H2SO4 - REAL*8, PARAMETER :: MWNH3 = 17.03061d0 ! NH3 - REAL*8, PARAMETER :: MWNH4 = 18.03858d0 ! NH4 + REAL*8, PARAMETER :: MWNO3 = 62.0!049d0 ! NO3 + REAL*8, PARAMETER :: MWHNO3 = 63.0!1287d0 ! HNO3 + REAL*8, PARAMETER :: MWSO4 = 96.0!576d0 ! SO4 + REAL*8, PARAMETER :: MWHSO4 = MWSO4 + 1.0!080d0 ! HSO4 + REAL*8, PARAMETER :: MH2SO4 = 98.0!7354d0 ! H2SO4 + REAL*8, PARAMETER :: MWNH3 = 17.0!3061d0 ! NH3 + REAL*8, PARAMETER :: MWNH4 = 18.0!3858d0 ! NH4 REAL*8, PARAMETER :: MWORG = 16.0d0 ! Organic Species REAL*8, PARAMETER :: MWCL = 35.453d0 ! Chloride REAL*8, PARAMETER :: MWAIR = 28.964d0 ! AIR diff --git a/MPI_Groups_mod.f90 b/MPI_Groups_mod.f90 index 6ab352a..c49bba5 100644 --- a/MPI_Groups_mod.f90 +++ b/MPI_Groups_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -31,7 +31,7 @@ module MPI_Groups_mod MPI_SUM,MPI_LOR,MPI_LAND,MPI_MAX,MPI_MIN, & MPI_COMM_WORLD,MPI_IN_PLACE,& MPI_ADDRESS_KIND,MPI_INFO_NULL,MPI_STATUS_SIZE,& - MPI_WTIME + MPI_WTIME, MPI_ANY_SOURCE implicit none integer, public, parameter :: MasterPE = 0 ! root/master processor diff --git a/Makefile.SRCS b/Makefile.SRCS index 2b561c9..9317f8f 100644 --- a/Makefile.SRCS +++ b/Makefile.SRCS @@ -23,7 +23,7 @@ FOBJ ?= \ Gravset_mod.o GridAllocate_mod.o GridValues_mod.o \ InterpolationRoutines_mod.o \ Io_mod.o Io_Nums_mod.o Io_Progs_mod.o KeyValueTypes.o LandDefs_mod.o Landuse_mod.o \ - LandPFT_mod.o LocalVariables_mod.o MARS_mod.o MARS_Aero_water_mod.o \ + LandPFT_mod.o LocalVariables_mod.o LocalFractions_mod.o MARS_mod.o MARS_Aero_water_mod.o \ MassBudget_mod.o Met_mod.o MetFields_mod.o EQSAM_mod.o MicroMet_mod.o \ MosaicOutputs_mod.o MPI_Groups_mod.o AerosolCalls.o \ My_Derived_mod.o NetCDF_mod.o Nest_mod.o NumberConstants.o \ @@ -35,7 +35,7 @@ FOBJ ?= \ SoilWater_mod.o Solver.o SeaSalt_mod.o StoFlux_mod.o \ SubMet_mod.o Tabulations_mod.o TimeDate_mod.o TimeDate_ExtraUtil_mod.o \ Timefactors_mod.o Timing_mod.o \ - Trajectory_mod.o uEMEP_mod.o Units_mod.o \ + Trajectory_mod.o Units_mod.o \ YieldModifications_mod.o \ ZchemData_mod.o \ global2local.o PhyChem_mod.o My_3DVar_mod.o Pollen_mod.o Pollen_const_mod.o diff --git a/MassBudget_mod.f90 b/MassBudget_mod.f90 index 5f057b4..5fe1539 100644 --- a/MassBudget_mod.f90 +++ b/MassBudget_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/MetFields_mod.f90 b/MetFields_mod.f90 index 3537754..26a394a 100644 --- a/MetFields_mod.f90 +++ b/MetFields_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -187,8 +187,8 @@ module MetFields_mod ,sdepth & ! Snowdepth, m ,ice_nwp & ! QUERY why real? ,sst & ! SST Sea Surface Temprature- ONLY from 2002 in PARLAM - ,ws_10m ! wind speed 10m - + ,ws_10m & ! wind speed 10m + ,hmix ! same as pzpbl, but interpolated in time real,target,public, save,allocatable, dimension(:,:) :: & u_ref & ! wind speed m/s at 45m (real, not projected) @@ -197,7 +197,8 @@ module MetFields_mod ,convective_precip & ! Convective precip mm/hr ,Tpot2m & ! Potential temp at 2m ,ustar_nwp & ! friction velocity m/s ustar^2 = tau/roa - ,pzpbl & ! stores H(ABL) for averaging and plotting purposes, m + ,pzpbl & ! Height of boundary layer in m. Used to compute Kz. + ! NB: use hmix variable for output, since hmix is interpolated in time, but not pzpbl ,pwp & ! Permanent Wilting Point ,fc & ! Field Capacity ,invL_nwp & ! inverse of the Monin-Obuhkov length @@ -667,6 +668,19 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) ix_pblnwp=ix !NWPHMIX + ix=ix+1 + met(ix)%name = 'hmix' ! NB: same as pzpbl, but interpolated in time + met(ix)%dim = 2 + met(ix)%frequency = 3 + met(ix)%time_interpolate = .true. + met(ix)%read_meteo = .false. + met(ix)%needed = .false. + met(ix)%found = .false. + + allocate(hmix(LIMAX,LJMAX,NMET)) + met(ix)%field(1:LIMAX,1:LJMAX,1:1,1:NMET) => hmix + met(ix)%zsize = 1 + met(ix)%msize = NMET ix=ix+1 met(ix)%name = 'temperature_2m' @@ -901,7 +915,7 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) met(ix)%read_meteo = .false.!read once only the first time met(ix)%needed = .false. met(ix)%found => foundtopo - allocate(model_surf_elevation(LIMAX,LJMAX)) + allocate(model_surf_elevation(LIMAX,LJMAX)) !in meters above sea level model_surf_elevation=0.0 met(ix)%field(1:LIMAX,1:LJMAX,1:1,1:1) => model_surf_elevation met(ix)%zsize = 1 @@ -1109,7 +1123,7 @@ subroutine Alloc_MetFields(LIMAX,LJMAX,KMAX_MID,KMAX_BND,NMET) allocate(u_ref(LIMAX,LJMAX)) allocate(rho_surf(LIMAX,LJMAX)) allocate(Tpot2m(LIMAX,LJMAX)) - allocate(pzpbl(LIMAX,LJMAX)) + allocate(pzpbl(LIMAX,LJMAX)) allocate(pwp(LIMAX,LJMAX)) allocate(fc(LIMAX,LJMAX)) allocate(xwf(LIMAX+2*NEXTEND,LJMAX+2*NEXTEND)) diff --git a/Met_mod.f90 b/Met_mod.f90 index cfef3d2..4df914f 100644 --- a/Met_mod.f90 +++ b/Met_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -1785,7 +1785,7 @@ subroutine BLPhysics() !..spatial smoothing of new zi: Need fixed minimum here. 100 or 50 m is okay ! First, we make sure coastal areas had "land-like" values. - if(LANDIFY_MET) & + if(LANDIFY_MET) & call landify(pzpbl,"pzbpl") call smoosp(pzpbl,PBL%ZiMIN,PBL%ZiMAX) @@ -1876,6 +1876,10 @@ subroutine BLPhysics() end if ! Specify unstable, stable separately: end if ! NWP_Kz .and. foundKz_met + forall(i=1:limax,j=1:ljmax) + hmix(i,j,nr) = pzpbl(i,j) + end forall + ! spatial smoothing of new zi: Need fixed minimum here. 100 or 50 m is okay ! First, we make sure coastal areas had "land-like" values. diff --git a/MosaicOutputs_mod.f90 b/MosaicOutputs_mod.f90 index dccb612..8ef248f 100644 --- a/MosaicOutputs_mod.f90 +++ b/MosaicOutputs_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/My_3DVar_mod.f90 b/My_3DVar_mod.f90 index b021b66..34f51ec 100644 --- a/My_3DVar_mod.f90 +++ b/My_3DVar_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/My_Derived_mod.f90 b/My_Derived_mod.f90 index 9c4d09f..e170496 100644 --- a/My_Derived_mod.f90 +++ b/My_Derived_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Nest_mod.f90 b/Nest_mod.f90 index 461d3ba..49b96b1 100644 --- a/Nest_mod.f90 +++ b/Nest_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/NetCDF_mod.f90 b/NetCDF_mod.f90 index d23cb5a..74745f1 100644 --- a/NetCDF_mod.f90 +++ b/NetCDF_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -103,6 +103,7 @@ module NetCDF_mod !redefined (in case several routines are using ncFileID_new !with different filename_given) integer,save :: ncFileID_iou(IOU_INST:IOU_HOUR_INST)=closedID +integer,save :: LF_ncFileID_iou(IOU_INST:IOU_HOUR_INST)=closedID integer,save :: outCDFtag=0 !CDF types for output: integer, public, parameter :: Int1=1,Int2=2,Int4=3,Real4=4,Real8=5 @@ -230,7 +231,7 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& real :: kcoord(KMAXcdf+1) real :: Acdf(KMAXcdf),Bcdf(KMAXcdf),Aicdf(KMAXcdf+1),Bicdf(KMAXcdf+1) integer,parameter :: MAX_String_length=36 - character(len=100) :: auxL(4) + character(len=TXTLEN_File) :: auxL(4) character(len=MAX_String_length) :: metaName,metaType,auxC(NStations) integer :: auxI(NStations),ierr real :: auxR(NStations) @@ -311,6 +312,8 @@ subroutine Create_CDF_sondes(fileName,NSpec,NSpec_Att,SpecDef,& call wordsplit(trim(MetaData(0,n)),3,auxL,k,ierr,strict_separator=':') call CheckStop(3,k,& "NetCDF_mod: too short metadata definition "//trim(MetaData(0,n))) + call CheckStop(ierr /= 0, & + "NetCDF_mod: wordsplit error:: "//trim(MetaData(0,n))) select case(auxL(2)) case("c","C","s","S") ! string/char attribute call check(nf90_put_att(ncFileID,nf90_global,trim(auxL(1)),trim(auxL(3))),& @@ -1870,6 +1873,11 @@ subroutine CloseNetCDF call check(nf90_close(ncFileID)) ncFileID_iou(i)=closedID end if + ncFileID=LF_ncFileID_iou(i) + if(ncFileID/=closedID)then + call check(nf90_close(ncFileID)) + LF_ncFileID_iou(i)=closedID + end if end do end if end subroutine CloseNetCDF @@ -3520,23 +3528,16 @@ subroutine ReadField_CDF(fileName,varname,Rvar,nstart,kstart,kend,interpol, & if(ig>dims(1))ig=ig-dims(1) endif endif - if(ig<0.5 .or. ig>dims(1))then - if(present(UnDef))then - Rvar(ijk)=UnDef_local - else - write(*,*)me,i,j,k,glon(i,j),glat(i,j),ig - call StopAll("ReadField_CDF: values outside grid required "//trim(varname)//" "//trim(filename)) - endif + !nearest must always give something + ig=max(1,min(dims(1),ig)) + jg=max(1,min(dims(2),nint((glat(i,j)-Rlat(startvec(2)))*dRlati)+1)) + igjgk=ig+(jg-1)*dims(1)+(k-1)*dims(1)*dims(2) + if(OnlyDefinedValues.or.(Rvalues(igjgk)/=FillValue.and. .not.isnan(Rvalues(igjgk))))then + Rvar(ijk)=Rvalues(igjgk) else - ig=max(1,min(dims(1),ig)) - jg=max(1,min(dims(2),nint((glat(i,j)-Rlat(startvec(2)))*dRlati)+1)) - igjgk=ig+(jg-1)*dims(1)+(k-1)*dims(1)*dims(2) - if(OnlyDefinedValues.or.(Rvalues(igjgk)/=FillValue.and. .not.isnan(Rvalues(igjgk))))then - Rvar(ijk)=Rvalues(igjgk) - else - Rvar(ijk)=UnDef_local - end if - endif + Rvar(ijk)=UnDef_local + end if + end do end do end do diff --git a/NumberConstants.f90 b/NumberConstants.f90 index 612ecf0..e6a10f4 100644 --- a/NumberConstants.f90 +++ b/NumberConstants.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/OutputChem_mod.f90 b/OutputChem_mod.f90 index d0ab8f4..2f56390 100644 --- a/OutputChem_mod.f90 +++ b/OutputChem_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -47,7 +47,7 @@ module OutputChem_mod use TimeDate_mod, only: tdif_secs,date,timestamp,make_timestamp,current_date, max_day &! days in month ,daynumber,add2current_date,date use TimeDate_ExtraUtil_mod,only: date2string, date_is_reached -use uEMEP_mod, only: out_uEMEP +use LocalFractions_mod, only: lf_out use Units_mod, only: Init_Units implicit none @@ -229,8 +229,8 @@ subroutine Output_fields(iotyp) call CloseNetCDF !uemep use own outputting for now, since it has several extra dimensions - if(USES%uEMEP)then - call out_uEMEP(iotyp) + if(USES%LocalFractions)then + call lf_out(iotyp) endif ! Write text file to mark output is finished diff --git a/OwnDataTypes_mod.f90 b/OwnDataTypes_mod.f90 index dccc21f..b492335 100644 --- a/OwnDataTypes_mod.f90 +++ b/OwnDataTypes_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -206,11 +206,12 @@ module OwnDataTypes_mod !================== ! uEMEP parameters -integer, public, parameter :: Npoll_uemep_max=7 !max number of uEMEP pollutant -integer, public, parameter :: Nsector_uemep_max=10 !max number of sectors for each uEMEP pollutant +integer, public, parameter :: Npoll_lf_max=7 !max number of lf pollutant +integer, public, parameter :: Nsector_lf_max=13 !max number of sectors for each lf pollutant +integer, public, parameter :: Size_Country_list=100 !max number of countries for each lf pollutant type, public :: poll_type character(len=4):: emis='none' ! one of EMIS_File: "sox ", "nox ", "co ", "voc ", "nh3 ", "pm25", "pmco" - integer, dimension(Nsector_uemep_max) ::sector=-1 ! sectors to be included for this pollutant. Zero is sum of all sectors + integer, dimension(Nsector_lf_max) ::sector=-1 ! sectors to be included for this pollutant. Zero is sum of all sectors integer :: EMIS_File_ix = 0 !index in EMIS_File (set by model) integer :: Nsectors = 0 !set by model integer :: sec_poll_ishift = 0 !The start of index for isec_poll loops @@ -316,12 +317,13 @@ module OwnDataTypes_mod end type emis_in type, public :: uEMEP_type + integer :: Nsrc=0 !number of distinct source to include integer :: Npoll=0 ! Number of pollutants to treat in total integer :: Nsec_poll=1 ! Number of sector and pollutants to treat in total integer :: dist=0 ! max distance of neighbor to include. (will include a square with edge size=2*dist+1) integer :: Nvert=20 ! number of k levels to include integer :: DOMAIN(4) = -999 - type(poll_type) :: poll(Npoll_uemep_max) !pollutants to include + type(poll_type) :: poll(Npoll_lf_max) !pollutants to include logical :: YEAR =.true.! Output frequency logical :: MONTH =.false. character(len=40):: MONTH_ENDING = "NOTSET" @@ -331,6 +333,42 @@ module OwnDataTypes_mod logical :: COMPUTE_LOCAL_TRANSPORT=.false. end type uEMEP_type +type, public :: lf_sources + character(len=TXTLEN_NAME) :: species = 'NONE' !pollutants to include + character(len=TXTLEN_NAME) :: type = 'relative' !Qualitatively different type of sources: "coarse", "relative", "country" + integer :: dist = -1 ! window dimension, if defined + integer :: Nvert = -1 ! vertical extend of the tracking/local rwindow + integer :: sector= -1 ! sector for this source. Zero is sum of all sectors + integer :: poll = 1 !index of pollutant in loc_tot (set by model) + integer :: start = 1 ! first position index in lf_src (set by model) + integer :: end = 1 ! last position index in lf_src (set by model) + integer :: iem = 0 ! index of emitted pollutant, emis (set by model) + integer :: Npos = 0 ! number of position indices in lf_src (set by model) + integer :: Nsplit = 0 ! into how many species the emitted pollutant is split into (set by model) + integer :: species_ix = -1 !species index, if single pollutant (for example NO or NO2, instead of nox) + integer :: iqrc = -1 !index for emissplits, if single pollutant (for example NO or NO2, instead of nox) + integer, dimension(4) :: DOMAIN = -1 ! DOMAIN which will be outputted + integer, dimension(15) :: ix = -1 ! internal index of the (splitted) species (set by model) + real, dimension(15) :: mw=0.0 ! molecular weight of the (splitted) species (set by model) + character(len=TXTLEN_NAME) :: country_ISO = 'NOTSET' !country name, for example FR for France, as defined in Country_mod + integer :: country_ix = -1 !Internal country index. Does not have any meaning outside of code + logical :: DryDep = .false. ! if drydep is to be outputed + logical :: WetDep = .false. ! if wetdep is to be outputed + logical :: YEAR =.true.! Output frequency + logical :: MONTH =.false. + character(len=40):: MONTH_ENDING = "NOTSET" + logical :: DAY =.false. + logical :: HOUR =.false. + logical :: HOUR_INST =.false. +end type lf_sources + +integer, parameter, public :: MAX_lf_country_group_size = 50 !max 50 countries in each group +type, public :: lf_country_group_type + character(len=TXTLEN_NAME) :: name = 'NOTSET' !the overall name of the group (for example 'EU') + character(len=10), dimension(MAX_lf_country_group_size):: list = 'NOTSET' ! list of countries inside the group + integer, dimension(MAX_lf_country_group_size):: ix = -1 ! index of the country as defined in Country_ml (set by model) +end type lf_country_group_type + contains !========================================================================= subroutine print_Asc2D(w) diff --git a/Par_mod.f90 b/Par_mod.f90 index d07b23e..28edb1a 100644 --- a/Par_mod.f90 +++ b/Par_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/PhyChem_mod.f90 b/PhyChem_mod.f90 index 9f1e359..cc5ad27 100644 --- a/PhyChem_mod.f90 +++ b/PhyChem_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -32,7 +32,7 @@ module PhyChem_mod ! Output of hourly data ! !----------------------------------------------------------------------------- -use Advection_mod, only: advecdiff_poles,advecdiff_Eta!,adv_int +use Advection_mod, only: advecdiff_Eta use Biogenics_mod, only: Set_SoilNOx use CheckStop_mod, only: CheckStop use Chemfields_mod, only: xn_adv,cfac,xn_shl @@ -88,7 +88,7 @@ module PhyChem_mod use TimeDate_ExtraUtil_mod,only : date2string use Timefactors_mod, only: NewDayFactors use Trajectory_mod, only: trajectory_out ! 'Aircraft'-type outputs -use uEMEP_mod, only: uEMEP_emis +use LocalFractions_mod, only: lf_emis !----------------------------------------------------------------------------- implicit none @@ -155,10 +155,6 @@ subroutine phyche() end if end if - call EmisSet(current_date) - - call Add_2timing(12,tim_after,tim_before,"phyche:EmisSet") - ! For safety we initialise instant. values here to zero. ! Usually not needed, but sometimes ! ======================== @@ -199,12 +195,8 @@ subroutine phyche() call Code_timer(tim_before0) - if(USES%EtaCOORDINATES)then - call advecdiff_Eta - else - call advecdiff_poles - end if - + call advecdiff_Eta + call Add_2timing(13,tim_after,tim_before0,"phyche: total advecdiff") if(USES%ASH) call gravset @@ -228,9 +220,13 @@ subroutine phyche() call init_drydep() !=================================== + call EmisSet(current_date) + + call Add_2timing(12,tim_after,tim_before,"phyche:EmisSet") + call Code_timer(tim_before0) !must be placed just before emissions are used - if(USES%uEMEP)call uemep_emis(current_date) + if(USES%LocalFractions)call lf_emis(current_date) !=========================================================! call debug_concs("PhyChe pre-chem ") diff --git a/PhysicalConstants_mod.f90 b/PhysicalConstants_mod.f90 index 55eddaa..83da1a5 100644 --- a/PhysicalConstants_mod.f90 +++ b/PhysicalConstants_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/PlumeRise_mod.f90 b/PlumeRise_mod.f90 index 204a935..c6f80d8 100644 --- a/PlumeRise_mod.f90 +++ b/PlumeRise_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/PointSource_mod.f90 b/PointSource_mod.f90 index 2d665ca..3ee5162 100644 --- a/PointSource_mod.f90 +++ b/PointSource_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Pollen_const_mod.f90 b/Pollen_const_mod.f90 index 958a564..dcc0e18 100644 --- a/Pollen_const_mod.f90 +++ b/Pollen_const_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Pollen_mod.f90 b/Pollen_mod.f90 index 63de7a6..6819363 100644 --- a/Pollen_mod.f90 +++ b/Pollen_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Precision_mod.f90 b/Precision_mod.f90 index 3894453..2ddd65e 100644 --- a/Precision_mod.f90 +++ b/Precision_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Radiation_mod.f90 b/Radiation_mod.f90 index c7eb8eb..756a966 100644 --- a/Radiation_mod.f90 +++ b/Radiation_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Rsurface_mod.f90 b/Rsurface_mod.f90 index 751b1ac..df6211b 100644 --- a/Rsurface_mod.f90 +++ b/Rsurface_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Runchem_mod.f90 b/Runchem_mod.f90 index 00cb149..a5b11ba 100644 --- a/Runchem_mod.f90 +++ b/Runchem_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -60,6 +60,7 @@ module RunChem_mod use FastJ_mod, only: setup_phot_fastj,phot_fastj_interpolate use GridValues_mod, only: debug_proc, debug_li, debug_lj, i_fdom, j_fdom use Io_Progs_mod, only: datewrite + use LocalFractions_mod,only: lf_chem,lf_aero_pre,lf_aero_pos use MassBudget_mod, only: emis_massbudget_1d use OrganicAerosol_mod,only: ORGANIC_AEROSOLS, OrganicAerosol, & Init_OrganicAerosol, & @@ -210,6 +211,7 @@ subroutine runchem() if(DEBUG%RUNCHEM) call check_negs(i,j,'B') call Add_2timing(28,tim_after,tim_before,"Runchem:other setups") + ! if(DEBUG%RUNCHEM.and.debug_flag) & ! call datewrite("RUNCHEM PRE-CHEM",(/xn_2d(PPM25,20),xn_2d(AER_BGNDOC,20)/)) ! !------------------------------------------------- @@ -218,11 +220,13 @@ subroutine runchem() if( .not. USES%NOCHEM) then call chemistry(i,j,DEBUG%RUNCHEM.and.debug_flag) - else + else xn_2d(NSPEC_SHL+1:NSPEC_TOT,:) = xn_2d(NSPEC_SHL+1:NSPEC_TOT,:) & +rcemis(NSPEC_SHL+1:NSPEC_TOT,:)*dt_advec end if + if(USES%LocalFractions) call lf_chem(i,j) + if(DEBUG%RUNCHEM) call check_negs(i,j,'C') ! !------------------------------------------------- ! !------------------------------------------------- @@ -255,8 +259,10 @@ subroutine runchem() ! Alternating Dry Deposition and Equilibrium chemistry ! Check that one and only one eq is chosen - if(mod(step_main,2)/=0) then + if(mod(step_main,2)/=0) then + if(USES%LocalFractions) call lf_aero_pre(i,j) call AerosolEquilib(debug_flag) + if(USES%LocalFractions) call lf_aero_pos(i,j) call Add_2timing(30,tim_after,tim_before,"Runchem:AerosolEquilib") if(DEBUG%RUNCHEM) call check_negs(i,j,'D') !if(AERO%EQUILIB=='EMEP' ) call ammonium() @@ -269,7 +275,9 @@ subroutine runchem() call DryDep(i,j) call Add_2timing(31,tim_after,tim_before,"Runchem:DryDep") if(DEBUG%RUNCHEM) call check_negs(i,j,'F') + if(USES%LocalFractions) call lf_aero_pre(i,j) call AerosolEquilib(debug_flag) + if(USES%LocalFractions) call lf_aero_pos(i,j) call Add_2timing(30,tim_after,tim_before,"Runchem:AerosolEquilib") if(DEBUG%RUNCHEM) call check_negs(i,j,'G') !if(AERO%EQUILIB=='EMEP' ) call ammonium() @@ -303,7 +311,8 @@ subroutine runchem() else call Aero_water_MARS(i,j, debug_flag) endif - + + call check_negs(i,j,'END') if(i>=li0.and.i<=li1.and.j>=lj0.and.j<=lj1) then diff --git a/SOA_mod.f90 b/SOA_mod.f90 index 5919be9..ec80152 100644 --- a/SOA_mod.f90 +++ b/SOA_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/SeaSalt_mod.f90 b/SeaSalt_mod.f90 index b58ecdc..f4ac3fc 100644 --- a/SeaSalt_mod.f90 +++ b/SeaSalt_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Setup_1d_mod.f90 b/Setup_1d_mod.f90 index 06f6656..7ceacb5 100644 --- a/Setup_1d_mod.f90 +++ b/Setup_1d_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Sites_mod.f90 b/Sites_mod.f90 index d782bac..e25b493 100644 --- a/Sites_mod.f90 +++ b/Sites_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -49,20 +49,20 @@ module Sites_mod NXTRA_SONDE, & SONDE_XTRA, & FREQ_SONDE -use Debug_module, only: DEBUG ! -> DEBUG%SITES +use Debug_module, only: DEBUG ! -> DEBUG%SITES, DEBUG%SITE use DerivedFields_mod, only: f_2d, d_2d ! not used:, d_3d use Functions_mod, only: Tpot_2_T ! Conversion function use GridValues_mod, only: lb2ij, i_fdom, j_fdom ,debug_proc & - ,i_local, j_local, A_mid, B_mid + ,i_local, j_local, A_mid, B_mid, z2level_stdatm use Io_mod, only: check_file,open_file,ios & , fexist, IO_SITES, IO_SONDES & , Read_Headers,read_line use KeyValueTypes, only : KeyVal, KeyValue, LENKEYVAL use MetFields_mod, only : t2_nwp, th, pzpbl & ! output with concentrations , z_bnd, z_mid, roa, Kz_m2s, q -use MetFields_mod, only : u_xmj, v_xmi, ps +use MetFields_mod, only : u_xmj, v_xmi, ps, model_surf_elevation use MPI_Groups_mod, only : MPI_BYTE, MPI_DOUBLE_PRECISION, MPI_REAL8, MPI_INTEGER, MPI_LOGICAL, & - MPI_MIN, MPI_MAX, MPI_SUM, & + MPI_MIN, MPI_MAX, MPI_SUM, MPI_ANY_SOURCE,& MPI_COMM_CALC, MPI_COMM_WORLD, MPISTATUS, IERROR, ME_MPI, NPROC_MPI use PhysicalConstants_mod,only: ATWAIR use NetCDF_mod, only : Create_CDF_sondes,Out_CDF_sondes,& @@ -71,15 +71,14 @@ module Sites_mod use Par_mod, only : li0,lj0,li1,lj1 & ,GIMAX,GJMAX,IRUNBEG,JRUNBEG& ,GI0,GI1,GJ0,GJ1,me,LIMAX,LJMAX -use SmallUtils_mod, only : find_index +use SmallUtils_mod, only : find_index !, str_replace use Tabulations_mod, only : tab_esat_Pa -use TimeDate_mod, only : current_date +use TimeDate_mod, only : current_date, print_date use TimeDate_ExtraUtil_mod, only : date2string implicit none private ! stops variables being accessed outside - ! subroutines made available public :: sitesdef ! Calls Init_sites for sites and sondes @@ -101,25 +100,34 @@ module Sites_mod integer, public, save, dimension (NSITES_MAX) :: & site_x, site_y, site_z &! local coordinates + ,site_alt, site_topo &! LLZ system , site_gn ! number in global real, public, save, dimension (NSITES_MAX) :: & + site_glon = -999, site_glat= -999, & ! Same as next line? Sites_lon= -999, Sites_lat= -999 integer, private, save, dimension (NSITES_MAX) :: & site_gx, site_gy, site_gz ! global coordinates +integer, private, save, dimension (NSITES_MAX) :: & + site_galt, site_gtopo ! for LonLatZ topo system integer, private, save, dimension (NSONDES_MAX) :: & sonde_gx, sonde_gy & ! global coordinates , sonde_x, sonde_y & ! local coordinates , sonde_gn ! number in global real, public, save, dimension (NSONDES_MAX) :: & + sonde_glon = -999, sonde_glat= -999, & ! Same as next line? Sondes_lon= -999, Sondes_lat= -999, ps_sonde=0.0 integer, private :: NSPC_SITE, NOUT_SITE, NOUT_SONDE, NSPC_SONDE -character(len=TXTLEN_NAME), public, save, dimension(NSITES_MAX) :: site_name -character(len=TXTLEN_NAME), private, save, dimension(NSONDES_MAX):: sonde_name +! Allow wide text strings here to allow addition of lat/lon info +integer, private, parameter :: TXTLEN_SITE=80 +character(len=TXTLEN_SITE), public, save, dimension(NSITES_MAX) :: site_name +character(len=TXTLEN_SITE), private, save, dimension(NSONDES_MAX):: sonde_name character(len=20), private, save, allocatable, dimension(:) :: site_species character(len=20), private, save, allocatable, dimension(:) :: sonde_species +character(len=20), private, save, dimension(2):: sCoords !(1=sites,2=sondes) +integer, private, save :: nInitCalls = 0 ! for setting sCoords character(len=70), private :: errmsg ! Message text integer, private :: d ! processor index @@ -141,6 +149,11 @@ module Sites_mod integer, public, dimension(NSPEC_SHL) :: SONDE_SHL integer, public, dimension(NSPEC_ADV) :: SONDE_ADV + type(KeyVal), private, dimension(20) :: KeyValues ! Info on units, coords, etc. + + + logical, private, save :: dbgProc = .false. + contains !==================================================================== > @@ -192,19 +205,21 @@ subroutine sitesdef() call Init_sites(SitesFile,IO_SITES,NSITES_MAX, & nglobal_sites,nlocal_sites, & site_gindex, site_gx, site_gy, site_gz, & + site_glat, site_glon, & site_x, site_y, site_z, site_gn, & - site_name) + site_name, site_galt, site_gtopo,site_alt,site_topo) call Init_sites(SondesFile,IO_SONDES,NSONDES_MAX, & nglobal_sondes,nlocal_sondes, & sonde_gindex, sonde_gx, sonde_gy, sonde_gz, & + sonde_glat, sonde_glon, & sonde_x, sonde_y, sonde_z, sonde_gn, & sonde_name) ! call set_species(SITE_ADV,SITE_SHL,SITE_XTRA,site_species) ! call set_species(SONDE_ADV,SONDE_SHL,SONDE_XTRA,sonde_species) - if ( DEBUG%SITES ) then + if ( DEBUG%SITES .and. dbgProc ) then write(6,*) "sitesdef After nlocal ", nlocal_sites, " on me ", me do i = 1, nlocal_sites write(6,*) "sitesdef After set_species x,y ", & @@ -236,7 +251,8 @@ subroutine set_species(adv,shl,xtra,s) end subroutine set_species !==================================================================== > subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & - s_gindex, s_gx, s_gy, s_gz, s_x, s_y, s_z, s_n, s_name) + s_gindex, s_gx, s_gy, s_gz, s_glat, s_glon, & + s_x, s_y, s_z, s_n, s_name, s_galt,s_gtopo,s_alt,s_topo) ! ---------------------------------------------------------------------- ! Reads the file "sites.dat" and "sondes.dat" to get coordinates of ! surface measurement stations or locations where vertical profiles @@ -259,24 +275,31 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & ,s_x, s_y, s_z & ! local coordinates ,s_n ! number in global character(len=*), intent(out), dimension (:) :: s_name + real, intent(out), dimension (:) :: s_glat, s_glon ! lat/lon for output + integer, intent(out), dimension (:), optional :: & + s_alt, s_topo, s_galt, s_gtopo ! alt and topography in LonLatZ system !-- Local: integer, dimension (NMAX) :: s_n_recv ! number in global - integer :: nin ! loop index + integer :: nin, dest! loop index integer :: ix, iy ! coordinates read in - integer :: lev ! vertical coordinate (20=ground) - character(len=20) :: s ! Name of site read in + integer :: lev ! vertical coordinate (20=ground if 20 levels) + real :: z ! station altitude above sea level for LatLonZ, or + ! or above local minima for LatLonHrel, in meters + real :: z_inp ! helper variable + real :: z_topo ! altitude above sea level of surface, as assumed by meteo + character(len=TXTLEN_SITE) :: s ! Name of site read in ! currently 64 character(len=30) :: comment ! comment on site location - character(len=40) :: errmsg + character(len=60) :: errmsg, coords real :: lat,lon character(len=*),parameter :: dtxt='SitesInit:' character(len=20), dimension(4) :: Headers - type(KeyVal), dimension(20) :: KeyValues ! Info on units, coords, etc. - integer :: NHeaders, NKeys + integer :: NHeaders, NKeys, iif, jjf character(len=80) :: txtinput ! Big enough to contain ! one full input record + logical :: dbgSite = .false. ios = 0 ! zero indicates no errors @@ -302,21 +325,98 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & n = 0 ! Number of sites found within domain + nInitCalls = nInitCalls + 1 + sCoords(nInitCalls) = KeyValue(KeyValues,"Coords") + coords = KeyValue(KeyValues,"Coords") ! shorthand + SITELOOP: do nin = 1, NMAX - if (trim(KeyValue(KeyValues,"Coords"))=='LatLong') then - call read_line(io_num,txtinput,ios) - if ( ios /= 0 ) exit ! End of file + z_topo = -9999. + z_inp = -9999. + z = -9999. + + call read_line(io_num,txtinput,ios) ! done on host, broadcast + if ( ios /= 0 ) exit ! End of file + !if(MasterProc) write(*,*) 'STRA', trim(txtinput) + !FAILED txtinput= str_replace(txtinput,' ',' ',dbg=.true.) ! compress a little + !if(MasterProc) write(*,*) 'STRB', trim(txtinput) + dbgSite = ( DEBUG%SITES .and. index( txtinput, DEBUG%SITE ) > 0 ) + + if ( MasterProc .and. dbgSite ) then + write(*,"(a,i3,a,2i3,4a)") dtxt// trim(fname) + write(*,'(a)') dtxt//' coords:'// trim(coords) + write(*,*) dtxt//'INPUT dbgSite:'//trim(txtinput) + end if + + if ( coords =='LatLong' .or. & ! older naming system, deprecated + coords =='LatLonKdown') then read(unit=txtinput,fmt=*) s, lat, lon, lev call lb2ij(lon,lat,ix,iy) - else - call read_line(io_num,txtinput,ios) + if ( MasterProc .and. dbgSite ) write(*,*) dtxt//'LLKD:', nin, lat, lon, ix, iy + else if (coords =='LatLonZ' .or. coords =='LatLonHrel') then + ! Z is given as altitude above sea level or (Hrel) local minima + read(unit=txtinput,fmt=*) s, lat, lon, z_inp + call lb2ij(lon,lat,ix,iy) + if ( MasterProc .and. dbgSite ) write(*,'(a,i4,2f8.3,2i4)') dtxt//'LLZH',& + nin, lat, lon, ix, iy + if ( ixRUNDOMAIN(2) .or. & + iyRUNDOMAIN(4) ) then !outside rundomain + lev = 0 ! Dummy val, not used + else + if(i_local(ix)>0 .and. i_local(ix)<=LIMAX& + .and. j_local(iy)>0 .and. j_local(iy)<=LJMAX ) then + z_topo = model_surf_elevation(i_local(ix),j_local(iy)) + do dest = 0, NPROC-1 + if(dest == me) cycle + call MPI_SEND(z_topo, 8,MPI_BYTE,dest,nin,MPI_COMM_CALC,IERROR) + enddo + else + call MPI_RECV(z_topo, 8, MPI_BYTE, MPI_ANY_SOURCE, nin, & + MPI_COMM_CALC,MPISTATUS,IERROR) + endif + ! If relative heighs are given, we assume that they are relative to NWP + ! topo. Not perfect, but we can't be perfect. This will ensure that + ! all Hrel in lowest 50-100m end up at KMAX_MID + if ( coords =='LatLonHrel') then + z = max(z_inp,0.0)+z_topo + else + z = z_inp ! LatLonZ + end if + call z2level_stdatm(z, z_topo, lev) + if(DEBUG%SITES .and. dbgProc) write(*,'(a,2f8.1,i4)')& + dtxt//' Z2LEV'//trim(txtinput), z, z_topo, lev + !if ( dbgSite .and. MasterProc ) write(*,'(a,3i4,2f8.3)') 'CFAC Z2', me, ix,iy,z_inp, z + endif + else if ( coords =='IJKdown' ) then ! Gices ix iy directly lon=-999.0 lat=-999.0 - if ( ios /= 0 ) exit ! End of file read(unit=txtinput,fmt=*) s, ix, iy, lev + if ( MasterProc .and. dbgSite ) write(*,*) dtxt//' CCCC', nin, lat, lon, ix, iy + else + errmsg="!!!! Allowed: LatLonKdown, LatLonZ, LatLonHrel, IJKdown" + call StopAll(dtxt//'Coordinates unkown:'//trim(coords)//errmsg) end if + if ( ixRUNDOMAIN(2) .or. & + iyRUNDOMAIN(4) ) then !outside rundomain + if(MasterProc) write(*,*) dtxt//trim(s)//' outside domain!' + cycle + end if + if(dbgSite .and. i_local(ix)>0 .and. i_local(ix)<=LIMAX& + .and. j_local(iy)>0 .and. j_local(iy)<=LJMAX ) then + write(*,'(a,5i4)') 'CFAC FOUND dbgSite'//trim(s),me,ix,iy,i_local(ix),j_local(iy) + dbgProc = .true. + end if + ! Didn't work with s here. Not sure why. Go via s2 + call CheckStop(len_trim(adjustl(s)) >= 40, dtxt//'Need longer TXTLEN_SITE for '//trim(s)) + + if (lev<0) lev = KMAX_MID + if(lev>KMAX_MID)then + write(*,*)'WARNING: sites.dat found vertical level out of range. Setting to ',KMAX_MID + write(*,*)'WARNING: vertical level out of range'//trim(txtinput), me + endif + lev = min(lev,KMAX_MID) + if (ioerr < 0) then write(6,*) dtxt//" end of file after ", nin-1, trim(fname) exit SITELOOP @@ -334,13 +434,29 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & else comment = " ok - inside domain " n = n + 1 + if ( dbgSite .and. dbgProc) & + write(*,'(a,5i4,2f11.3)') dtxt//'dbgSite XY',me, n, ix,iy,lev,lat,lon s_gx(n) = ix s_gy(n) = iy s_gz(n) = lev + s_glat(n) = lat + s_glon(n) = lon + + + if ( present(s_gtopo)) then + if ( z_topo> -888 ) then + s_galt(n) = z_inp + s_gtopo(n) = z_topo + else + s_galt(n) = z_inp + s_gtopo(n) = -999 + end if + end if + if(trim(fname)==trim(SitesFile))then - if(lon>-990)Sites_lon(n) = lon + if(lon>-990)Sites_lon(n) = lon ! QUERY. Same as s_glon?? if(lat>-990)Sites_lat(n) = lat end if if(trim(fname)==trim(SondesFile))then @@ -348,14 +464,18 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & if(lat>-990)Sondes_lat(n) = lat end if - s_name(n) = s !!! remove comments// comment - if (DEBUG%SITES.and.MasterProc) write(6,"(a,i4,a)") dtxt//" s_name : ",& - n, trim(s_name(n)) + s_name(n) = s !!! remove comments// comment len_trim=60 here + if (DEBUG%SITES.and.dbgProc)then + write(6,"(a,3i4,1x,a)") dtxt//" s_name : ",& + nin, n, me, trim(s_name(n)) + if ( coords =='LatLonZ') & + write(*,*)z,' m height converted to level ',lev,', z_topo=', z_topo + endif end if end do SITELOOP - nglobal = n + nglobal = n ! same on each processor ! NSITES/SONDES_MAX must be _greater_ than the number used, for safety @@ -369,6 +489,7 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & ix = s_gx(n) ! global-domain coords iy = s_gy(n) + dbgSite = ( DEBUG%SITES .and. index(s_name(n), DEBUG%SITE ) > 0 ) if ( i_local(ix)>=li0 .and. i_local(ix)<=li1 .and. & j_local(iy)>=lj0 .and. j_local(iy)<=lj1 ) then @@ -378,28 +499,34 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & s_y(nlocal) = j_local(iy) s_z(nlocal) = s_gz(n) s_n(nlocal) = n + if ( present(s_gtopo) ) then + s_alt(nlocal) = s_galt(n) + s_topo(nlocal) = s_gtopo(n) + end if - if (DEBUG%SITES) & - write(6,"(a,i3,a,2i3,3i4,a,3i4)") dtxt//" Site on me : ", me, & + !if (DEBUG%SITES ) & + if ( dbgSite ) then + write(6,"(a,i3,a,2i3,3i4,a,3i4)") dtxt//" dbgSite on me : ", me, & " Nos. ", n, nlocal, s_gx(n), s_gy(n) , s_gz(n), " => ", & s_x(nlocal), s_y(nlocal), s_z(nlocal) - write(6,"(a,i3,a,2i3,4a)") dtxt// trim(fname), me, & + write(6,"(a,i3,a,2i3,4a)") dtxt//'Names?' , me, & " Nos. ", n, nlocal, " ", trim(s_name(n)), " => ", trim(s_name(s_n(nlocal))) + end if end if end do ! nglobal ! inform me=0 of local array indices: - if(DEBUG%SITES) write(6,*) dtxt//trim(fname), " before gc NLOCAL_SITES", & - me, nlocal + !if(DEBUG%SITES) write(6,'(a,2i4)') dtxt// & + if(dbgProc) write(6,'(a,2i4)') dtxt//" before gc NLOCAL_SITES", me, nlocal if ( .not.MasterProc ) then call MPI_SEND(nlocal, 4*1, MPI_BYTE, 0, 333, MPI_COMM_CALC, IERROR) if(nlocal>0) call MPI_SEND(s_n, 4*nlocal, MPI_BYTE, 0, 334, & MPI_COMM_CALC, IERROR) else - if(DEBUG%SITES) write(6,*) dtxt//" for me =0 LOCAL_SITES", me, nlocal + if(DEBUG%SITES) write(6,'(a,2i4)')dtxt//" for me=0 LOCAL_SITES",me,nlocal do n = 1, nlocal s_gindex(me,n) = s_n(n) end do @@ -407,17 +534,19 @@ subroutine Init_sites(fname,io_num,NMAX, nglobal,nlocal, & call MPI_RECV(nloc, 4*1, MPI_BYTE, d, 333, MPI_COMM_CALC,MPISTATUS, IERROR) if(nloc>0) call MPI_RECV(s_n_recv, 4*nloc, MPI_BYTE, d, 334, & MPI_COMM_CALC,MPISTATUS, IERROR) - if(DEBUG%SITES) write(6,*) dtxt//" recv d ", fname, d, & - " zzzz nloc : ", nloc, " zzzz me0 nlocal", nlocal + !if(DEBUG%SITES) write(6,'(3(a,i4))') dtxt//" recv d ", d,& + ! " zzzz nloc : ", nloc, " zzzz me0 nlocal", nlocal do n = 1, nloc s_gindex(d,n) = s_n_recv(n) - if(DEBUG%SITES) write(6,*) dtxt//" for d =", fname, d, & - " nloc = ", nloc, " n: ", n, " gives nglob ", s_gindex(d,n) + !if(DEBUG%SITES) write(6,'(4(a,i4))') " nloc = ", nloc, " n: ", n, & + if(dbgProc) write(6,'(4(a,i4))') " nloc = ", nloc, " n: ", n, & + " gives nglob ", s_gindex(d,n) end do ! n end do ! d end if ! MasterProc - if ( DEBUG%SITES ) write(6,*) dtxt//' on me', me, ' = ', nlocal + !if ( DEBUG%SITES .and. nlocal>0 ) write(6,*) dtxt//trim(fname)//' done', me, ' = ', nlocal + if ( dbgProc ) write(6,*) dtxt//trim(fname)//' done', me, ' = ', nlocal end subroutine Init_sites !==================================================================== > @@ -442,20 +571,21 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) character(len=*),parameter :: dtxt = 'siteswrt_surf:' real,dimension(NOUT_SITE,NSITES_MAX) :: out ! for output, local node + logical :: dbgSite - if ( DEBUG%SITES ) then + if ( dbgProc ) then ! DEBUG%SITES ) then write(6,*) dtxt//"nlocal ", nlocal_sites, " on me ", me do i = 1, nlocal_sites - write(6,*) dtxt//"x,y ",site_x(i),site_y(i),& - site_z(i)," me ", me + write(6,'(a,4i6,a,i4)') dtxt//"x,y ",site_x(i),site_y(i),& + site_z(i),site_alt(i), " me ", me end do if ( MasterProc ) then write(6,*) "======= site_gindex ======== sitesdef ============" do n = 1, nglobal_sites write(6,*) dtxt//"def ", n, NPROC, (site_gindex(d,n),d=0,4) - write(6,'(a12,i4,2x,200i4)') dtxt//"def ", n, & - (site_gindex(d,n),d=0,NPROC-1) + !write(6,'(a,i4,2x,200i4)') dtxt//"def ", n, & + ! (site_gindex(d,n),d=0,NPROC-1) end do write(6,*) "======= site_end ======== sitesdef ============" end if ! MasterProc @@ -466,17 +596,27 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) i_Att=0 NSpec_Att=1 !number of Spec attributes defined do i = 1, nlocal_sites + ix = site_x(i) iy = site_y(i) iz = site_z(i) if( iz == 0 ) iz = KMAX_MID ! If ZERO'd, skip surface correction + dbgSite = ( DEBUG%SITES .and. index(site_name(site_gn(i)),DEBUG%SITE) > 0 ) + if ( dbgSite .and. my_first_call ) write(*,'(a,6i4,L2)') dtxt//& + 'DBGSITE FOUND '// trim(site_name(site_gn(i))), me,i,site_gn(i),ix,iy,iz,dbgProc + i_Att=0 do ispec = 1, NADV_SITE !if (iz == KMAX_MID ) then ! corrected to surface if (site_z(i) == KMAX_MID ) then ! corrected to surface out(ispec,i) = xn_adv( SITE_ADV(ispec) ,ix,iy,KMAX_MID ) * & cfac( SITE_ADV(ispec),ix,iy) * PPBINV + if ( dbgSite .and. species_adv(SITE_ADV(ispec))%name=='O3') & + write(*,'(a,3f12.4)') trim( & + dtxt//'ZZCFAC'//adjustl(species_adv(SITE_ADV(ispec))%name)), & + out(ispec,i), cfac( SITE_ADV(ispec),ix,iy), & + xn_adv( SITE_ADV(ispec) ,ix,iy,KMAX_MID )*PPBINV else ! Mountain sites not corrected to surface out(ispec,i) = xn_adv( SITE_ADV(ispec) ,ix,iy,iz ) * PPBINV end if @@ -505,8 +645,6 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) out(nn,i) = th(ix,iy,iz,1) i_Att=i_Att+1 Spec_Att(i_Att,1)='units:C:K' -! case("hmix") -! out(nn,i) = pzpbl(ix,iy) case default call CheckStop("Error, Sites_mod/siteswrt_surf: SITE_XTRA_MISC:"& // trim(SITE_XTRA_MISC(ispec))) @@ -533,9 +671,10 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) Spec_Att(i_Att,1)='units:C:'//trim(f_2d(d2index)%unit) end if - if( DEBUG%SITES ) & + if( dbgSite .and. my_first_call ) then ! DEBUG%SITES ) & write(6,"(a,3i4,a15,i4,es12.3)") dtxt//"D2DEBUG ", me, nn, i,& " "//trim(d2code), d2index, out(nn,i) + end if call CheckStop( abs(out(nn,i))>1.0e99, & dtxt//"ABS(SITES OUT: '"//trim(SITE_XTRA_D2D(ispec))//"') TOO BIG" ) end do @@ -545,9 +684,10 @@ subroutine siteswrt_surf(xn_adv,cfac,xn_shl) my_first_call = .false. ! collect data into gout on me=0 t call siteswrt_out("sites",IO_SITES,NOUT_SITE, FREQ_SITE, & - nglobal_sites,nlocal_sites, & - site_gindex,site_name,site_gx,site_gy,site_gz,& - site_species,out,ps_sonde) + nglobal_sites,nlocal_sites, site_gindex,site_name,& + site_gx,site_gy,site_gz,site_glat,site_glon, & + site_species,out,ps_sonde, & + site_galt,site_gtopo) end subroutine siteswrt_surf !==================================================================== > subroutine siteswrt_sondes(xn_adv,xn_shl) @@ -567,6 +707,7 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) integer, dimension(KMAX_MID) :: itemp real, dimension(KMAX_MID) :: pp, temp, qsat, rh, sum_PM, sum_NOy real, dimension(NOUT_SONDE,NSONDES_MAX):: out + character(len=*),parameter :: dtxt = 'siteswrt_sond:' out=0.0 ! Consistency check @@ -737,14 +878,14 @@ subroutine siteswrt_sondes(xn_adv,xn_shl) ! collect data into gout on me=0 t call siteswrt_out("sondes",IO_SONDES,NOUT_SONDE, FREQ_SONDE, & - nglobal_sondes,nlocal_sondes, & - sonde_gindex,sonde_name,sonde_gx,sonde_gy,sonde_gy, & + nglobal_sondes,nlocal_sondes, sonde_gindex,sonde_name,& + sonde_gx,sonde_gy,sonde_gy,sonde_glat,sonde_glon, & sonde_species,out,ps_sonde) end subroutine siteswrt_sondes !==================================================================== > subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & - s_gindex,s_name,s_gx,s_gy,s_gz,s_species,out,ps_sonde) + s_gindex,s_name,s_gx,s_gy,s_gz,s_glat,s_glon,s_species,out,ps_sonde,s_galt,s_gtopo) ! ------------------------------------------------------------------- ! collects data from local nodes and writes out to sites/sondes.dat ! ------------------------------------------------------------------- @@ -755,10 +896,12 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & integer, intent(in) :: nglobal, nlocal integer, intent(in), dimension (0:,:) :: s_gindex ! index, starts at me=0 character(len=*), intent(in), dimension (:) :: s_name ! site/sonde name - integer, intent(in), dimension (:) :: s_gx, s_gy, s_gz ! coordinates + integer, intent(in), dimension (:) :: s_gx, s_gy, s_gz ! coordinates + real, intent(in), dimension (:) :: s_glat,s_glon ! coordinates character(len=*), intent(in), dimension (:) :: s_species ! Variable names real, intent(in), dimension(:,:) :: out ! outputs, local node real, intent(in), dimension(:) :: ps_sonde ! surface pressure local node + integer, intent(in), dimension(:), optional :: s_galt, s_gtopo ! ! Local real,dimension(nout,nglobal) :: g_out ! for output, collected @@ -777,6 +920,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & integer :: Nlevels,ispec,NSPEC,NStations,NMetaData integer ::i_Att_MPI logical :: debug_1d=.false. + character(len=*),parameter :: dtxt = 'siteswrt_out:' select case (fname) case("sites") ;type=1 @@ -806,15 +950,24 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & outfile = fname // "_" // suffix // ".csv" open(file=outfile,unit=io_num,action="write",form='FORMATTED') - write(io_num,"(i3,2x,a,a, 4i4)") nglobal, fname, " in domain",RUNDOMAIN + write(io_num,"(i3,2x,a,a, 4i4, a)") nglobal, trim(fname), " in domain",& + RUNDOMAIN, ' sCoords: '// sCoords(type) write(io_num,"(i3,a)") f, " Hours between outputs" do n = 1, nglobal - write(io_num,'(a50,3(",",i4))') s_name(n), s_gx(n), s_gy(n),s_gz(n) + if ( present(s_gtopo) ) then ! max(s_gtopo>0) then + if(n==1) write(io_num,'(a4,37x,2(",",a8),5(",",a7))') 'name', & + 'lat', 'lon', 'ix','iy', 'iz', 'z_site', 'ztopo' + write(io_num,'(a40,2(",",f9.3),5(",",i7))') adjustl(s_name(n)), & + s_glat(n), s_glon(n), & + s_gx(n)-RUNDOMAIN(1)+1, s_gy(n)-RUNDOMAIN(3)+1,s_gz(n), & + s_galt(n), s_gtopo(n) + else + write(io_num,'(a56,3(",",i7))') s_name(n), & + s_gx(n)-RUNDOMAIN(1)+1, s_gy(n)-RUNDOMAIN(3)+1,s_gz(n) + end if end do ! nglobal write(io_num,'(i3,a)') size(s_species), " Variables units: ppb" - !MV write(io_num,'(a9,(",",a))')"site,date",(trim(s_species(i)),i=1,size(s_species)) - !MAY2019 write(io_num,'(9999a)')"site,date", (",", (trim(s_species(i)) ),i=1,size(s_species)) write(io_num,'(9999a)')"site,date,hh", (",", (trim(s_species(i)) ),i=1,size(s_species)) !defintions of file for NetCDF output @@ -937,7 +1090,7 @@ subroutine siteswrt_out(fname,io_num,nout,f,nglobal,nlocal, & call MPI_SEND(ps_sonde, 8*nlocal, MPI_BYTE, 0, 348, MPI_COMM_CALC, IERROR) else ! MasterProc ! first, assign me=0 local data to g_out - if ( DEBUG%SITES ) print *, "ASSIGNS ME=0 NLOCAL_SITES", me, nlocal + if ( DEBUG%SITES ) write(*,*) "ASSIGNS ME=0 NLOCAL_SITES", me, nlocal do n = 1, nlocal nglob = s_gindex(0,n) diff --git a/SmallUtils_mod.f90 b/SmallUtils_mod.f90 index 62b2189..a33d50a 100644 --- a/SmallUtils_mod.f90 +++ b/SmallUtils_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -111,6 +111,8 @@ subroutine wordsplit(text,nword_max,wordarray,nwords,errcode,separator,& keep_empty ! keep empty strings on request integer :: i, is, iw character(len=1) :: c,s(0:3) + character(len=*), parameter :: dtxt='Wordsplit:' + errcode = 0 wasinword = .false. !To be safe, with spaces at start of line @@ -132,7 +134,8 @@ subroutine wordsplit(text,nword_max,wordarray,nwords,errcode,separator,& is = is + 1 if ( is> len(wordarray) ) then !DSJJ errcode = 2 - print *, "ERROR in WORDSPLIT IS: ", trim(text(:i)) + write(*,*) dtxt//"ERROR: too short: ", trim(text(:i)) + write(*,*) dtxt//"ERROR: too short: ",i, is, len(wordarray) exit end if wordarray(iw)(is:is) = c @@ -144,8 +147,8 @@ subroutine wordsplit(text,nword_max,wordarray,nwords,errcode,separator,& is = 0 if(iw>nword_max ) then errcode = 2 - print *, "ERROR in WORDSPLIT : Problem at ", text - print *,"Too many words" + print *,dtxt//"ERROR: Problem at ", text + print *,dtxt//"Too many words" iw=iw-1 exit end if @@ -381,10 +384,14 @@ end function trims !============================================================================ ! Adapted from D. Frank code, string_functions ! Replaces 'text' in string s with 'rep' -function str_replace (s,text,rep) result(outs) +function str_replace (s,text,rep,dbg) result(outs) character(len=*) :: s,text,rep character(len=len(s)+100) :: outs ! provide outs with extra 100 char len integer :: i, nt, nr + logical, optional :: dbg + logical :: debug = .false. + + if ( present(dbg) ) debug=dbg outs = s nt = len_trim(text) @@ -392,6 +399,7 @@ function str_replace (s,text,rep) result(outs) do i = index(outs,text(:nt)) + !if ( debug) print *, 'STRi ', i, nt, len_trim(outs) if (i == 0) exit outs = outs(:i-1) // rep(:nr) // outs(i+nt:) end do diff --git a/Solver.f90 b/Solver.f90 index 92ad174..6c054ac 100644 --- a/Solver.f90 +++ b/Solver.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -85,6 +85,9 @@ module Chemsolver_mod integer, parameter:: NUM_INITCHEM=5 ! Number of initial time-steps with shorter dt real, save:: DT_INITCHEM=20.0 ! shorter dt for initial time-steps, reduced for integer, parameter :: EXTRA_ITER = 1 ! Set > 1 for even more iteration + real, public, dimension(:,:,:,:), save,allocatable :: & + Dchem ! Concentration increments due to chemistry + contains @@ -98,9 +101,6 @@ subroutine chemistry(i,j,debug_flag) integer, intent(in) :: i,j ! Coordinates (needed for Dchem) logical, intent(in) :: debug_flag - real, dimension(:,:,:,:), save,allocatable :: & - Dchem ! Concentration increments due to chemistry - logical, save :: first_call = .true. real(kind=dp), parameter :: CPINIT = 0.0 ! 1.0e-30 ! small value for init diff --git a/StoFlux_mod.f90 b/StoFlux_mod.f90 index 858c8bb..853565c 100644 --- a/StoFlux_mod.f90 +++ b/StoFlux_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/SubMet_mod.f90 b/SubMet_mod.f90 index 5a632ec..8d14113 100644 --- a/SubMet_mod.f90 +++ b/SubMet_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/TimeDate_ExtraUtil_mod.f90 b/TimeDate_ExtraUtil_mod.f90 index 423ee16..ac519cb 100644 --- a/TimeDate_ExtraUtil_mod.f90 +++ b/TimeDate_ExtraUtil_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/TimeDate_mod.f90 b/TimeDate_mod.f90 index 1a25afd..501168e 100644 --- a/TimeDate_mod.f90 +++ b/TimeDate_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Timefactors_mod.f90 b/Timefactors_mod.f90 index 23a9575..4a8d92d 100755 --- a/Timefactors_mod.f90 +++ b/Timefactors_mod.f90 @@ -109,7 +109,7 @@ module Timefactors_mod ! Hourly for each day ! From EURODELTA/INERIS real, public, save, allocatable, & - dimension(:,:,:,:) :: fac_ehh24x7 ! Hour factors for 7 days + dimension(:,:,:,:,:) :: fac_ehh24x7 ! Hour factors for 7 days ! We keep track of min value for degree-day work ! @@ -167,7 +167,7 @@ subroutine timefactors(year) character(len=200) :: inputline real :: fracchange real :: Start, Endval, Average, x, buff(12) - + if (DEBUG) write(unit=6,fmt=*) "into timefactors " call CheckStop( nydays < 365, & @@ -336,13 +336,17 @@ subroutine timefactors(year) if( idd == 0 ) then ! same values very day do idd2 = 1, 7 do ihh=1,24 - fac_ehh24x7(insec,ihh,idd2,:) = tmp24(ihh) + do iemis = 1, NEMIS_FILE + fac_ehh24x7(iemis,insec,ihh,idd2,:) = tmp24(ihh) + end do end do end do idd = 1 ! Used later else do ihh=1,24 - fac_ehh24x7(insec,ihh,idd,:) = tmp24(ihh) + do iemis = 1, NEMIS_FILE + fac_ehh24x7(iemis,insec,ihh,idd,:) = tmp24(ihh) + end do end do end if @@ -351,82 +355,96 @@ subroutine timefactors(year) ! Use sumfac for mean, and normalise within each day/sector ! (Sector 10 had a sum of 1.00625) !use first country to compute sumfac, since all countries have same factors here - sumfac = sum(fac_ehh24x7(insec,:,idd,1))/24.0 + sumfac = sum(fac_ehh24x7(1,insec,:,idd,1))/24.0 if(DEBUG .and. MasterProc) write(*,"(a,2i3,3f12.5)") & 'HOURLY-FACS mean min max', idd, insec, sumfac, & - minval(fac_ehh24x7(insec,:,idd,1)), & - maxval(fac_ehh24x7(insec,:,idd,1)) + minval(fac_ehh24x7(1,insec,:,idd,1)), & + maxval(fac_ehh24x7(1,insec,:,idd,1)) - fac_ehh24x7(insec,:,idd,:) = fac_ehh24x7(insec,:,idd,:) * 1.0/sumfac + do iemis = 1, NEMIS_FILE + fac_ehh24x7(iemis,insec,:,idd,:) = fac_ehh24x7(iemis,insec,:,idd,:) * 1.0/sumfac + end do ! if ( ios < 0 ) exit ! End of file end do - !do insec=1, 11; do idd =1, 7; do ihh =1, 24 - ! if( fac_ehh24x7(insec,ihh,idd) < 0.0 ) then - ! print *, "Unfilled ", insec, idd, ihh, fac_ehh24x7(insec,ihh,idd) - ! end if - !end do; end do; end do - !call CheckStop ( any(fac_ehh24x7 < 0.0 ) , "Unfilled efac_ehh24x7") + if (DEBUG) write(unit=6,fmt=*) "Read ", n, " records from ", fname2 call CheckStop ( any(fac_ehh24x7 < 0.0 ) , "Unfilled efac_ehh24x7") close(IO_TIMEFACS) -!3.1)Additional country specific hourly time factors - fname2 = trim(HourlyFacSpecialsFile)!"HOURLY-FACS-SPECIALS" ! - write(unit=6,fmt=*) "Starting HOURLY-FACS-SPECIALS" - call open_file(IO_TIMEFACS,"r",fname2,needed=.false.,iostat=ios) - if(ios==0)then - n = 0 - do - read(IO_TIMEFACS,"(a)",iostat=ios) inputline - n = n + 1 - if(DEBUG)write(*,*) "HourlyFacsSpecials ", n, trim(inputline) - if ( ios < 0 ) exit ! End of file - if( index(inputline,"#")>0 ) then ! Headers - if(n==1) call PrintLog(trim(inputline)) - cycle +!3.1)Additional country and species specific hourly time factors + do iemis = 1, NEMIS_FILE + fname2 = key2str(HourlyFacSpecialsFile,'POLL',trim (EMIS_FILE(iemis))) + write(unit=6,fmt=*) "Starting HOURLY-FACS-SPECIALS" + call open_file(IO_TIMEFACS,"r",fname2,needed=.false.,iostat=ios) + if(ios==0)then + n = 0 + do + read(IO_TIMEFACS,"(a)",iostat=ios) inputline + n = n + 1 + if(DEBUG)write(*,*) "HourlyFacsSpecials ", n, trim(inputline) + if ( ios < 0 ) exit ! End of file + if( index(inputline,"#")>0 ) then ! Headers + if(n==1) call PrintLog(trim(inputline)) + cycle + else + read(inputline,fmt=*,iostat=ios) inland, idd, insec, & + (tmp24(ihh),ihh=1,24) + icc=find_index(inland,Country(:)%icode) + if( DEBUG ) write(*,*) "HOURLY SPECIAL=> ",icc, idd, insec, tmp24(1), tmp24(13) + + if( icc<0 .and. inland/=0)then + write(*,*)"Warning: HourlyFacsSpecials, country code not recognized", inland + cycle + endif + end if + + if( idd == 0 ) then ! same values very day + do idd2 = 1, 7 + do ihh=1,24 + if(inland/=0)then + fac_ehh24x7(iemis,insec,ihh,idd2,icc) = tmp24(ihh) + else + fac_ehh24x7(iemis,insec,ihh,idd2,:) = tmp24(ihh) + endif + end do + end do + idd = 1 ! Used later + else + do ihh=1,24 + if(inland/=0)then + fac_ehh24x7(iemis,insec,ihh,idd2,icc) = tmp24(ihh) + else + fac_ehh24x7(iemis,insec,ihh,idd2,:) = tmp24(ihh) + endif + enddo + end if + + ! Use sumfac for mean, and normalise within each day/sector + ! (Sector 10 had a sum of 1.00625) + if(inland==0)icc=1 + sumfac = sum(fac_ehh24x7(iemis,insec,:,idd,icc))/24.0 + if(DEBUG .and. MasterProc) write(*,"(a,2i3,3f12.5)") & + 'HOURLY-FACS mean min max', idd, insec, sumfac, & + minval(fac_ehh24x7(iemis,insec,:,idd,icc)), & + maxval(fac_ehh24x7(iemis,insec,:,idd,icc)) + + if(inland/=0)then + fac_ehh24x7(iemis,insec,:,idd,icc) = fac_ehh24x7(iemis,insec,:,idd,icc) * 1.0/sumfac + else + fac_ehh24x7(iemis,insec,:,idd,:) = fac_ehh24x7(iemis,insec,:,idd,:) * 1.0/sumfac + endif + ! if ( ios < 0 ) exit ! End of file + end do + + close(IO_TIMEFACS) else - read(inputline,fmt=*,iostat=ios) inland, idd, insec, & - (tmp24(ihh),ihh=1,24) - icc=find_index(inland,Country(:)%icode) - if( DEBUG ) write(*,*) "HOURLY SPECIAL=> ",icc, idd, insec, tmp24(1), tmp24(13) - end if - - if( idd == 0 ) then ! same values very day - do idd2 = 1, 7 - do ihh=1,24 - fac_ehh24x7(insec,ihh,idd2,icc) = tmp24(ihh) - end do - end do - idd = 1 ! Used later - else - do ihh=1,24 - fac_ehh24x7(insec,ihh,idd,icc) = tmp24(ihh) - enddo - end if - - !(fac_ehh24x7(insec,ihh,idd),ihh=1,24) - - ! Use sumfac for mean, and normalise within each day/sector - ! (Sector 10 had a sum of 1.00625) - sumfac = sum(fac_ehh24x7(insec,:,idd,icc))/24.0 - if(DEBUG .and. MasterProc) write(*,"(a,2i3,3f12.5)") & - 'HOURLY-FACS mean min max', idd, insec, sumfac, & - minval(fac_ehh24x7(insec,:,idd,icc)), & - maxval(fac_ehh24x7(insec,:,idd,icc)) - - fac_ehh24x7(insec,:,idd,icc) = fac_ehh24x7(insec,:,idd,icc) * 1.0/sumfac - - ! if ( ios < 0 ) exit ! End of file - end do - - close(IO_TIMEFACS) - else - if(me==0)write(*,*)'Special hourly factors not found (but not needed): ',trim(fname2) - endif - - write(unit=6,fmt="(a,I6,a,I5)")" Time factors normalisation: ",nydays,' days in ',year + if(me==0)write(*,*)'Special hourly factors not found (but not needed): ',trim(fname2) + endif + + + end do ! NEMIS_FILE ! ####################################################################### ! 4) Normalise the monthly-daily factors. This is needed in order to @@ -435,6 +453,7 @@ subroutine timefactors(year) ! Here we execute the same interpolations which are later done ! in "NewDayFactors", and scale efac_mm if necessary. + write(unit=6,fmt="(a,I6,a,I5)")" Time factors normalisation: ",nydays,' days in ',year call yearly_normalize(year) !######################################################################### @@ -448,7 +467,7 @@ subroutine timefactors(year) fac_emm(27,mm,2,1), fac_edd(27,1,2,1), fac_edd(27,7,2,1) end do ! mm write(*,"(a,4f8.3)") " day factors traffic 24x7", & - fac_ehh24x7(7,1,4,1),fac_ehh24x7(7,13,4,1), & + fac_ehh24x7(1,7,1,4,1),fac_ehh24x7(1,7,13,4,1), & minval(fac_ehh24x7), maxval(fac_ehh24x7) end if ! DEBUG diff --git a/Timing_mod.f90 b/Timing_mod.f90 index 6cd141b..d68627e 100644 --- a/Timing_mod.f90 +++ b/Timing_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/Units_mod.f90 b/Units_mod.f90 index ba2e3da..bfb0256 100644 --- a/Units_mod.f90 +++ b/Units_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/YieldModifications_mod.f90 b/YieldModifications_mod.f90 index 82b5d3f..48c5e6e 100644 --- a/YieldModifications_mod.f90 +++ b/YieldModifications_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/ZchemData_mod.f90 b/ZchemData_mod.f90 index b3efd7e..ee329e9 100644 --- a/ZchemData_mod.f90 +++ b/ZchemData_mod.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no diff --git a/config_emep.nml b/config_emep.nml index 9ad70e3..4f0f8bf 100644 --- a/config_emep.nml +++ b/config_emep.nml @@ -20,6 +20,7 @@ TopoFile = 'DataDir/topoGRID.nc' SitesFile = 'DataDir/sites.dat', SondesFile = 'DataDir/sondes.dat', + Vertical_levelsFile = 'DataDir/Vertical_levels20_EC.txt' !------------------------------ ZCMDIR = 'DataDir/ZCM_EmChem19', SplitDefaultFile = 'ZCMDIR/emissplit.defaults.POLL', diff --git a/dependencies b/dependencies index dd1d84d..f538dd7 100644 --- a/dependencies +++ b/dependencies @@ -4,11 +4,11 @@ AeroFunctions.o : AeroFunctions.f90 PhysicalConstants_mod.o Aero_Vds_mod.o : Aero_Vds_mod.f90 PhysicalConstants_mod.o Ammonium_mod.o : Ammonium_mod.f90 CM_ChemSpecs_mod.o ZchemData_mod.o Config_module.o AOD_PM_mod.o : AOD_PM_mod.f90 SmallUtils_mod.o ZchemData_mod.o PhysicalConstants_mod.o Par_mod.o Config_module.o MetFields_mod.o GridValues_mod.o CheckStop_mod.o CM_ChemGroups_mod.o ChemFields_mod.o CM_ChemSpecs_mod.o -Advection_mod.o : Advection_mod.f90 uEMEP_mod.o PhysicalConstants_mod.o Par_mod.o MPI_Groups_mod.o Timing_mod.o MassBudget_mod.o MetFields_mod.o Io_Progs_mod.o Io_mod.o GridValues_mod.o EmisDef_mod.o Convection_mod.o Debug_module.o Config_module.o CheckStop_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o +Advection_mod.o : Advection_mod.f90 LocalFractions_mod.o PhysicalConstants_mod.o Par_mod.o MPI_Groups_mod.o Timing_mod.o MassBudget_mod.o MetFields_mod.o Io_Progs_mod.o Io_mod.o GridValues_mod.o EmisDef_mod.o Convection_mod.o Debug_module.o Config_module.o CheckStop_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o AirEmis_mod.o : AirEmis_mod.f90 TimeDate_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o MPI_Groups_mod.o Config_module.o MetFields_mod.o GridValues_mod.o Io_mod.o AllocInit.o : AllocInit.f90 CheckStop_mod.o AOTnPOD_mod.o : AOTnPOD_mod.f90 TimeDate_mod.o Par_mod.o OwnDataTypes_mod.o NumberConstants.o MetFields_mod.o LocalVariables_mod.o LandDefs_mod.o Io_Progs_mod.o GridValues_mod.o DO3SE_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o ChemFields_mod.o CheckStop_mod.o -Aqueous_n_WetDep_mod.o : Aqueous_n_WetDep_mod.f90 Units_mod.o SmallUtils_mod.o ZchemData_mod.o PhysicalConstants_mod.o Par_mod.o SOA_mod.o MetFields_mod.o MassBudget_mod.o Io_mod.o GridValues_mod.o GasParticleCoeffs_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o My_Derived_mod.o +Aqueous_n_WetDep_mod.o : Aqueous_n_WetDep_mod.f90 Units_mod.o SmallUtils_mod.o ZchemData_mod.o PhysicalConstants_mod.o Par_mod.o SOA_mod.o MetFields_mod.o MassBudget_mod.o LocalFractions_mod.o Io_mod.o GridValues_mod.o GasParticleCoeffs_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o My_Derived_mod.o BiDir_emep.o : BiDir_emep.f90 Config_module.o BiDir_module.o : BiDir_module.f90 BLPhysics_mod.o : BLPhysics_mod.f90 PhysicalConstants_mod.o Landuse_mod.o Config_module.o @@ -29,16 +29,16 @@ CM_ChemSpecs_mod.o : CM_ChemSpecs_mod.f90 CM_ChemDims_mod.o Config_module.o : Config_module.f90 SmallUtils_mod.o Precision_mod.o TimeDate_mod.o OwnDataTypes_mod.o Io_Nums_mod.o Debug_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o AeroConstants_mod.o Debug_module.o : Debug_module.f90 DefPhotolysis_mod.o : DefPhotolysis_mod.f90 ZchemData_mod.o SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o MPI_Groups_mod.o MetFields_mod.o LocalVariables_mod.o Io_mod.o GridValues_mod.o Functions_mod.o DerivedFields_mod.o Config_module.o CheckStop_mod.o -Derived_mod.o : Derived_mod.f90 Units_mod.o uEMEP_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o ZchemData_mod.o SOA_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NumberConstants.o My_Derived_mod.o MosaicOutputs_mod.o MetFields_mod.o Io_Progs_mod.o GridValues_mod.o GasParticleCoeffs_mod.o EmisGet_mod.o EmisDef_mod.o EcoSystem_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemGroups_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o AOTnPOD_mod.o AOD_PM_mod.o AeroConstants_mod.o +Derived_mod.o : Derived_mod.f90 Units_mod.o LocalFractions_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o Tabulations_mod.o SmallUtils_mod.o ZchemData_mod.o SOA_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NumberConstants.o My_Derived_mod.o MosaicOutputs_mod.o MetFields_mod.o Io_Progs_mod.o GridValues_mod.o GasParticleCoeffs_mod.o Functions_mod.o EmisGet_mod.o EmisDef_mod.o EcoSystem_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemGroups_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o AOTnPOD_mod.o AOD_PM_mod.o AeroConstants_mod.o DerivedFields_mod.o : DerivedFields_mod.f90 OwnDataTypes_mod.o DO3SE_mod.o : DO3SE_mod.f90 TimeDate_mod.o SmallUtils_mod.o Radiation_mod.o LocalVariables_mod.o LandDefs_mod.o Debug_module.o Config_module.o CheckStop_mod.o -DryDep_mod.o : DryDep_mod.f90 TimeDate_mod.o SubMet_mod.o StoFlux_mod.o SoilWater_mod.o SmallUtils_mod.o Sites_mod.o ZchemData_mod.o Rsurface_mod.o Rb_mod.o PhysicalConstants_mod.o Par_mod.o MosaicOutputs_mod.o MicroMet_mod.o MetFields_mod.o MassBudget_mod.o LocalVariables_mod.o LandDefs_mod.o Landuse_mod.o Io_Progs_mod.o GridValues_mod.o GasParticleCoeffs_mod.o EcoSystem_mod.o DO3SE_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o BiDir_module.o BiDir_emep.o Aero_Vds_mod.o AeroConstants_mod.o +DryDep_mod.o : DryDep_mod.f90 TimeDate_mod.o SubMet_mod.o StoFlux_mod.o SoilWater_mod.o SmallUtils_mod.o Sites_mod.o ZchemData_mod.o Rsurface_mod.o Rb_mod.o PhysicalConstants_mod.o Par_mod.o MosaicOutputs_mod.o MicroMet_mod.o MetFields_mod.o MassBudget_mod.o LocalVariables_mod.o LocalFractions_mod.o LandDefs_mod.o Landuse_mod.o Io_Progs_mod.o GridValues_mod.o GasParticleCoeffs_mod.o EcoSystem_mod.o DO3SE_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o BiDir_module.o BiDir_emep.o Aero_Vds_mod.o AeroConstants_mod.o DustProd_mod.o : DustProd_mod.f90 ZchemData_mod.o TimeDate_mod.o SubMet_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o MicroMet_mod.o MetFields_mod.o LocalVariables_mod.o LandDefs_mod.o Landuse_mod.o Io_mod.o GridValues_mod.o CM_ChemSpecs_mod.o Functions_mod.o Debug_module.o Config_module.o CheckStop_mod.o Biogenics_mod.o EcoSystem_mod.o : EcoSystem_mod.f90 Par_mod.o OwnDataTypes_mod.o LandDefs_mod.o Debug_module.o Config_module.o -emep_Main.o : emep_Main.f90 uEMEP_mod.o Trajectory_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o Tabulations_mod.o SmallUtils_mod.o Sites_mod.o PhyChem_mod.o Par_mod.o OutputChem_mod.o NetCDF_mod.o Nest_mod.o MPI_Groups_mod.o Met_mod.o MassBudget_mod.o Landuse_mod.o Io_Progs_mod.o Io_mod.o GridValues_mod.o DryDep_mod.o ForestFire_mod.o Emissions_mod.o EcoSystem_mod.o Derived_mod.o DefPhotolysis_mod.o Debug_module.o My_3DVar_mod.o Country_mod.o Config_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o ChemFields_mod.o CheckStop_mod.o BoundaryConditions_mod.o Biogenics_mod.o BiDir_emep.o AirEmis_mod.o Aqueous_n_WetDep_mod.o Advection_mod.o Timing_mod.o +emep_Main.o : emep_Main.f90 LocalFractions_mod.o Trajectory_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o Tabulations_mod.o SmallUtils_mod.o Sites_mod.o PhyChem_mod.o Par_mod.o OutputChem_mod.o NetCDF_mod.o Nest_mod.o MPI_Groups_mod.o Met_mod.o MassBudget_mod.o Landuse_mod.o Io_Progs_mod.o Io_mod.o GridValues_mod.o DryDep_mod.o ForestFire_mod.o Emissions_mod.o EcoSystem_mod.o Derived_mod.o DefPhotolysis_mod.o Debug_module.o My_3DVar_mod.o Country_mod.o Config_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o ChemFields_mod.o CheckStop_mod.o BoundaryConditions_mod.o Biogenics_mod.o BiDir_emep.o AirEmis_mod.o Aqueous_n_WetDep_mod.o Advection_mod.o Timing_mod.o EmisDef_mod.o : EmisDef_mod.f90 CM_EmisFile.inc OwnDataTypes_mod.o CM_ChemDims_mod.o EmisGet_mod.o : EmisGet_mod.f90 CM_EmisSpecs.inc Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o PhysicalConstants_mod.o SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o KeyValueTypes.o Io_Progs_mod.o Io_mod.o GridValues_mod.o GridAllocate_mod.o EmisDef_mod.o Debug_module.o Country_mod.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o -Emissions_mod.o : Emissions_mod.f90 Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o ZchemData_mod.o PointSource_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o MetFields_mod.o Io_Progs_mod.o Io_Nums_mod.o GridValues_mod.o EmisGet_mod.o EmisDef_mod.o Debug_module.o Country_mod.o Config_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Biogenics_mod.o AirEmis_mod.o +Emissions_mod.o : Emissions_mod.f90 LocalFractions_mod.o Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o ZchemData_mod.o PointSource_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o MetFields_mod.o Io_Progs_mod.o Io_Nums_mod.o GridValues_mod.o EmisGet_mod.o EmisDef_mod.o Debug_module.o Country_mod.o Config_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Biogenics_mod.o AirEmis_mod.o ExternalBICs_mod.o : ExternalBICs_mod.f90 TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o OwnDataTypes_mod.o Io_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o FastJ_mod.o : FastJ_mod.f90 ZchemData_mod.o TimeDate_mod.o Radiation_mod.o PhysicalConstants_mod.o Par_mod.o NetCDF_mod.o Config_module.o MetFields_mod.o Landuse_mod.o LandDefs_mod.o GridValues_mod.o DefPhotolysis_mod.o ForestFire_mod.o : ForestFire_mod.f90 ZchemData_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NumberConstants.o NetCDF_mod.o MetFields_mod.o Io_mod.o GridValues_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o @@ -56,6 +56,7 @@ LandDefs_mod.o : LandDefs_mod.f90 SmallUtils_mod.o LandPFT_mod.o KeyValueTypes.o Landuse_mod.o : Landuse_mod.f90 NetCDF_mod.o TimeDate_mod.o SmallUtils_mod.o Par_mod.o MPI_Groups_mod.o LandPFT_mod.o LandDefs_mod.o KeyValueTypes.o Io_mod.o GridValues_mod.o GridAllocate_mod.o DO3SE_mod.o Debug_module.o Config_module.o CheckStop_mod.o LandPFT_mod.o : LandPFT_mod.f90 SmallUtils_mod.o Par_mod.o NetCDF_mod.o GridValues_mod.o Debug_module.o Config_module.o CheckStop_mod.o LocalVariables_mod.o : LocalVariables_mod.f90 +LocalFractions_mod.o : LocalFractions_mod.f90 ZchemData_mod.o Timing_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o MetFields_mod.o GridValues_mod.o EmisGet_mod.o EmisDef_mod.o DefPhotolysis_mod.o Country_mod.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o MARS_mod.o : MARS_mod.f90 Par_mod.o Debug_module.o Config_module.o MARS_Aero_water_mod.o Io_mod.o CheckStop_mod.o MARS_Aero_water_mod.o : MARS_Aero_water_mod.f90 MassBudget_mod.o : MassBudget_mod.f90 ZchemData_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o MPI_Groups_mod.o MetFields_mod.o Io_mod.o GridValues_mod.o EmisDef_mod.o Debug_module.o Config_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o @@ -65,12 +66,12 @@ EQSAM_mod.o : EQSAM_mod.f90 MicroMet_mod.o : MicroMet_mod.f90 MosaicOutputs_mod.o : MosaicOutputs_mod.f90 Units_mod.o TimeDate_mod.o SubMet_mod.o SmallUtils_mod.o OwnDataTypes_mod.o MetFields_mod.o LocalVariables_mod.o Landuse_mod.o LandDefs_mod.o Io_Progs_mod.o GasParticleCoeffs_mod.o EcoSystem_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemGroups_mod.o CM_ChemDims_mod.o CheckStop_mod.o AOTnPOD_mod.o MPI_Groups_mod.o : MPI_Groups_mod.f90 -AerosolCalls.o : AerosolCalls.f90 ZchemData_mod.o PhysicalConstants_mod.o MARS_mod.o EQSAM_mod.o Debug_module.o Config_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Ammonium_mod.o AeroConstants_mod.o +AerosolCalls.o : AerosolCalls.f90 ZchemData_mod.o SmallUtils_mod.o PhysicalConstants_mod.o MARS_mod.o EQSAM_mod.o Debug_module.o Config_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Ammonium_mod.o AeroConstants_mod.o My_Derived_mod.o : My_Derived_mod.f90 SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o MosaicOutputs_mod.o Io_Progs_mod.o Io_Nums_mod.o GridValues_mod.o EmisGet_mod.o EmisDef_mod.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o CM_ChemGroups_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o AOTnPOD_mod.o NetCDF_mod.o : NetCDF_mod.f90 SmallUtils_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o MPI_Groups_mod.o InterpolationRoutines_mod.o GridValues_mod.o Functions_mod.o Debug_module.o Country_mod.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o ChemFields_mod.o Nest_mod.o : Nest_mod.f90 CM_ChemGroups_mod.o SmallUtils_mod.o Units_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o Pollen_const_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o Debug_module.o Config_module.o MetFields_mod.o InterpolationRoutines_mod.o Io_mod.o GridValues_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o ExternalBICs_mod.o NumberConstants.o : NumberConstants.f90 -OutputChem_mod.o : OutputChem_mod.f90 Units_mod.o uEMEP_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o Io_mod.o GridValues_mod.o DerivedFields_mod.o Derived_mod.o Debug_module.o Config_module.o CheckStop_mod.o +OutputChem_mod.o : OutputChem_mod.f90 Units_mod.o LocalFractions_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o Io_mod.o GridValues_mod.o DerivedFields_mod.o Derived_mod.o Debug_module.o Config_module.o CheckStop_mod.o OwnDataTypes_mod.o : OwnDataTypes_mod.f90 TimeDate_mod.o NumberConstants.o Par_mod.o : Par_mod.f90 MPI_Groups_mod.o Config_module.o Io_Nums_mod.o CheckStop_mod.o PhysicalConstants_mod.o : PhysicalConstants_mod.f90 @@ -81,7 +82,7 @@ Radiation_mod.o : Radiation_mod.f90 TimeDate_mod.o PhysicalConstants_mod.o Rb_mod.o : Rb_mod.f90 PhysicalConstants_mod.o GasParticleCoeffs_mod.o Debug_module.o ReadField_mod.o : ReadField_mod.f90 Io_mod.o Par_mod.o MPI_Groups_mod.o Config_module.o CheckStop_mod.o Rsurface_mod.o : Rsurface_mod.f90 TimeDate_mod.o SmallUtils_mod.o Radiation_mod.o Par_mod.o MetFields_mod.o LocalVariables_mod.o LandDefs_mod.o Io_Progs_mod.o GasParticleCoeffs_mod.o DO3SE_mod.o Debug_module.o Config_module.o CoDep_mod.o CheckStop_mod.o -Runchem_mod.o : Runchem_mod.f90 TimeDate_mod.o SmallUtils_mod.o ZchemData_mod.o Setup_1d_mod.o SeaSalt_mod.o PointSource_mod.o Par_mod.o Pollen_mod.o SOA_mod.o MassBudget_mod.o Io_Progs_mod.o GridValues_mod.o FastJ_mod.o DustProd_mod.o DryDep_mod.o DerivedFields_mod.o DefPhotolysis_mod.o Debug_module.o Config_module.o ColumnSource_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o Solver.o ChemFields_mod.o CheckStop_mod.o CellMet_mod.o Biogenics_mod.o Aqueous_n_WetDep_mod.o AOD_PM_mod.o Timing_mod.o AerosolCalls.o AeroConstants_mod.o +Runchem_mod.o : Runchem_mod.f90 TimeDate_mod.o SmallUtils_mod.o ZchemData_mod.o Setup_1d_mod.o SeaSalt_mod.o PointSource_mod.o Par_mod.o Pollen_mod.o SOA_mod.o MassBudget_mod.o LocalFractions_mod.o Io_Progs_mod.o GridValues_mod.o FastJ_mod.o DustProd_mod.o DryDep_mod.o DerivedFields_mod.o DefPhotolysis_mod.o Debug_module.o Config_module.o ColumnSource_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o Solver.o ChemFields_mod.o CheckStop_mod.o CellMet_mod.o Biogenics_mod.o Aqueous_n_WetDep_mod.o AOD_PM_mod.o Timing_mod.o AerosolCalls.o AeroConstants_mod.o Setup_1d_mod.o : Setup_1d_mod.f90 ZchemData_mod.o Units_mod.o TimeDate_mod.o Tabulations_mod.o SmallUtils_mod.o Radiation_mod.o PhysicalConstants_mod.o Par_mod.o MetFields_mod.o MassBudget_mod.o LocalVariables_mod.o Landuse_mod.o Io_Progs_mod.o GridValues_mod.o GasParticleCoeffs_mod.o Functions_mod.o ForestFire_mod.o EmisGet_mod.o EmisDef_mod.o DerivedFields_mod.o Debug_module.o Config_module.o ColumnSource_mod.o CheckStop_mod.o CM_ChemSpecs_mod.o CM_ChemRates_mod.o CM_ChemGroups_mod.o ChemFunctions_mod.o ChemFields_mod.o CM_ChemDims_mod.o Biogenics_mod.o AirEmis_mod.o AeroFunctions.o AeroConstants_mod.o Sites_mod.o : Sites_mod.f90 TimeDate_ExtraUtil_mod.o TimeDate_mod.o Tabulations_mod.o SmallUtils_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o PhysicalConstants_mod.o MPI_Groups_mod.o MetFields_mod.o KeyValueTypes.o Io_mod.o GridValues_mod.o Functions_mod.o DerivedFields_mod.o Debug_module.o Config_module.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o ChemFunctions_mod.o CM_ChemDims_mod.o CheckStop_mod.o Units_mod.o SmallUtils_mod.o : SmallUtils_mod.f90 @@ -97,12 +98,11 @@ TimeDate_ExtraUtil_mod.o : TimeDate_ExtraUtil_mod.f90 TimeDate_mod.o CheckStop_m Timefactors_mod.o : Timefactors_mod.f90 TimeDate_mod.o Io_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o Debug_module.o Config_module.o Met_mod.o InterpolationRoutines_mod.o GridValues_mod.o EmisDef_mod.o Country_mod.o CM_ChemDims_mod.o CheckStop_mod.o Timing_mod.o : Timing_mod.f90 Trajectory_mod.o : Trajectory_mod.f90 SmallUtils_mod.o TimeDate_mod.o Par_mod.o MPI_Groups_mod.o Config_module.o MetFields_mod.o Io_mod.o GridValues_mod.o CM_ChemSpecs_mod.o ChemFields_mod.o -uEMEP_mod.o : uEMEP_mod.f90 Timing_mod.o Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SmallUtils_mod.o PhysicalConstants_mod.o Par_mod.o OwnDataTypes_mod.o NetCDF_mod.o MPI_Groups_mod.o Config_module.o MetFields_mod.o GridValues_mod.o EmisGet_mod.o EmisDef_mod.o Country_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Units_mod.o : Units_mod.f90 SmallUtils_mod.o OwnDataTypes_mod.o Pollen_const_mod.o PhysicalConstants_mod.o Config_module.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CM_ChemGroups_mod.o CheckStop_mod.o YieldModifications_mod.o : YieldModifications_mod.f90 SmallUtils_mod.o NumberConstants.o Debug_module.o Config_module.o CM_ChemSpecs_mod.o ChemFields_mod.o CheckStop_mod.o ZchemData_mod.o : ZchemData_mod.f90 Config_module.o CM_ChemDims_mod.o AllocInit.o AeroConstants_mod.o global2local.o : global2local.f90 Par_mod.o MPI_Groups_mod.o Config_module.o -PhyChem_mod.o : PhyChem_mod.f90 uEMEP_mod.o Trajectory_mod.o Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SoilWater_mod.o Sites_mod.o Runchem_mod.o Radiation_mod.o Pollen_mod.o PhysicalConstants_mod.o Par_mod.o OutputChem_mod.o Nest_mod.o NetCDF_mod.o Timing_mod.o MetFields_mod.o GridValues_mod.o Gravset_mod.o Emissions_mod.o EmisDef_mod.o DryDep_mod.o DerivedFields_mod.o Derived_mod.o Debug_module.o My_3DVar_mod.o My_3DVar_mod.o Config_module.o CoDep_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o Advection_mod.o +PhyChem_mod.o : PhyChem_mod.f90 LocalFractions_mod.o Trajectory_mod.o Timefactors_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SoilWater_mod.o Sites_mod.o Runchem_mod.o Radiation_mod.o Pollen_mod.o PhysicalConstants_mod.o Par_mod.o OutputChem_mod.o Nest_mod.o NetCDF_mod.o Timing_mod.o MetFields_mod.o GridValues_mod.o Gravset_mod.o Emissions_mod.o EmisDef_mod.o DryDep_mod.o DerivedFields_mod.o Derived_mod.o Debug_module.o My_3DVar_mod.o My_3DVar_mod.o Config_module.o CoDep_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o ChemFields_mod.o CheckStop_mod.o Biogenics_mod.o Advection_mod.o My_3DVar_mod.o : My_3DVar_mod.f90 Config_module.o CheckStop_mod.o Pollen_mod.o : Pollen_mod.f90 Io_mod.o TimeDate_ExtraUtil_mod.o TimeDate_mod.o SubMet_mod.o SmallUtils_mod.o ZchemData_mod.o OwnDataTypes_mod.o Radiation_mod.o Par_mod.o NetCDF_mod.o MPI_Groups_mod.o Config_module.o MicroMet_mod.o MetFields_mod.o LocalVariables_mod.o Landuse_mod.o GridValues_mod.o Functions_mod.o GasParticleCoeffs_mod.o DerivedFields_mod.o Debug_module.o ChemFields_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Biogenics_mod.o PhysicalConstants_mod.o Pollen_const_mod.o Pollen_const_mod.o : Pollen_const_mod.f90 SmallUtils_mod.o CM_ChemGroups_mod.o CM_ChemSpecs_mod.o CM_ChemDims_mod.o CheckStop_mod.o Debug_module.o Config_module.o PhysicalConstants_mod.o diff --git a/emep_Main.f90 b/emep_Main.f90 index 6a7d6ef..a3e5853 100644 --- a/emep_Main.f90 +++ b/emep_Main.f90 @@ -1,4 +1,4 @@ -! +! !*****************************************************************************! !* !* Copyright (C) 2007-2020 met.no @@ -94,7 +94,7 @@ program emep_Main use TimeDate_ExtraUtil_mod,only : date2string, assign_startandenddate,& date_is_reached use Trajectory_mod, only: trajectory_init,trajectory_in - use uEMEP_mod, only: init_uEMEP, NTIMING_uEMEP + use LocalFractions_mod, only: lf_init, NTIMING_lf !-------------------------------------------------------------------- ! ! Variables. There are too many to list here. Still, here are a @@ -166,7 +166,7 @@ program emep_Main end if !*** Timing ******** - call Init_timing(NTIMING_UNIMOD+NTIMING_3DVAR+NTIMING_uEMEP) + call Init_timing(NTIMING_UNIMOD+NTIMING_3DVAR+NTIMING_lf) call Code_Timer(tim_before0) tim_before = tim_before0 @@ -213,6 +213,7 @@ program emep_Main call Add_2timing(2,tim_after,tim_before,"Meteo read first record") + if (MasterProc.and.DEBUG%MAINCODE) print *,"Calling emissions with year",yyyy call Init_masks() @@ -221,8 +222,8 @@ program emep_Main call Add_2timing(3,tim_after,tim_before,"Yearly emissions read in") - if(USES%uEMEP) call init_uEMEP - + if(USES%LocalFractions) call lf_init + call MetModel_LandUse(1) ! call Init_EcoSystems() ! Defines ecosystem-groups for dep output diff --git a/modrun.sh b/modrun.sh index 9a6db0c..7e684b6 100755 --- a/modrun.sh +++ b/modrun.sh @@ -3,12 +3,12 @@ ### job options for Slurm/sbatch #SBATCH --job-name=emepctm #SBATCH --output=%x.out --error=%x.out -#SBATCH --nodes=2 --ntasks-per-node=32 --time=5:00:00 +#SBATCH --nodes=2 --ntasks-per-node=32 --time=6:00:00 ### Minimalistic script for run the Unified EMEP model # working directory -cd ~/work/EMEP_MSC-W_model.rv4.34.OpenSource/Base +cd ~/work/EMEP_MSC-W_model.rv4.36.OpenSource/Base # run the model #mpiexec ../code/emepctm # or diff --git a/uEMEP_mod.f90 b/uEMEP_mod.f90 deleted file mode 100644 index 968083f..0000000 --- a/uEMEP_mod.f90 +++ /dev/null @@ -1,1347 +0,0 @@ -! -!*****************************************************************************! -!* -!* Copyright (C) 2007-2020 met.no -!* -!* Contact information: -!* Norwegian Meteorological Institute -!* Box 43 Blindern -!* 0313 OSLO -!* NORWAY -!* email: emep.mscw@met.no -!* http://www.emep.int -!* -!* This program is free software: you can redistribute it and/or modify -!* it under the terms of the GNU General Public License as published by -!* the Free Software Foundation, either version 3 of the License, or -!* (at your option) any later version. -!* -!* This program 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 -!* GNU General Public License for more details. -!* -!* You should have received a copy of the GNU General Public License -!* along with this program. If not, see . -!*****************************************************************************! -module uEMEP_mod -! -! all subroutines for uEMEP -! -use CheckStop_mod, only: CheckStop,StopAll -use Chemfields_mod, only: xn_adv -use ChemDims_mod, only: NSPEC_ADV, NSPEC_SHL,NEMIS_File -use ChemSpecs_mod, only: species_adv,species -use Country_mod, only: MAXNLAND,NLAND,Country -use EmisDef_mod, only: loc_frac, loc_frac_1d, loc_frac_hour, loc_tot_hour,& - loc_frac_hour_inst, loc_tot_hour_inst,loc_frac_day, & - loc_tot_day, loc_frac_month,loc_tot_month,& - loc_frac_full,loc_tot_full, NSECTORS,EMIS_FILE, & - nlandcode,landcode,sec2tfac_map,sec2hfac_map, & - ISNAP_DOM,secemis, roaddust_emis_pot,KEMISTOP,& - NEmis_sources, Emis_source_2D, Emis_source -use EmisGet_mod, only: nrcemis, iqrc2itot, emis_nsplit,nemis_kprofile, emis_kprofile,& - make_iland_for_time,itot2iqrc,iqrc2iem -use GridValues_mod, only: dA,dB,xm2, dhs1i, glat, glon, projection, extendarea_N -use MetFields_mod, only: ps,roa,EtaKz -use Config_module, only: KMAX_MID, KMAX_BND,USES, uEMEP, IOU_HOUR& - , IOU_HOUR_INST,IOU_INST,IOU_YEAR,IOU_MON,IOU_DAY& - ,IOU_HOUR,IOU_HOUR_INST, KMAX_MID & - ,MasterProc,dt_advec, RUNDOMAIN, runlabel1 & - ,HOURLYFILE_ending -use MPI_Groups_mod -use NetCDF_mod, only: Real4,Out_netCDF -use OwnDataTypes_mod, only: Deriv, Npoll_uemep_max, Nsector_uemep_max, TXTLEN_FILE -use Par_mod, only: me,LIMAX,LJMAX,MAXLIMAX,MAXLJMAX,gi0,gj0,li0,li1,lj0,lj1,GIMAX,GJMAX -use PhysicalConstants_mod, only : GRAV, ATWAIR -use SmallUtils_mod, only: find_index -use TimeDate_mod, only: date, current_date,day_of_week -use TimeDate_ExtraUtil_mod,only: date2string -use Timefactors_mod, only: & - DegreeDayFactors & ! degree-days used for SNAP-2 - ,Gridded_SNAP2_Factors, gridfac_HDD & - ,GridTfac &!array with monthly gridded time factors - ,fac_min,timefactors & ! subroutine - ,fac_ehh24x7 ,fac_emm, fac_edd, timefac ! time-factors -use My_Timing_mod, only: Add_2timing, Code_timer, NTIMING - -!(dx,dy,i,j) shows contribution of pollutants from (i+dx,j+dy) to (i,j) - -implicit none -!external advection_mod_mp_vertdiffn_k - -private - -public :: init_uEMEP -public :: out_uEMEP -public :: av_uEMEP -public :: uemep_adv_x -public :: uemep_adv_y -public :: uemep_adv_k -public :: uemep_diff -public :: uemep_emis - -integer, public, save :: uEMEP_Size1=0 !total size of the first 3 dimensions of loc_frac -!uEMEP_Size1=uEMEP%Nsec_poll*(2*uEMEP%dist+1)**2 -integer, public, save :: uEMEP_Sizedxdy=0 !total size of the first 3 dimensions of loc_frac -!uEMEP_Sizedxdy=(2*uEMEP%dist+1)**2 - -real, private, save ::av_fac_hour,av_fac_day,av_fac_month,av_fac_full -real, allocatable, save ::loc_poll_to(:,:,:,:,:) - -logical, public, save :: COMPUTE_LOCAL_TRANSPORT=.false. -integer , private, save :: uEMEPNvertout = 1!number of vertical levels to save in output -integer, public, save :: NTIMING_uEMEP=7 -real, private :: tim_after,tim_before - -contains -subroutine init_uEMEP - integer :: i, ix, itot, iqrc, iem, iemis, isec, ipoll, ixnh3, ixnh4 - - call Code_timer(tim_before) - uEMEP%Nsec_poll = 0 - uEMEP%Npoll = 0 - do iemis=1,Npoll_uemep_max - if(uEMEP%poll(iemis)%emis=='none')then - call CheckStop(iemis==1,"init_uEMEP: no pollutant specified") - exit - else - uEMEP%Npoll = uEMEP%Npoll + 1 - uEMEP%poll(iemis)%Nsectors = 0 - uEMEP%poll(iemis)%sec_poll_ishift=uEMEP%Nsec_poll - do isec=1,Nsector_uemep_max - if(uEMEP%poll(iemis)%sector(isec)<0)then - call CheckStop(isec==0,"init_uEMEP: nosector specified for "//uEMEP%poll(iemis)%emis) - exit - else - uEMEP%Nsec_poll = uEMEP%Nsec_poll + 1 - uEMEP%poll(iemis)%Nsectors = uEMEP%poll(iemis)%Nsectors +1 - endif - enddo - endif - enddo - -!find indices in EMIS_File - do ipoll=1,uEMEP%Npoll - do iem=1,NEMIS_FILE - if(trim(EMIS_File(iem))==trim(uEMEP%poll(ipoll)%emis))then - uEMEP%poll(ipoll)%EMIS_File_ix = iem - exit - endif - enddo - call CheckStop(iem>NEMIS_FILE,"uemep pollutant not found: "//trim(uEMEP%poll(ipoll)%emis)) - enddo - -! uEMEP%dist = 5 -! uEMEP%Nvert =7 - do i=1,4 - if(uEMEP%DOMAIN(i)<0)uEMEP%DOMAIN(i) = RUNDOMAIN(i) - enddo - - uEMEP_Sizedxdy = (2*uEMEP%dist+1)**2 - uEMEP_Size1 = uEMEP%Nsec_poll*uEMEP_Sizedxdy - - if(MasterProc)then - write(*,*)'uEMEP pollutants : ',uEMEP%Npoll - write(*,*)'total uEMEP pollutants and sectors : ',uEMEP%Nsec_poll - end if - do ipoll=1,uEMEP%Npoll - iem=find_index(uEMEP%poll(ipoll)%emis ,EMIS_FILE(1:NEMIS_FILE)) - call CheckStop( iem<1, "uEMEP did not find corresponding emission file: "//trim(uEMEP%poll(ipoll)%emis) ) - call CheckStop( iem/=uEMEP%poll(ipoll)%EMIS_File_ix, "uEMEP wrong emis file index for: "//trim(uEMEP%poll(ipoll)%emis) ) - uEMEP%poll(ipoll)%Nix=emis_nsplit(iem) - do i=1,uEMEP%poll(ipoll)%Nix - iqrc=sum(emis_nsplit(1:iem-1)) + i - itot=iqrc2itot(iqrc) - ix=itot-NSPEC_SHL - uEMEP%poll(ipoll)%ix(i)=ix - uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt - if(uEMEP%poll(ipoll)%emis=="nox ")then - ix=find_index("NO2",species_adv(:)%name) - call CheckStop(ix<0,'Index for NO2 not found') - uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt - endif - if(uEMEP%poll(ipoll)%emis=="sox ")then - ix=find_index("SO2",species_adv(:)%name) - call CheckStop(ix<0,'Index for SO2 not found') - uEMEP%poll(ipoll)%mw(i)=species_adv(ix)%molwt - endif - -!!$ if(uEMEP%poll(ipoll)%emis=="nox ")then -!!$ uEMEP%poll(ipoll)%Nix=0 -!!$ ixnh4=find_index("NH4_F",species_adv(:)%name) -!!$ ixnh3=find_index("NH3",species_adv(:)%name) -!!$ do ix=1,NSPEC_ADV -!!$ if(ix==ixnh4.or.ix==ixnh3)cycle!reduced nitrogen -!!$ if(species_adv(ix)%nitrogens>0)then -!!$ uEMEP%poll(ipoll)%ix(uEMEP%poll(ipoll)%Nix)=ix -!!$ uEMEP%poll(ipoll)%Nix = uEMEP%poll(ipoll)%Nix + 1 -!!$ if(species_adv(ix)%nitrogens==1)uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=46 -!!$ if(species_adv(ix)%nitrogens==2)uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=92 -!!$ endif -!!$ enddo -!!$ endif - if(uEMEP%poll(ipoll)%emis=="nh3 ")then - uEMEP%poll(ipoll)%Nix=0 - ixnh4=find_index("NH4_F",species_adv(:)%name , any_case=.true.) - ixnh3=find_index("NH3",species_adv(:)%name) - do ix=1,NSPEC_ADV - if(ix/=ixnh4.and.ix/=ixnh3)cycle!not reduced nitrogen - if(species_adv(ix)%nitrogens>0)then - uEMEP%poll(ipoll)%Nix = uEMEP%poll(ipoll)%Nix + 1 - uEMEP%poll(ipoll)%ix(uEMEP%poll(ipoll)%Nix)=ix - uEMEP%poll(ipoll)%mw(uEMEP%poll(ipoll)%Nix)=species_adv(ixnh3)%molwt!use NH3 mw also for NH4 - endif - enddo - endif - end do - if(MasterProc)then - write(*,*)'uEMEP pollutant : ',uEMEP%poll(ipoll)%emis - write(*,*)'uEMEP number of species in '//trim(uEMEP%poll(ipoll)%emis)//' group: ',uEMEP%poll(ipoll)%Nix - write(*,"(A,30(A,F6.2))")'including:',('; '//trim(species_adv(uEMEP%poll(ipoll)%ix(i))%name)//', mw ',uEMEP%poll(ipoll)%mw(i),i=1,uEMEP%poll(ipoll)%Nix) - write(*,"(A,30I4)")'sectors:',(uEMEP%poll(ipoll)%sector(i),i=1,uEMEP%poll(ipoll)%Nsectors) - write(*,"(A,30I4)")'ix:',(uEMEP%poll(ipoll)%ix(i),i=1,uEMEP%poll(ipoll)%Nix) - end if - end do - - COMPUTE_LOCAL_TRANSPORT = uEMEP%COMPUTE_LOCAL_TRANSPORT - - av_fac_hour=0.0 - av_fac_day=0.0 - av_fac_month=0.0 - av_fac_full=0.0 - - allocate(loc_frac(uEMEP%Nsec_poll,-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID)) - loc_frac=0.0 !must be initiated to 0 so that outer frame does not contribute. - if(COMPUTE_LOCAL_TRANSPORT)then - allocate(loc_poll_to(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEPNvertout+1:KMAX_MID)) - loc_poll_to=0.0 - endif - allocate(loc_frac_1d(uEMEP%Nsec_poll,-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,0:max(LIMAX,LJMAX)+1)) - if(uEMEP%HOUR)then - allocate(loc_frac_hour(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) - loc_frac_hour=0.0 - allocate(loc_tot_hour(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) - loc_tot_hour=0.0 - endif - if(uEMEP%HOUR_INST)then - allocate(loc_frac_hour_inst(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) - loc_frac_hour_inst=0.0 - allocate(loc_tot_hour_inst(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) - loc_tot_hour_inst=0.0 - endif - if(uEMEP%DAY)then - allocate(loc_frac_day(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) - loc_frac_day=0.0 - allocate(loc_tot_day(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) - loc_tot_day=0.0 - endif - if(uEMEP%MONTH)then - allocate(loc_frac_month(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) - loc_frac_month=0.0 - allocate(loc_tot_month(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) - loc_tot_month=0.0 - endif - if(uEMEP%YEAR)then - allocate(loc_frac_full(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Nsec_poll)) - loc_frac_full=0.0 - allocate(loc_tot_full(LIMAX,LJMAX,KMAX_MID-uEMEP%Nvert+1:KMAX_MID,uEMEP%Npoll)) - loc_tot_full=0.0 - else - !need to be allocated to avoid debugging error - allocate(loc_frac_full(1,1,1,1,1,1)) - allocate(loc_tot_full(1,1,1,1)) - endif - - call Add_2timing(NTIMING-9,tim_after,tim_before,"uEMEP: init") -end subroutine init_uEMEP - - -subroutine out_uEMEP(iotyp) - integer, intent(in) :: iotyp - character(len=200) ::filename, varname - real :: xtot,scale,invtot,t1,t2 - integer ::i,j,k,dx,dy,ix,iix,isec,iisec,isec_poll,ipoll,isec_poll1 - integer ::ndim,kmax,CDFtype,dimSizes(10),chunksizes(10) - integer ::ndim_tot,dimSizes_tot(10),chunksizes_tot(10) - character (len=20) ::dimNames(10),dimNames_tot(10) - type(Deriv) :: def1 ! definition of fields - type(Deriv) :: def2 ! definition of fields - logical ::overwrite - logical,save :: first_call(10)=.true. - real,allocatable ::tmp_ext(:,:,:,:,:)!allocate since it may be heavy for the stack - type(date) :: onesecond = date(0,0,0,0,1) - character(len=TXTLEN_FILE),save :: oldhourlyname = 'NOTSET' - character(len=TXTLEN_FILE),save :: oldhourlyInstname = 'NOTSET' - character(len=TXTLEN_FILE),save :: oldmonthlyname - real :: fracsum(LIMAX,LJMAX) - - call Code_timer(tim_before) - - if(COMPUTE_LOCAL_TRANSPORT)allocate(tmp_ext(-uEMEP%dist:uEMEP%dist,-uEMEP%dist:uEMEP%dist,1-uEMEP%dist:LIMAX+uEMEP%dist,1-uEMEP%dist:LJMAX+uEMEP%dist,KMAX_MID-uEMEPNvertout+1:KMAX_MID)) - if(iotyp==IOU_HOUR_INST .and. uEMEP%HOUR_INST)then - fileName = trim(runlabel1)//'_uEMEP_hourInst'//date2string(trim(HOURLYFILE_ending),current_date,-1.0) - if(oldhourlyInstname/=fileName)then - first_call(iotyp) = .true. - oldhourlyInstname = fileName - endif - else if(iotyp==IOU_HOUR .and. uEMEP%HOUR)then - fileName = trim(runlabel1)//'_uEMEP_hour'//date2string(trim(HOURLYFILE_ending),current_date,-1.0) - if(oldhourlyname/=fileName)then - first_call(iotyp) = .true. - oldhourlyname = fileName - endif - else if(iotyp==IOU_DAY .and. uEMEP%DAY)then - fileName=trim(runlabel1)//'_uEMEP_day.nc' - else if(iotyp==IOU_MON .and. uEMEP%MONTH)then - if(uEMEP%MONTH_ENDING /= "NOTSET")then - fileName=trim(runlabel1)//'_uEMEP_month'//date2string(trim(uEMEP%MONTH_ENDING),current_date,-1.0) - if(oldmonthlyname/=fileName)then - first_call(iotyp) = .true. - oldmonthlyname = fileName - endif - else - fileName=trim(runlabel1)//'_uEMEP_month.nc' - endif - else if(iotyp==IOU_YEAR .and. uEMEP%YEAR)then - fileName=trim(runlabel1)//'_uEMEP_full.nc' - else - return - endif - ndim=5 - ndim_tot=3 - kmax=uEMEPNvertout - scale=1.0 - CDFtype=Real4 - ! dimSizes(1)=uEMEP%Nsec_poll - ! dimNames(1)='sector' - dimSizes(1)=2*uEMEP%dist+1 - dimNames(1)='x_dist' - dimSizes(2)=2*uEMEP%dist+1 - dimNames(2)='y_dist' - dimSizes(3)=LIMAX - dimSizes(4)=LJMAX - - dimSizes_tot(1)=LIMAX - dimSizes_tot(2)=LJMAX - - select case(projection) - case('Stereographic') - dimNames(3)='i' - dimNames(4)='j' - dimNames_tot(1)='i' - dimNames_tot(2)='j' - case('lon lat') - dimNames(3)='lon' - dimNames(4)='lat' - dimNames_tot(1)='lon' - dimNames_tot(2)='lat' - case('Rotated_Spherical') - dimNames(3)='i' - dimNames(4)='j' - dimNames_tot(1)='i' - dimNames_tot(2)='j' - case('lambert') - dimNames(3)='i' - dimNames(4)='j' - dimNames_tot(1)='i' - dimNames_tot(2)='j' - case default - dimNames(3)='i' - dimNames(4)='j' - dimNames_tot(1)='i' - dimNames_tot(2)='j' - end select - - dimSizes(5)=kmax - dimNames(5)='klevel' - dimSizes_tot(3)=kmax - dimNames_tot(3)='klevel' - def1%class='uEMEP' !written - def1%avg=.false. !not used - def1%index=0 !not used - def1%scale=1.0 !not used - def1%name=trim(varName) - def1%unit='' - def2=def1 - def2%unit='ug/m3' - chunksizes=1 - chunksizes(3)=dimSizes(3) - chunksizes(4)=dimSizes(4) - chunksizes(5)=dimSizes(5) - chunksizes_tot=1 - chunksizes_tot(1)=dimSizes_tot(1) - chunksizes_tot(2)=dimSizes_tot(2) - chunksizes_tot(3)=dimSizes_tot(3) - - isec_poll1=1 - overwrite=.true.!only first time when new file is created - do ipoll=1,uEMEP%Npoll - def2%name=trim(uEMEP%poll(ipoll)%emis) - if(first_call(iotyp))then - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec=uEMEP%poll(ipoll)%sector(iisec) - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_full,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=overwrite,create_var_only=.true.,chunksizes=chunksizes) - overwrite=.false. - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - write(def2%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def2%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - if(me==0)write(*,*)'making '//def2%name - call Out_netCDF(iotyp,def2,ndim,kmax,loc_frac_full,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.true.,chunksizes=chunksizes) - endif - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - if(me==0)write(*,*)'making '//def1%name//' with dimsizes ',(dimSizes_tot(i),i=1,ndim_tot) - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.true.,chunksizes=chunksizes_tot) - endif - enddo - - def2%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_full,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=overwrite,create_var_only=.true.,chunksizes=chunksizes_tot) - - endif - - if(iotyp==IOU_HOUR_INST)then - !compute instantaneous values - !need to transpose loc_frac. Could be avoided? - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=isec_poll1+iisec-1 - isec=uEMEP%poll(ipoll)%sector(iisec) - if(iisec==1)fracsum=0.0 - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - xtot=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))/ATWAIR& - *roa(i,j,k,1)*1.E9 !for ug/m3 - ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 - end do - loc_tot_hour_inst(i,j,k,ipoll)=xtot - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - loc_frac_hour_inst(dx,dy,i,j,k,isec_poll)=loc_frac(isec_poll,dx,dy,i,j,k) - if(iisec==1.and.k==KMAX_MID)fracsum(i,j)=fracsum(i,j)+loc_frac_hour_inst(dx,dy,i,j,k,isec_poll) - enddo - enddo - enddo - enddo - enddo - scale=1.0 - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_hour_inst(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - !loc_frac_hour_instare fractions -> convert first to pollutant - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_frac_hour_inst(dx,dy,i,j,k,isec_poll)=loc_frac_hour_inst(dx,dy,i,j,k,isec_poll)*loc_tot_hour_inst(i,j,k,ipoll) - enddo - enddo - enddo - enddo - enddo - call extendarea_N(loc_frac_hour_inst(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEPNvertout) - - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k)!tmp_ext already converted to pollutant - enddo - enddo - enddo - enddo - enddo - - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - scale=1.0 - call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - enddo - - scale=1.0 - def1%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def1,ndim_tot,kmax,loc_tot_hour_inst(1,1,KMAX_MID-uEMEPNvertout+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - else if(iotyp==IOU_HOUR )then - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=isec_poll1+iisec-1 - isec=uEMEP%poll(ipoll)%sector(iisec) - - if(iisec==1)fracsum=0.0 - !copy before dividing by loc_tot_hour - if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_hour(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEPNvertout) - - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - invtot=1.0/(loc_tot_hour(i,j,k,ipoll)+1.E-20) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - loc_frac_hour(dx,dy,i,j,k,isec_poll)=loc_frac_hour(dx,dy,i,j,k,isec_poll)*invtot - if(iisec==1.and.k==KMAX_MID)fracsum(i,j)=fracsum(i,j)+loc_frac_hour(dx,dy,i,j,k,isec_poll) - enddo - enddo - enddo - enddo - enddo - scale=1.0 - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_hour(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) - enddo - enddo - enddo - enddo - enddo - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - if(abs(av_fac_hour)>1.E-5)then - scale=1.0/av_fac_hour - else - scale=0.0 - endif - if(abs(av_fac_hour)<1.E-5)scale=0.0 - call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - enddo - ! loc_tot_hour=loc_tot_hour/av_fac_hour - if(abs(av_fac_hour)>1.E-5)then - scale=1.0/av_fac_hour - else - scale=0.0 - endif - def1%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def1,ndim_tot,kmax,loc_tot_hour(1,1,KMAX_MID-uEMEPNvertout+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - else if(iotyp==IOU_DAY)then - - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=isec_poll1+iisec-1 - isec=uEMEP%poll(ipoll)%sector(iisec) - !copy before dividing by loc_tot - if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_day(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEPNvertout) - if(iisec==1)fracsum=0.0 - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - invtot=1.0/(loc_tot_day(i,j,k,ipoll)+1.E-20) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - loc_frac_day(dx,dy,i,j,k,isec_poll)=loc_frac_day(dx,dy,i,j,k,isec_poll)*invtot - if(iisec==1.and.k==KMAX_MID)fracsum(i,j)=fracsum(i,j)+loc_frac_day(dx,dy,i,j,k,isec_poll) - enddo - enddo - enddo - enddo - enddo - scale=1.0 - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_day(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) - enddo - enddo - enddo - enddo - enddo - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - if(abs(av_fac_day)>1.E-5)then - scale=1.0/av_fac_day - else - scale=0.0 - endif - call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - enddo - - if(abs(av_fac_day)>1.E-5)then - scale=1.0/av_fac_day - else - scale=0.0 - endif - def2%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_day(1,1,KMAX_MID-uEMEPNvertout+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - else if(iotyp==IOU_MON)then - - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=isec_poll1+iisec-1 - isec=uEMEP%poll(ipoll)%sector(iisec) - !copy before dividing by loc_tot - if(COMPUTE_LOCAL_TRANSPORT)call extendarea_N(loc_frac_month(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEPNvertout) - if(iisec==1)fracsum=0.0 - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - invtot=1.0/(loc_tot_month(i,j,k,ipoll)+1.E-20) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - loc_frac_month(dx,dy,i,j,k,isec_poll)=loc_frac_month(dx,dy,i,j,k,isec_poll)*invtot - if(iisec==1.and.k==KMAX_MID)fracsum(i,j)=fracsum(i,j)+loc_frac_month(dx,dy,i,j,k,isec_poll) - enddo - enddo - enddo - enddo - enddo - scale=1.0 - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_month(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) - enddo - enddo - enddo - enddo - enddo - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - if(abs(av_fac_month)>1.E-5)then - scale=1.0/av_fac_month - else - scale=0.0 - endif - call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - enddo - - if(abs(av_fac_month)>1.E-5)then - scale=1.0/av_fac_month - else - scale=0.0 - endif - def2%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_month(1,1,KMAX_MID-uEMEPNvertout+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - else if(iotyp==IOU_YEAR)then - - do iisec=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=isec_poll1+iisec-1 - isec=uEMEP%poll(ipoll)%sector(iisec) - !copy before dividing by loc_tot_full - if(COMPUTE_LOCAL_TRANSPORT)then - t1 = MPI_WTIME() - call extendarea_N(loc_frac_full(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),tmp_ext,uEMEP%dist,uEMEP_Sizedxdy,uEMEPNvertout) - t2 = MPI_WTIME() - if(me==0)write(*,*)'transport extendarea ',t2-t1,' seconds' - endif - if(iisec==1)fracsum=0.0 - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - do j=1,ljmax - do i=1,limax - invtot=1.0/(loc_tot_full(i,j,k,ipoll)+1.E-20) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - loc_frac_full(dx,dy,i,j,k,isec_poll)=loc_frac_full(dx,dy,i,j,k,isec_poll)*invtot - if(iisec==1.and.k==KMAX_MID)fracsum(i,j)=fracsum(i,j)+loc_frac_full(dx,dy,i,j,k,isec_poll) - enddo - enddo - enddo - enddo - enddo - - scale=1.0 - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_fraction' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_fraction' - call Out_netCDF(iotyp,def1,ndim,kmax,loc_frac_full(-uEMEP%dist,-uEMEP%dist,1,1,KMAX_MID-uEMEPNvertout+1,isec_poll),scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - - if(iisec==1)then - def1%name=trim(uEMEP%poll(ipoll)%emis)//'_fracsum' - call Out_netCDF(iotyp,def1,ndim_tot,1,fracsum,scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - endif - - if(isec==0 .and. COMPUTE_LOCAL_TRANSPORT)then - t1 = MPI_WTIME() - do k = KMAX_MID-uEMEPNvertout+1,KMAX_MID - ! do k = KMAX_MID,KMAX_MID - do j=1,ljmax - do i=1,limax - !invtot=1.0/(1.E-20+loc_tot_full(i,j,k)) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - !in loc_poll_to (dx,dy,i,j) shows from (i,j) to (i+dx,j+dy) - loc_poll_to(dx,dy,i,j,k)=tmp_ext(-dx,-dy,i+dx,j+dy,k) - enddo - enddo - enddo - enddo - enddo - t2 = MPI_WTIME() - if(me==0)write(*,*)'transport transpose ',t2-t1,' seconds' - write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_sec',isec,'_local_transport' - if(isec==0)write(def1%name,"(A,I2.2,A)")trim(uEMEP%poll(ipoll)%emis)//'_local_transport' - if(abs(av_fac_full)>1.E-5)then - scale=1.0/av_fac_full - else - scale=0.0 - endif - call Out_netCDF(iotyp,def1,ndim,kmax,loc_poll_to,scale,CDFtype,dimSizes,dimNames,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - t1 = MPI_WTIME() - if(me==0)write(*,*)'transport out ',t1-t2,' seconds' - endif - enddo - - if(abs(av_fac_full)>1.E-5)then - scale=1.0/av_fac_full - else - scale=0.0 - endif - def2%name=trim(uEMEP%poll(ipoll)%emis) - call Out_netCDF(iotyp,def2,ndim_tot,kmax,loc_tot_full(1,1,KMAX_MID-uEMEPNvertout+1,ipoll),scale,CDFtype,dimSizes_tot,dimNames_tot,out_DOMAIN=uEMEP%DOMAIN,& - fileName_given=trim(fileName),overwrite=.false.,create_var_only=.false.) - else - if(me==0)write(*,*)'IOU not recognized' - endif - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo - - !reset the cumulative counters - if(iotyp==IOU_HOUR)then - av_fac_hour=0 - loc_frac_hour=0.0 - loc_tot_hour=0.0 - else if(iotyp==IOU_DAY)then - av_fac_day=0.0 - loc_frac_day=0.0 - loc_tot_day=0.0 - else if(iotyp==IOU_MON)then - av_fac_month=0.0 - loc_frac_month=0.0 - loc_tot_month=0.0 - else if(iotyp==IOU_YEAR)then - av_fac_full=0.0 - loc_frac_full=0.0 - loc_tot_full=0.0 - endif - - first_call(iotyp)=.false. - if(COMPUTE_LOCAL_TRANSPORT)deallocate(tmp_ext) - - call Add_2timing(NTIMING-2,tim_after,tim_before,"uEMEP: output") - -! CALL MPI_BARRIER(MPI_COMM_CALC, I) - -!stop -end subroutine out_uEMEP - -subroutine av_uEMEP(dt,End_of_Day) - real, intent(in) :: dt ! time-step used in integrations - logical, intent(in) :: End_of_Day ! e.g. 6am for EMEP sites - real :: xtot - integer ::i,j,k,dx,dy,ix,iix,ipoll,isec_poll1 - integer ::isec_poll - - call Code_timer(tim_before) - if(.not. uEMEP%HOUR.and.& - .not. uEMEP%DAY .and.& - .not. uEMEP%MONTH .and.& - .not. uEMEP%YEAR )return - - !do the averaging - do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID - do j=1,ljmax - do i=1,limax - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - xtot=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))/ATWAIR& - *roa(i,j,k,1)*1.E9 !for ug/m3 - ! *(dA(k)+dB(k)*ps(i,j,1))/GRAV*1.E6 !for mg/m2 - end do - if(uEMEP%HOUR)then - loc_tot_hour(i,j,k,ipoll)=loc_tot_hour(i,j,k,ipoll)+xtot - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac_hour(dx,dy,i,j,k,isec_poll)=loc_frac_hour(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) - enddo - enddo - enddo - endif - if(uEMEP%DAY)then - loc_tot_day(i,j,k,ipoll)=loc_tot_day(i,j,k,ipoll)+xtot - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac_day(dx,dy,i,j,k,isec_poll)=loc_frac_day(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) - enddo - enddo - enddo - endif - if(uEMEP%MONTH)then - loc_tot_month(i,j,k,ipoll)=loc_tot_month(i,j,k,ipoll)+xtot - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac_month(dx,dy,i,j,k,isec_poll)=loc_frac_month(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) - enddo - enddo - enddo - endif - if(uEMEP%YEAR)then - loc_tot_full(i,j,k,ipoll)=loc_tot_full(i,j,k,ipoll)+xtot - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac_full(dx,dy,i,j,k,isec_poll)=loc_frac_full(dx,dy,i,j,k,isec_poll)+xtot*loc_frac(isec_poll,dx,dy,i,j,k) - enddo - enddo - enddo - endif - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo - enddo - enddo - enddo - av_fac_hour=av_fac_hour+1.0 - av_fac_day=av_fac_day+1.0 - av_fac_month=av_fac_month+1.0 - av_fac_full=av_fac_full+1.0 - - call Add_2timing(NTIMING-8,tim_after,tim_before,"uEMEP: averaging") - -end subroutine av_uEMEP - - subroutine uemep_adv_y(fluxy,i,j,k) - real, intent(in)::fluxy(NSPEC_ADV,-1:LJMAX+1) - integer, intent(in)::i,j,k - real ::x,xn,xx,f_in,inv_tot - integer ::iix,ix,dx,dy,ipoll,isec_poll,isec_poll1 - - call Code_timer(tim_before) - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - xn=0.0 - x=0.0 - xx=0.0 - !positive x or xx means incoming, negative means outgoing - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) - x=x-xm2(i,j)*fluxy(ix,j)*uEMEP%poll(ipoll)%mw(iix)!flux through "North" face (Up) - xx=xx+xm2(i,j)*fluxy(ix,j-1)*uEMEP%poll(ipoll)%mw(iix)!flux through "South" face (Bottom) - end do - !NB: here xn already includes the fluxes. Remove them! - xn=xn-xx-x - - xn=max(0.0,xn+min(0.0,x)+min(0.0,xx))!include negative part. all outgoing flux - f_in=max(0.0,x)+max(0.0,xx)!positive part. all incoming flux - inv_tot=1.0/(xn+f_in+1.e-20)!incoming dilutes - - xx=max(0.0,xx)*inv_tot!factor due to flux through "South" face (Bottom) - x =max(0.0,x)*inv_tot!factor due to flux through "North" face (Up) - - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k) *xn *inv_tot - enddo - if(x>0.0.and.dy>-uEMEP%dist)then - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)+ loc_frac_1d(isec_poll,dx,dy-1,j+1)*x - enddo - endif - if(xx>0.0.and.dy0.0.and.dx>-uEMEP%dist)then - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)+ loc_frac_1d(isec_poll,dx-1,dy,i+1)*x - enddo - endif - if(xx>0.0.and.dx can use k+1 to access non-updated value - - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - - xn=0.0 - x=0.0 - xx=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - xn=xn+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) - if(kKMAX_MID-uEMEP%Nvert+1)then - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k) * xn * inv_tot & - + loc_frac_km1(isec_poll,dx,dy,k-1) * xx& - + loc_frac(isec_poll,dx,dy,i,j,k+1) * x!k is increasing-> can use k+1 to access non-updated value - enddo - enddo - enddo - else - !k=KMAX_MID-uEMEP%Nvert+1 , assume no local fractions from above - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)* xn * inv_tot & - + loc_frac(isec_poll,dx,dy,i,j,k+1) * x!k is increasing-> can use k+1 to access non-updated value - enddo - enddo - enddo - endif - else - !k=KMAX_MID , no local fractions from below - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = loc_frac(isec_poll,dx,dy,i,j,k)* xn * inv_tot & - + loc_frac_km1(isec_poll,dx,dy,k-1) * xx - enddo - enddo - enddo - endif - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo - - end do - call Add_2timing(NTIMING-5,tim_after,tim_before,"uEMEP: adv_k") - end subroutine uemep_adv_k - - subroutine uemep_diff(i,j,ds3,ds4,ndiff) - - implicit none - interface - subroutine vertdiffn(xn_k,NSPEC,Nij,KMIN_in,SigmaKz,ds3,ds4,ndiff) - real,intent(inout) :: xn_k(NSPEC,0:*)!dummy - real,intent(in):: SigmaKz(*)!dummy - real,intent(in):: ds3(*),ds4(*)!dummy - integer,intent(in):: NSPEC,ndiff,Nij,KMIN_in - end subroutine vertdiffn - end interface - - real, intent(in) :: ds3(2:KMAX_MID),ds4(2:KMAX_MID) - integer, intent(in) :: i,j,ndiff -! real :: xn_k(uEMEP_Size1+uEMEP%Nsec_poll,KMAX_MID),x - real :: xn_k(uEMEP_Size1+uEMEP%Npoll,KMAX_MID),x - integer ::isec_poll1,ipoll,isec_poll - integer ::k,n,ix,iix,dx,dy - !how far diffusion should take place above uEMEP%Nvert. - ! KUP = 2 gives less than 0.001 differences in locfrac, except sometimes over sea, because - !ship emission are higher up and need to come down to diminish locfrac - integer, parameter :: KUP = 2 - - call Code_timer(tim_before) - xn_k = 0.0 - do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - x=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - !assumes mixing ratios units, but weight by mass - x=x+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) - end do - n=0 - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - n=n+1 - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - xn_k((n-1)*(uEMEP%Nsec_poll)+isec_poll,k)=x*loc_frac(isec_poll,dx,dy,i,j,k) - end do - end do - end do - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo - enddo - do k = 1,KMAX_MID - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - x=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - !assumes mixing ratios units, but weight by mass - x=x+xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix) - end do - xn_k(uEMEP_Size1+ipoll,k)=x - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo - enddo - - call vertdiffn(xn_k,uEMEP_Size1+uEMEP%Npoll,1,KMAX_MID-uEMEP%Nvert-KUP,EtaKz(i,j,1,1),ds3,ds4,ndiff) - - do k = KMAX_MID-uEMEP%Nvert+1,KMAX_MID - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - n=0 - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - n=n+1 - x = 1.0/(xn_k(uEMEP_Size1+ipoll,k)+1.E-30) - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k) = xn_k((n-1)*(uEMEP%Nsec_poll)+isec_poll,k)*x - end do - end do - end do - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - end do - end do - call Add_2timing(NTIMING-4,tim_after,tim_before,"uEMEP: diffusion") - end subroutine uemep_diff - -subroutine uEMEP_emis(indate) -!include emission contributions to local fractions - -!NB: should replace most of the stuff and use gridrcemis instead! - - implicit none - type(date), intent(in) :: indate ! Gives year..seconds - integer :: i, j, k, n ! coordinates, loop variables - integer :: icc, ncc ! No. of countries in grid. - integer :: isec ! loop variables: emission sectors - integer :: iem ! loop variable over 1..NEMIS_FILE - - ! Save daytime value between calls, initialise to zero - integer, save, dimension(MAXNLAND) :: daytime(1:MAXNLAND) = 0 ! 0=night, 1=day - integer, save, dimension(MAXNLAND) :: localhour(1:MAXNLAND) = 1 ! 1-24 local hour in the different countries - integer :: hourloc ! local hour - real, dimension(NRCEMIS) :: tmpemis ! local array for emissions - real :: tfac ! time-factor (tmp variable); dt*h*h for scaling - real :: s ! source term (emis) before splitting - integer :: iland, iland_timefac, iland_timefac_hour ! country codes, and codes for timefac - integer :: hour_iland - integer ::icc_uemep, iqrc, itot - integer, save :: wday , wday_loc ! wday = day of the week 1-7 - integer ::ix,iix, dx, dy, isec_poll, iisec_poll, isec_poll1, ipoll - real::dt_uemep, xtot, emis_uemep(KMAX_MID,NEMIS_FILE,NSECTORS),emis_tot(KMAX_MID,NEMIS_FILE) - real :: lon - - call Code_timer(tim_before) - dt_uemep=dt_advec - - wday=day_of_week(indate%year,indate%month,indate%day) - if(wday==0)wday=7 ! Sunday -> 7 - do iland = 1, NLAND - daytime(iland) = 0 - hourloc = indate%hour + Country(iland)%timezone - localhour(iland) = hourloc ! here from 0 to 23 - if(hourloc>=7 .and. hourloc<=18) daytime(iland)=1 - end do ! iland - - do j = lj0,lj1 - do i = li0,li1 - ncc = nlandcode(i,j) ! No. of countries in grid - - !************************************************* - ! loop over sector emissions - !************************************************* - tmpemis(:)=0. - icc_uemep=0 - emis_uemep=0.0 - emis_tot=0.0 - do icc = 1, ncc - ! iland = landcode(i,j,icc) ! 1=Albania, etc. - iland=find_index(landcode(i,j,icc),Country(:)%icode) !array index - call make_iland_for_time(.false., indate, i, j, iland, wday, iland_timefac,hour_iland,wday_loc,iland_timefac_hour) - - do iem = 1, NEMIS_FILE - do isec = 1, Nsectors ! Loop over snap codes - ! Calculate emission rates from secemis, time-factors, - ! and if appropriate any speciation fraction (NEMIS_FRAC) - ! kg/m2/s - - tfac = timefac(iland_timefac,sec2tfac_map(isec),iem) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) - - if(USES%GRIDDED_EMIS_MONTHLY_FACTOR)tfac=tfac* GridTfac(i,j,sec2tfac_map(isec),iem) - - !Degree days - only SNAP-2 - if(USES%DEGREEDAY_FACTORS .and. & - sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors) then - ! If INERIS_SNAP2 set, the fac_min will be zero, otherwise - ! we make use of a baseload even for SNAP2 - tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload - + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) - end if ! =============== HDD - - s = tfac * secemis(isec,i,j,icc,iem) - - do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID - emis_tot(k,iem)=emis_tot(k,iem)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - end do - - !if(isec==uEMEP%sector .or. uEMEP%sector==0)then - do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID - emis_uemep(k,iem,isec)=emis_uemep(k,iem,isec)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - end do - !end if - - end do ! iem - - end do ! isec - ! ================================================== - end do ! icc - - !Add emissions from new format - do n = 1, NEmis_sources - if(Emis_source(n)%include_in_local_fractions)then - itot = Emis_source(n)%species_ix - isec = Emis_source(n)%sector - iland = Emis_source(n)%country_ix - if(itot>0)then - !the species is directly defined (no splits) - iqrc = itot2iqrc(itot) - if(isec>0)then - call CheckStop(itot2iqrc(itot)<=0,"emitted sector species must belong to one of the splitted species") - endif - iem = iqrc2iem(iqrc) - else - iem=find_index(Emis_source(n)%species,EMIS_FILE(:)) - endif - if(isec>0)then - if(Emis_source(n)%periodicity == 'yearly' .or. Emis_source(n)%periodicity == 'monthly')then - !we need to apply hourly factors - call make_iland_for_time(.false., indate, i, j, iland, wday, iland_timefac,hour_iland,wday_loc,iland_timefac_hour) - tfac = fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) - if(Emis_source(n)%periodicity == 'yearly')then - !apply monthly factor on top of hourly factors - tfac = tfac * timefac(iland_timefac,sec2tfac_map(isec),iem) - endif - else - !not monthly or yearly emissions, timefactors must be included in emission values - tfac = 1.0 - endif - - if (USES%GRIDDED_EMIS_MONTHLY_FACTOR) tfac=tfac* GridTfac(i,j,sec2tfac_map(isec),iem) - - !Degree days - only SNAP-2 - if(USES%DEGREEDAY_FACTORS .and. & - sec2tfac_map(isec)==ISNAP_DOM .and. Gridded_SNAP2_Factors) then - ! If INERIS_SNAP2 set, the fac_min will be zero, otherwise - ! we make use of a baseload even for SNAP2 - tfac = ( fac_min(iland,sec2tfac_map(isec),iem) & ! constant baseload - + ( 1.0-fac_min(iland,sec2tfac_map(isec),iem) )* gridfac_HDD(i,j) ) & - * fac_ehh24x7(sec2tfac_map(isec),hour_iland,wday_loc,iland_timefac_hour) - end if ! =============== HDD - - s = Emis_source_2D(i,j,n) * tfac - - do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID - emis_tot(k,iem)=emis_tot(k,iem)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - end do - - do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID - emis_uemep(k,iem,isec)=emis_uemep(k,iem,isec)+s*emis_kprofile(KMAX_BND-k,sec2hfac_map(isec))*dt_uemep - end do - endif - endif - enddo - - isec_poll1=1 - do ipoll=1,uEMEP%Npoll - iem = uEMEP%poll(ipoll)%EMIS_File_ix - - do k=max(KEMISTOP,KMAX_MID-uEMEP%Nvert+1),KMAX_MID - if(emis_tot(k,iem)<1.E-20)cycle - !units kg/m2 - !total pollutant - xtot=0.0 - do iix=1,uEMEP%poll(ipoll)%Nix - ix=uEMEP%poll(ipoll)%ix(iix) - xtot=xtot+(xn_adv(ix,i,j,k)*uEMEP%poll(ipoll)%mw(iix))*(dA(k)+dB(k)*ps(i,j,1))/ATWAIR/GRAV - end do - dx=0 ; dy=0!local fraction from this i,j - do iisec_poll=1,uEMEP%poll(ipoll)%Nsectors - isec_poll=iisec_poll+isec_poll1-1 - isec = uEMEP%poll(ipoll)%sector(iisec_poll) - if(isec==0)then - !sum of all sectors - loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot+emis_tot(k,iem))/(xtot+emis_tot(k,iem)+1.e-20) - else - loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot+emis_uemep(k,iem,isec))/(xtot+emis_tot(k,iem)+1.e-20) - endif - enddo - - !local fractions from other cells are updated (reduced) - do dy=-uEMEP%dist,uEMEP%dist - do dx=-uEMEP%dist,uEMEP%dist - if(dx==0 .and. dy==0)cycle!local fractions from other cells only - do isec_poll=isec_poll1,isec_poll1+uEMEP%poll(ipoll)%Nsectors-1 - loc_frac(isec_poll,dx,dy,i,j,k)=(loc_frac(isec_poll,dx,dy,i,j,k)*xtot)/(xtot+emis_tot(k,iem)+1.e-20) - enddo - enddo - enddo - - end do! k - isec_poll1=isec_poll1+uEMEP%poll(ipoll)%Nsectors - enddo!Npoll - end do ! i - end do ! j - - call Add_2timing(NTIMING-3,tim_after,tim_before,"uEMEP: emissions") - -end subroutine uEMEP_emis - - -end module uEMEP_mod