Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
IPSL
LMD
InTro
Multiscale Transport
Commits
648f764a
Commit
648f764a
authored
Jul 06, 2021
by
Thomas Dubos
Committed by
Romain Pennel
Jul 08, 2021
Browse files
Emit stuff at one grid point
parent
4ffa0f79
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
61 additions
and
3 deletions
+61
-3
DYNAMICO_emission/src/emission.F90
DYNAMICO_emission/src/emission.F90
+61
-3
No files found.
DYNAMICO_emission/src/emission.F90
View file @
648f764a
...
...
@@ -11,6 +11,8 @@ MODULE emission
REAL
,
PARAMETER
::
oneday
=
86400.
! hard-coded
INTEGER
,
PARAMETER
::
log_unit
=
15
INTEGER
::
emission_ij
! index of cell where volcanic emissions occur
! TYPE(t_field),POINTER :: f_write2d(:), f_write_llm(:), f_write_llmp1(:)
...
...
@@ -27,13 +29,52 @@ CONTAINS
USE
getin_mod
,
ONLY
:
getin
USE
physics_interface_mod
,
ONLY
:
inout
=>
physics_inout
REAL
(
rstd
)
::
unjours
WRITE
(
*
,
*
)
'init_emission called'
unjours
=
86400.
CALL
getin
(
'unjours'
,
unjours
)
CALL
init_emission
(
inout
%
lon
,
inout
%
lat
)
END
SUBROUTINE
init_physics
SUBROUTINE
init_emission
(
lon
,
lat
)
USE
icosa
,
ONLY
:
rstd
USE
getin_mod
,
ONLY
:
getin
USE
spherical_geom_mod
,
ONLY
:
dist_lonlat
! distance on the sphere
REAL
(
rstd
),
INTENT
(
IN
)
::
lon
(:),
lat
(:)
REAL
(
rstd
)
::
emission_lon
,
emission_lat
,
dist
,
dist_min
,
dist_max
INTEGER
::
ij
,
ij_min
WRITE
(
*
,
*
)
'init_emission called'
emission_lon
=
0.
CALL
getin
(
'emission_lon'
,
emission_lon
)
emission_lat
=
0.
CALL
getin
(
'emission_lat'
,
emission_lat
)
dist_max
=
1e-4
CALL
getin
(
'emission_dist_max'
,
dist_max
)
dist_min
=
4.
! distances on the unit sphere are always less than pi
ij_min
=
1
DO
ij
=
1
,
SIZE
(
lon
)
CALL
dist_lonlat
(
emission_lon
,
emission_lat
,
lon
(
ij
),
lat
(
ij
),
dist
)
IF
(
dist
<
dist_min
)
THEN
dist_min
=
dist
ij_min
=
ij
END
IF
END
DO
PRINT
*
,
'emission lon, lat :'
,
emission_lon
,
emission_lat
PRINT
*
,
'closest lon, lat :'
,
lon
(
ij_min
),
lat
(
ij_min
)
PRINT
*
,
'dist to closest cell :'
,
ij
,
dist_min
IF
(
dist_min
<
dist_max
)
THEN
emission_ij
=
ij_min
ELSE
! if the closest point is too far from the target, this means that
! this points is on another MPI process
emission_ij
=
-1
END
IF
END
SUBROUTINE
init_emission
SUBROUTINE
physics
USE
mpipara
,
ONLY
:
is_mpi_master
...
...
@@ -66,8 +107,25 @@ CONTAINS
! & inout%p, play, pphi, &
! & inout%ulon, inout%ulat, inout%temp, &
! & inout%dulon, inout%dulat, inout%dtemp, dps)
IF
(
emission_ij
>
0
)
THEN
inout
%
dq
(:,:,:)
=
0.
CALL
emit
(
llm
,
time
,
inout
%
p
(
emission_ij
,
:),
inout
%
geopot
(
emission_ij
,:),
&
&
inout
%
dq
(
emission_ij
,:,
1
)
)
END
IF
END
SUBROUTINE
physics
SUBROUTINE
emit
(
llm
,
time
,
p
,
geopot
,
dq
)
USE
icosa
,
ONLY
:
rstd
INTEGER
,
INTENT
(
IN
)
::
llm
! number of model layers
REAL
(
rstd
),
INTENT
(
IN
)
::
time
! current time in seconds since start of simulation
REAL
(
rstd
),
INTENT
(
IN
)
::
p
(:),
&
! pressure at interfaces
&
geopot
(:)
! geopotential at interfaces
REAL
(
rstd
),
INTENT
(
OUT
)
::
dq
(:)
! uniform emission on the whole column
dq
(:)
=
1.
END
SUBROUTINE
emit
SUBROUTINE
compute_play
(
ngrid
,
llm
,
plev
,
play
)
INTEGER
,
INTENT
(
IN
)
::
ngrid
,
llm
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment