Docker-in-Docker (DinD) capabilities of public runners deactivated. More info

Commit 648f764a authored by Thomas Dubos's avatar Thomas Dubos Committed by Romain Pennel
Browse files

Emit stuff at one grid point

parent 4ffa0f79
......@@ -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
......
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