Skip to content

GitLab

Commit 4138764d authored by Sabine's avatar Sabine
Browse files

Merge remote-tracking branch 'refs/remotes/origin/dev' into dev

parents 03adec6e 759df5f2
Hide whitespace changes
Inline Side-by-side
src/clustering.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine clustering(xl,yl,zl,n,xclust,yclust,zclust,fclust,rms, &
rmsclust,zrms)
! i i i i o o o o o
......
src/cmapf_mod.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
! Changes to the routines by A. Stohl
! xi,xi0,eta,eta0 are double precision variables to avoid problems
! at poles
......@@ -228,7 +231,7 @@ real function cgszll (strcmp, xlat,xlong)
ymerc = log((1. + slat) / (1. - slat))/2.
!efact = exp(ymerc)
!cgszll = 2. * strcmp(7) * exp (strcmp(1) * ymerc)
!c / (efact + 1./efact)
!c / (efact + 1./efact)
endif
cgszll = strcmp(7) * cos(radpdg * xlat) * exp(strcmp(1) *ymerc)
return
......
src/com_mod.f90
View file @ 4138764d
......@@ -24,7 +24,7 @@ module com_mod
! Variables defining where FLEXPART input/output files are stored
!****************************************************************
character :: path(numpath+2*maxnests)*120
character :: path(numpath+2*maxnests)*200
integer :: length(numpath+2*maxnests)
character(len=256) :: pathfile, flexversion, flexversion_major, arg1, arg2
character(len=256) :: ohfields_path
......
src/conccalc.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine conccalc(itime,weight)
! i i
!*****************************************************************************
......
src/conccalc_mpi.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine conccalc(itime,weight)
! i i
!*****************************************************************************
......
src/concoutput.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
......
src/concoutput_inversion.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
......
src/concoutput_inversion_nest.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_inversion_nest(itime,outnum)
! i i
!*****************************************************************************
......
src/concoutput_mpi.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
......@@ -55,6 +58,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
integer :: sp_count_i,sp_count_r
real :: sp_fact
real :: outnum,densityoutrecept(maxreceptor),xl,yl
! RLT
real :: densitydryrecept(maxreceptor)
real :: factor_dryrecept(maxreceptor)
!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
......@@ -89,6 +95,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! mind eso: added to ensure identical results between 2&3-fields versions
character(LEN=8),save :: file_stat='REPLACE'
logical :: ldates_file
logical :: lexist
integer :: ierr
character(LEN=100) :: dates_char
......@@ -190,6 +197,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
! rho(iix,jjy,kzz-1,2)*dz2)/dz
densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
rho(iix,jjy,kzz-1,mind)*dz2)/dz
! RLT
densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
end do
end do
end do
......@@ -201,8 +211,14 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
jjy=max(min(nint(yl),nymin1),0)
!densityoutrecept(i)=rho(iix,jjy,1,2)
densityoutrecept(i)=rho(iix,jjy,1,mind)
! RLT
densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
end do
! RLT
! conversion factor for output relative to dry air
factor_drygrid=densityoutgrid/densitydrygrid
factor_dryrecept=densityoutrecept/densitydryrecept
! Output is different for forward and backward simulations
do kz=1,numzgrid
......@@ -255,11 +271,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
endif
write(unitoutgrid) itime
endif
if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
atime//'_'//anspec,form='unformatted')
write(unitoutgridppt) itime
endif
endif ! if deposition output
......@@ -603,6 +617,49 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
end do
! RLT Aug 2017
! Write out conversion factor for dry air
inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
if (lexist) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
status='new',action='write')
endif
sp_count_i=0
sp_count_r=0
sp_fact=-1.
sp_zer=.true.
do kz=1,numzgrid
do jy=0,numygrid-1
do ix=0,numxgrid-1
if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
if (sp_zer.eqv..true.) then ! first value not equal to one
sp_count_i=sp_count_i+1
sparse_dump_i(sp_count_i)= &
ix+jy*numxgrid+kz*numxgrid*numygrid
sp_zer=.false.
sp_fact=sp_fact*(-1.)
endif
sp_count_r=sp_count_r+1
sparse_dump_r(sp_count_r)= &
sp_fact*factor_drygrid(ix,jy,kz)
else ! factor is one
sp_zer=.true.
endif
end do
end do
end do
write(unitoutfactor) sp_count_i
write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutfactor) sp_count_r
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
wetgridtotal
......@@ -629,7 +686,23 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
end do
endif
! RLT Aug 2017
! Write out conversion factor for dry air
if (numreceptor.gt.0) then
inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
if (lexist) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
status='new',action='write')
endif
write(unitoutfactor) itime
write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
close(unitoutfactor)
endif
! Reinitialization of grid
!*************************
......
src/concoutput_nest.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_nest(itime,outnum)
! i i
!*****************************************************************************
......@@ -584,7 +587,6 @@ subroutine concoutput_nest(itime,outnum)
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
! Reinitialization of grid
!*************************
......
src/concoutput_nest_mpi.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_nest(itime,outnum)
! i i
!*****************************************************************************
......@@ -36,7 +39,6 @@ subroutine concoutput_nest(itime,outnum)
! *
!*****************************************************************************
use unc_mod
use point_mod
use outg_mod
......@@ -52,6 +54,9 @@ subroutine concoutput_nest(itime,outnum)
integer :: sp_count_i,sp_count_r
real :: sp_fact
real :: outnum,densityoutrecept(maxreceptor),xl,yl
! RLT
real :: densitydryrecept(maxreceptor)
real :: factor_dryrecept(maxreceptor)
!real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
......@@ -78,6 +83,7 @@ subroutine concoutput_nest(itime,outnum)
logical :: sp_zer
character :: adate*8,atime*6
character(len=3) :: anspec
logical :: lexist
integer :: mind
! mind eso:added to ensure identical results between 2&3-fields versions
......@@ -154,6 +160,9 @@ subroutine concoutput_nest(itime,outnum)
! rho(iix,jjy,kzz-1,2)*dz2)/dz
densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
rho(iix,jjy,kzz-1,mind)*dz2)/dz
! RLT
densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
end do
end do
end do
......@@ -165,8 +174,14 @@ subroutine concoutput_nest(itime,outnum)
jjy=max(min(nint(yl),nymin1),0)
!densityoutrecept(i)=rho(iix,jjy,1,2)
densityoutrecept(i)=rho(iix,jjy,1,mind)
! RLT
densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
end do
! RLT
! conversion factor for output relative to dry air
factor_drygrid=densityoutgrid/densitydrygrid
factor_dryrecept=densityoutrecept/densitydryrecept
! Output is different for forward and backward simulations
do kz=1,numzgrid
......@@ -189,6 +204,16 @@ subroutine concoutput_nest(itime,outnum)
do ks=1,nspec
write(anspec,'(i3.3)') ks
if (DRYBKDEP.or.WETBKDEP) then !scavdep output
if (DRYBKDEP) &
open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_nest_'//adate// &
atime//'_'//anspec,form='unformatted')
if (WETBKDEP) &
open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_nest_'//adate// &
atime//'_'//anspec,form='unformatted')
write(unitoutgrid) itime
else
if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
if (ldirect.eq.1) then
open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
......@@ -201,6 +226,7 @@ subroutine concoutput_nest(itime,outnum)
endif
write(unitoutgrid) itime
endif
endif
if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio
open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
......@@ -531,30 +557,72 @@ subroutine concoutput_nest(itime,outnum)
end do
! Reinitialization of grid
!*************************
do ks=1,nspec
do kp=1,maxpointspec_act
do i=1,numreceptor
creceptor(i,ks)=0.
end do
do jy=0,numygridn-1
do ix=0,numxgridn-1
do l=1,nclassunc
do nage=1,nageclass
do kz=1,numzgrid
griduncn(ix,jy,kz,ks,kp,l,nage)=0.
end do
end do
end do
end do
! RLT Aug 2017
! Write out conversion factor for dry air
inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
if (lexist) then
! open and append
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
status='old',action='write',access='append')
else
! create new
open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
status='new',action='write')
endif
sp_count_i=0
sp_count_r=0
sp_fact=-1.
sp_zer=.true.
do kz=1,numzgrid
do jy=0,numygridn-1
do ix=0,numxgridn-1
if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
if (sp_zer.eqv..true.) then ! first value not equal to one
sp_count_i=sp_count_i+1
sparse_dump_i(sp_count_i)= &
ix+jy*numxgridn+kz*numxgridn*numygridn
sp_zer=.false.
sp_fact=sp_fact*(-1.)
endif
sp_count_r=sp_count_r+1
sparse_dump_r(sp_count_r)= &
sp_fact*factor_drygrid(ix,jy,kz)
else ! factor is one
sp_zer=.true.
endif
end do
end do
end do
write(unitoutfactor) sp_count_i
write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
write(unitoutfactor) sp_count_r
write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
close(unitoutfactor)
! Reinitialization of grid
!*************************
! do ks=1,nspec
! do kp=1,maxpointspec_act
! do i=1,numreceptor
! creceptor(i,ks)=0.
! end do
! do jy=0,numygridn-1
! do ix=0,numxgridn-1
! do l=1,nclassunc
! do nage=1,nageclass
! do kz=1,numzgrid
! griduncn(ix,jy,kz,ks,kp,l,nage)=0.
! end do
! end do
! end do
! end do
! end do
! end do
! end do
creceptor(:,:)=0.
griduncn(:,:,:,:,:,:,:)=0.
if (mp_measure_time) call mpif_mtime('iotime',1)
! if (mp_measure_time) then
! call cpu_time(mp_root_time_end)
......
src/concoutput_surf.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
......
src/concoutput_surf_mpi.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc, &
drygridtotalunc)
! i i o o
......
src/concoutput_surf_nest.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_surf_nest(itime,outnum)
! i i
!*****************************************************************************
......
src/concoutput_surf_nest_mpi.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine concoutput_surf_nest(itime,outnum)
! i i
!*****************************************************************************
......@@ -629,23 +632,23 @@ subroutine concoutput_surf_nest(itime,outnum)
!*************************
do ks=1,nspec
do kp=1,maxpointspec_act
do i=1,numreceptor
creceptor(i,ks)=0.
end do
do jy=0,numygridn-1
do ix=0,numxgridn-1
do l=1,nclassunc
do nage=1,nageclass
do kz=1,numzgrid
griduncn(ix,jy,kz,ks,kp,l,nage)=0.
do kp=1,maxpointspec_act
do i=1,numreceptor
creceptor(i,ks)=0.
end do
do jy=0,numygridn-1
do ix=0,numxgridn-1
do l=1,nclassunc
do nage=1,nageclass
do kz=1,numzgrid
griduncn(ix,jy,kz,ks,kp,l,nage)=0.
end do
end do
end do
end do
end do
end do
end do
end do
if (mp_measure_time) call mpif_mtime('iotime',1)
! if (mp_measure_time) then
......
src/convect43c.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
!**************************************************************************
!**** SUBROUTINE CONVECT *****
!**** VERSION 4.3c *****
......
src/convmix.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine convmix(itime,metdata_format)
! i
!**************************************************************
......
src/coordtrafo.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
subroutine coordtrafo
!**********************************************************************
......
src/detectformat.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
integer function detectformat()
!*****************************************************************************
......
src/distance.f90
View file @ 4138764d
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
!-----------------------------------------------------------------------
function distance(rlat1,rlon1,rlat2,rlon2)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment