Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Lake Precision Update #601

Draft
wants to merge 5 commits into
base: main
Choose a base branch
from
Draft

Lake Precision Update #601

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
1b1340a
made lake variables double precision
Sep 8, 2020
2efcfb1
double precision on lake variables
Sep 16, 2020
2864a14
few changes made to the code to pass the perfect restarts test
Sep 21, 2020
2f91cb7
Update reservoir assimilated values to doubles
rcabell Dec 7, 2021
c6b8a46
Add missing mpp_land_bcast_real8() and read_rst_crt_nc8() subroutines
rcabell Jan 26, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/Data_Rec/module_RT_data.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ Module module_RT_data
use module_subsurface_input
use module_subsurface_output
use module_reservoir, only: reservoir_container
use iso_fortran_env, only: int64
use iso_fortran_env, only: int64, real64
IMPLICIT NONE
INTEGER, PARAMETER :: max_domain=5

Expand Down
8 changes: 4 additions & 4 deletions src/Data_Rec/rt_include.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
class (reservoir_container), allocatable, dimension(:) :: reservoirs
integer, allocatable, dimension(:) :: reservoir_type ! specifying type of reservoir
integer, allocatable, dimension(:) :: final_reservoir_type ! resolved reservoir type (since it can change)
real, allocatable, dimension(:) :: reservoir_assimilated_value ! observation or forecast assimilated to reservoir discharge
real*8, allocatable, dimension(:) :: reservoir_assimilated_value ! observation or forecast assimilated to reservoir discharge
character(len=256), allocatable, dimension(:) :: reservoir_assimilated_source_file ! source file of assimilated value

INTEGER :: IX, JX
Expand Down Expand Up @@ -129,8 +129,8 @@
INTEGER, allocatable, DIMENSION(:) :: TYPEL !type of link Muskingum: 0 strm 1 lake
!-- Diffusion: 0 edge or pour; 1 interior; 2 lake
INTEGER, allocatable, DIMENSION(:) :: TYPEN !type of link 0 strm 1 lake
REAL, allocatable, DIMENSION(:) :: QLAKEI !lake inflow in difussion scheme
REAL, allocatable, DIMENSION(:) :: QLAKEO !lake outflow in difussion scheme
REAL(kind=real64), allocatable, DIMENSION(:) :: QLAKEI !lake inflow in difussion scheme
REAL(kind=real64), allocatable, DIMENSION(:) :: QLAKEO !lake outflow in difussion scheme
INTEGER(kind=int64), allocatable, DIMENSION(:) :: LAKENODE !which nodes flow into which lakes
integer(kind=int64), allocatable, dimension(:) :: LINKID ! id of links on linked routing
REAL, allocatable, DIMENSION(:) :: CVOL ! channel volume
Expand Down Expand Up @@ -159,7 +159,7 @@
REAL, DIMENSION(50) :: TOPWIDCC, NCC !topwidth and mannings n of compund

! VARIABLES FOR RESERVOIRS
REAL, allocatable, DIMENSION(:) :: RESHT !reservoir height
REAL*8, allocatable, DIMENSION(:) :: RESHT !reservoir height
!-- lake params
integer(kind=int64), allocatable, dimension(:) :: LAKEIDA !id of lakes in routlink file
integer(kind=int64), allocatable, dimension(:) :: LAKEIDM !id of LAKES Modeled in LAKEPARM.nc or tbl
Expand Down
89 changes: 78 additions & 11 deletions src/MPP/mpp_land.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1096,6 +1096,17 @@ subroutine mpp_land_bcast_real(size1,inout)
return
end subroutine mpp_land_bcast_real

subroutine mpp_land_bcast_real8(size1,inout)
integer size1
! real inout(size1)
real*8 , dimension(:) :: inout
integer ierr, len
call mpi_bcast(inout,size1,MPI_REAL8, &
IO_id,HYDRO_COMM_WORLD,ierr)
call mpp_land_sync()
return
end subroutine mpp_land_bcast_real8

subroutine mpp_land_bcast_int2d(inout)
integer length1, k,length2
integer inout(:,:)
Expand Down Expand Up @@ -2092,9 +2103,52 @@ subroutine write_chanel_int8(v,map_l2g,gnlinks,nlinks,g_v)
end subroutine write_chanel_int8


subroutine write_lake_real(v,nodelist_in,nlakes)
subroutine write_lake_real8(v,nodelist_in,nlakes)
implicit none
real recv(nlakes), v(nlakes)
real*8 recv(nlakes)
!real recv(nlakes)
real*8 v(nlakes)
integer nodelist(nlakes), nlakes, nodelist_in(nlakes)
integer i, ierr, tag, k
integer length, node

nodelist = nodelist_in
if(my_id .eq. IO_id) then
do i = 0, numprocs - 1
if(i .ne. my_id) then
!block receive from other node.
tag = 129
call mpi_recv(nodelist,nlakes,MPI_INTEGER,i, &
tag,HYDRO_COMM_WORLD,mpp_status,ierr)
tag = 139
!call mpi_recv(recv(:),nlakes,MPI_REAL,i, &
call mpi_recv(recv(:),nlakes,MPI_DOUBLE_PRECISION,i, &
tag,HYDRO_COMM_WORLD,mpp_status,ierr)

do k = 1,nlakes
if(nodelist(k) .gt. -99) then
node = nodelist(k)
v(node) = recv(node)
endif
enddo
end if
end do
else
tag = 129
call mpi_send(nodelist,nlakes,MPI_INTEGER, IO_id, &
tag,HYDRO_COMM_WORLD,ierr)
tag = 139
!call mpi_send(v,nlakes,MPI_REAL,IO_id, &
call mpi_send(v,nlakes,MPI_DOUBLE_PRECISION,IO_id, &
tag,HYDRO_COMM_WORLD,ierr)
end if
end subroutine write_lake_real8


subroutine write_lake_real(v,nodelist_in,nlakes)
implicit none
real recv(nlakes)
real v(nlakes)
integer nodelist(nlakes), nlakes, nodelist_in(nlakes)
integer i, ierr, tag, k
integer length, node
Expand Down Expand Up @@ -2604,29 +2658,38 @@ end subroutine updateLake_seqInt8
subroutine updateLake_seq(in,nsize,in0)
implicit none
integer :: nsize
real, dimension(nsize) :: in
real, dimension(nsize) :: tmp
real, dimension(:) :: in0
real*8, dimension(nsize) :: in
real*8, dimension(nsize) :: tmp
real*8, dimension(:) :: in0
integer tag, i, status, ierr, k
if(nsize .le. 0) return

tag = 29
if(my_id .ne. IO_id) then
call mpi_send(in,nsize,MPI_REAL, IO_id, &

! call mpi_send(in,nsize,MPI_REAL, IO_id, &
! tag,HYDRO_COMM_WORLD,ierr)
call mpi_send(in,nsize,MPI_double, IO_id, &
tag,HYDRO_COMM_WORLD,ierr)
else
do i = 0, numprocs - 1
if(i .ne. IO_id) then

! call mpi_recv(tmp,nsize,&
! MPI_REAL,i,tag,HYDRO_COMM_WORLD,mpp_status,ierr)
call mpi_recv(tmp,nsize,&
MPI_REAL,i,tag,HYDRO_COMM_WORLD,mpp_status,ierr)
do k = 1, nsize
MPI_double,i,tag,HYDRO_COMM_WORLD,mpp_status,ierr)

do k = 1, nsize
if(in0(k) .ne. tmp(k)) in(k) = tmp(k)
end do
end if
end do
end if
call mpp_land_bcast_real_1d(in)
!call mpp_land_bcast_real_1d(in)
call mpp_land_bcast_real8_1d(in)


end subroutine updateLake_seq


Expand Down Expand Up @@ -2664,7 +2727,8 @@ end subroutine updateLake_seq_char
subroutine updateLake_grid(in,nsize,lake_index)
implicit none
integer :: nsize
real, dimension(nsize) :: in
!real, dimension(nsize) :: in
real*8, dimension(nsize) :: in
integer, dimension(nsize) :: lake_index
real, dimension(nsize) :: tmp
integer tag, i, status, ierr, k
Expand Down Expand Up @@ -2692,8 +2756,11 @@ subroutine updateLake_grid(in,nsize,lake_index)
end if
end do
end if
call mpp_land_bcast_real_1d(in)

!call mpp_land_bcast_real_1d(in)
call mpp_land_bcast_real8_1d(in)


end subroutine updateLake_grid


Expand Down
Loading