Skip to content

Commit

Permalink
release of JAGURS-D_V501.RC01(src)
Browse files Browse the repository at this point in the history
  • Loading branch information
@jagurs-admin
jagurs-admin authored Sep 3, 2018
1 parent 45a786a commit 05c2d6e
Show file tree
Hide file tree
Showing 5 changed files with 398 additions and 4 deletions.
75 changes: 75 additions & 0 deletions src/mod_bank.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,24 +18,45 @@ subroutine read_bank_file(dg)

integer(kind=4), pointer :: nx, ny
#if !defined(MPI) || !defined(ONEFILE)
#ifdef CARTESIAN
real(kind=REAL_BYTE), pointer :: mlon0, mlat0, dh
#else
real(kind=REAL_BYTE), pointer :: mlon0, mlat0
real(kind=REAL_BYTE) :: dh
#endif
#else
#ifdef CARTESIAN
real(kind=REAL_BYTE), pointer :: dh
#else
real(kind=REAL_BYTE) :: dh
#endif
integer(kind=4), pointer :: kx, kyend, totalNy
real(kind=REAL_BYTE) :: mlon0, mlat0
#endif
integer(kind=4), pointer, dimension(:,:) :: ir
real(kind=REAL_BYTE), pointer, dimension(:,:) :: btx, bty

#ifndef CARTESIAN
real(kind=REAL_BYTE), allocatable, dimension(:) :: xin, yin
real(kind=REAL_BYTE) :: xtmpin, ytmpin
#endif
#ifdef OLDFORMAT
integer(kind=4), allocatable, dimension(:) :: x, y, val

#ifdef CARTESIAN
integer(kind=4) :: n, i, j, num_lines, xtmp, ytmp, valtmp
#else
integer(kind=4) :: n, i, j, num_lines, valtmp
#endif
#else
integer(kind=4), allocatable, dimension(:) :: x, y, irread
real(kind=REAL_BYTE), allocatable, dimension(:) :: height

#ifdef CARTESIAN
integer(kind=4) :: n, i, j, num_lines, xtmp, ytmp, irtmp
#else
integer(kind=4) :: n, i, j, num_lines, irtmp
#endif
real(kind=REAL_BYTE) :: heighttmp
#endif
real(kind=REAL_BYTE) :: bh
Expand All @@ -47,15 +68,27 @@ subroutine read_bank_file(dg)

num_lines = 0
do while(.true.)
#ifdef CARTESIAN
#ifdef OLDFORMAT
read(1,*,end=100) xtmp, ytmp, valtmp
#else
read(1,*,end=100) ytmp, xtmp, irtmp, heighttmp
#endif
#else
#ifdef OLDFORMAT
read(1,*,end=100) xtmpin, ytmpin, valtmp
#else
read(1,*,end=100) ytmpin, xtmpin, irtmp, heighttmp
#endif
#endif
num_lines = num_lines + 1
end do
100 write(6,'(a,i6)') '[bank] Number of banks: ', num_lines

#ifndef CARTESIAN
allocate(xin(num_lines))
allocate(yin(num_lines))
#endif
allocate(x(num_lines))
allocate(y(num_lines))
#ifdef OLDFORMAT
Expand All @@ -67,15 +100,24 @@ subroutine read_bank_file(dg)

rewind(1)
do n = 1, num_lines
#ifdef CARTESIAN
#ifdef OLDFORMAT
read(1,*) x(n), y(n), val(n)
#else
read(1,*) y(n), x(n), irread(n), height(n)
#endif
#else
#ifdef OLDFORMAT
read(1,*) xin(n), yin(n), val(n)
#else
read(1,*) yin(n), xin(n), irread(n), height(n)
#endif
#endif
end do

nx => dg%my%nx
ny => dg%my%ny
#ifdef CARTESIAN
#if !defined(MPI) || !defined(ONEFILE)
mlon0 => dg%my%mlon0
mlat0 => dg%my%mlat0
Expand All @@ -89,6 +131,30 @@ subroutine read_bank_file(dg)
mlon0 = dg%my%mlon0 + (kx - 1)*dh
mlat0 = dg%my%mlat0 + (totalNy - 1)*dh - (kyend - 1)*dh
#endif
#else
#if !defined(MPI) || !defined(ONEFILE)
mlon0 => dg%my%mlon0
mlat0 => dg%my%mlat0
dh = dg%my%dh*60.0d0
#else
mlon0 = dg%my%mlon0
mlat0 = dg%my%mlat0
dh = dg%my%dh*60.0d0
#endif
#endif
#ifndef CARTESIAN
if(mlon0 < 0.0d0) then
do n = 1, num_lines
xin(n) = (360.0d0+xin(n))*60.0d0
yin(n) = (90.0d0-yin(n))*60.0d0
end do
else
do n = 1, num_lines
xin(n) = xin(n)*60.0d0
yin(n) = (90.0d0-yin(n))*60.0d0
end do
end if
#endif

ir => dg%wave_field%ir
btx => dg%wave_field%btx
Expand All @@ -97,9 +163,14 @@ subroutine read_bank_file(dg)
do n = 1, num_lines
! x(n) = int((x(n) - mlon0 + 0.5d0)/dh) + 1
! y(n) = int((y(n) - mlat0 + 0.5d0)/dh) + 1
#ifdef CARTESIAN
x(n) = floor((x(n) - mlon0 + 0.5d0)/dh) + 1
y(n) = floor((y(n) - mlat0 + 0.5d0)/dh) + 1
y(n) = ny - y(n) + 1
#else
x(n) = floor((xin(n) - mlon0)/dh) + 1
y(n) = floor((yin(n) - mlat0)/dh) + 1
#endif

#ifdef MPI
if((x(n) >= 0) .and. (x(n) <= nx+1) .and. (y(n) >= 0) .and. (y(n) <= ny+1)) then
Expand Down Expand Up @@ -169,6 +240,10 @@ subroutine read_bank_file(dg)
end do
#endif

#ifndef CARTESIAN
deallocate(xin)
deallocate(yin)
#endif
deallocate(x)
deallocate(y)
#ifdef OLDFORMAT
Expand Down
106 changes: 106 additions & 0 deletions src/mod_fxy.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,9 @@ module mod_fxy
! === Limiter with max Froude number. ==========================================
use mod_params, only : froude_lim
! ==============================================================================
#ifdef BANKFILE
use mod_params, only : broken_rate
#endif
implicit none

contains
Expand Down Expand Up @@ -121,6 +124,13 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,cflag,dt,th0,dth,joff,nlon,nlat,
! === Limiter with max Froude number. ==========================================
real(kind=REAL_BYTE) :: d, lim
! ==============================================================================
#ifdef BANKFILE
integer(kind=4), pointer, dimension(:,:) :: ir, brokenx, brokeny
real(kind=REAL_BYTE), pointer, dimension(:,:) :: btx, bty, dx, dy

real(kind=REAL_BYTE) :: zhigh, zlow, discharge, dhigh
real(kind=REAL_BYTE), parameter :: GX = 1.0d-5, GY = 1.0d-10
#endif

fx => wfld%fx
fy => wfld%fy
Expand All @@ -129,8 +139,24 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,cflag,dt,th0,dth,joff,nlon,nlat,
fy_old => wfld%fy_old
hz_old => wfld%hz_old

#ifndef BANKFILE
ddx => dfld%dx
ddy => dfld%dy
#else
if(allocated(wfld%ir)) then
ir => wfld%ir

ddx => dfld%dxbx
ddy => dfld%dyby

btx => wfld%btx
dx => dfld%dx
brokenx => wfld%brokenx
bty => wfld%bty
dy => dfld%dy
brokeny => wfld%brokeny
end if
#endif
dz => dfld%dz

dtds = dt/(dth*rote)
Expand Down Expand Up @@ -665,6 +691,46 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,cflag,dt,th0,dth,joff,nlon,nlat,
end do
end do
! ==============================================================================
#ifdef BANKFILE
if(allocated(wfld%ir)) then
!$omp do private(i, zhigh, zlow, discharge, dhigh)
do j = jst, jnd
do i = ist, ind
if((ir(i,j) == 1) .or. (ir(i,j) == 3)) then
dhigh = min(dz(i,j), dz(i+1,j))
! === CRITICAL! Almost all line-data will be ignored!!! ========================
! if(ddx(i,j) > -dhigh) then
if(ddx(i,j) < dhigh) then
! ==============================================================================
! === CAL. OF DISCHANGE OF OVERFLOW ===
if(hz(i,j) + ddx(i,j) > hz(i+1,j) + ddx(i,j)) then
zhigh = hz(i,j) + ddx(i,j)
zlow = hz(i+1,j) + ddx(i,j)
else
zhigh = hz(i+1,j) + ddx(i,j)
zlow = hz(i,j) + ddx(i,j)
end if
if(zhigh < GX) then
fx(i,j) = zap
else
if(zhigh*0.66667d0 < zlow) then
discharge = 4.029d0*zlow*sqrt(zhigh - zlow) ! 4.029 = u'*(9.8*2)*0.5, u' = 2.6u
else
discharge = 1.55d0*zhigh**1.5d0 ! 1.55 = u*(9.8*2)*0.5, u = 0.35
end if
if(hz(i+1,j) + ddx(i,j) > hz(i,j) + ddx(i,j)) discharge = -discharge
fx(i,j) = discharge
if(brokenx(i,j) == 0) then
btx(i,j) = broken_rate*(btx(i,j) - dhigh) + dhigh
brokenx(i,j) = 1
end if
end if
end if
end if
end do
end do
end if
#endif
!$omp do private(i, dh)
do j = jst, jnd
do i = ist, ind
Expand All @@ -688,6 +754,46 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,cflag,dt,th0,dth,joff,nlon,nlat,
end do
end do
! ==============================================================================
#ifdef BANKFILE
if(allocated(wfld%ir)) then
!$omp do private(i, zhigh, zlow, discharge, dhigh)
do j = jst, jnd
do i = ist, ind
if((ir(i,j+1) == 2) .or. (ir(i,j+1) == 3)) then
dhigh = min(dz(i,j), dz(i,j+1))
! === CRITICAL! Almost all line-data will be ignored!!! ========================
! if(ddy(i,j) > -dhigh) then
if(ddy(i,j) < dhigh) then
! ==============================================================================
! === CAL. OF DISCHANGE OF OVERFLOW ===
if(hz(i,j) + ddy(i,j) > hz(i,j+1) + ddy(i,j)) then
zhigh = hz(i,j) + ddy(i,j)
zlow = hz(i,j+1) + ddy(i,j)
else
zhigh = hz(i,j+1) + ddy(i,j)
zlow = hz(i,j) + ddy(i,j)
end if
if(zhigh < GX) then
fy(i,j) = zap
else
if(zhigh*0.66667d0 < zlow) then
discharge = 4.029d0*zlow*sqrt(zhigh - zlow) ! 4.029 = u'*(9.8*2)*0.5, u' = 2.6u
else
discharge = 1.55d0*zhigh**1.5d0 ! 1.55 = u*(9.8*2)*0.5, u = 0.35
end if
if(hz(i,j+1) + ddy(i,j) > hz(i,j) + ddy(i,j)) discharge = -discharge
fy(i,j) = discharge
if(brokeny(i,j) == 0) then
bty(i,j) = broken_rate*(bty(i,j) - dhigh) + dhigh
brokeny(i,j) = 1
end if
end if
end if
end if
end do
end do
end if
#endif
!$omp do private(i, fybar, cf, bcf, fric, ddx_tmp, d, lim)
do j = jst, jnd
do i = ist, ind
Expand Down
10 changes: 8 additions & 2 deletions src/mod_fxy_cartesian.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -456,7 +456,10 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,dt,dxdy,nlon,nlat,gflag,smallh,b
do i = ist, ind
if((ir(i,j) == 1) .or. (ir(i,j) == 3)) then
dhigh = min(dz(i,j), dz(i+1,j))
if(ddx(i,j) > -dhigh) then
! === CRITICAL! Almost all line-data will be ignored!!! ========================
! if(ddx(i,j) > -dhigh) then
if(ddx(i,j) < dhigh) then
! ==============================================================================
! === CAL. OF DISCHANGE OF OVERFLOW ===
if(hz(i,j) + ddx(i,j) > hz(i+1,j) + ddx(i,j)) then
zhigh = hz(i,j) + ddx(i,j)
Expand Down Expand Up @@ -692,7 +695,10 @@ subroutine fxynl_rwg(wfld,dfld,ffld,ifz,cfs,cfl,dt,dxdy,nlon,nlat,gflag,smallh,b
do i = ist, ind
if((ir(i,j+1) == 2) .or. (ir(i,j+1) == 3)) then
dhigh = min(dz(i,j), dz(i,j+1))
if(ddy(i,j) > -dhigh) then
! === CRITICAL! Almost all line-data will be ignored!!! ========================
! if(ddy(i,j) > -dhigh) then
if(ddy(i,j) < dhigh) then
! ==============================================================================
! === CAL. OF DISCHANGE OF OVERFLOW ===
if(hz(i,j) + ddy(i,j) > hz(i,j+1) + ddy(i,j)) then
zhigh = hz(i,j) + ddy(i,j)
Expand Down
Loading

0 comments on commit 05c2d6e

Please sign in to comment.