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.

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

Replace mersenne twister in CALWXT_BOURG.f with standard Fortran RNG #244

Merged
merged 4 commits into from
Dec 22, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 0 additions & 1 deletion CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,6 @@ find_package(g2tmpl REQUIRED)
find_package(bacio REQUIRED)
find_package(ip REQUIRED)
find_package(sp REQUIRED)
find_package(w3emc REQUIRED)
find_package(crtm REQUIRED)

if(BUILD_POSTEXEC)
Expand Down
2 changes: 1 addition & 1 deletion VERSION
Original file line number Diff line number Diff line change
@@ -1 +1 @@
10.0.0
10.0.1
1 change: 0 additions & 1 deletion cmake/PackageConfig.cmake.in
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ find_dependency(g2tmpl CONFIG)
find_dependency(bacio CONFIG)
find_dependency(ip CONFIG)
find_dependency(sp CONFIG)
find_dependency(w3emc CONFIG)
find_dependency(crtm CONFIG)

# nceppost library does not depend on these, the executable does.
Expand Down
19 changes: 11 additions & 8 deletions sorc/ncep_post.fd/CALWXT_BOURG.f
Original file line number Diff line number Diff line change
Expand Up @@ -63,12 +63,10 @@
!! and layer lmh = bottom
!!
!!

subroutine calwxt_bourg_post(im,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1, &
& iseed,g,pthresh, &
& t,q,pmid,pint,lmh,prec,zint,ptype,me)
! use mersenne_twister, only: random_number
use mersenne_twister
implicit none
!
! input:
Expand All @@ -85,13 +83,15 @@ subroutine calwxt_bourg_post(im,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1, &
integer i,j,ifrzl,iwrml,l,lhiwrm,lmhk,jlen
real pintk1,areane,tlmhk,areape,pintk2,surfw,area1,dzkl,psfck,r1,r2
real rn(im*jm*2)
integer :: rn_seed_size
integer, allocatable, dimension(:) :: rn_seed
!
! initialize weather type array to zero (ie, off).
! we do this since we want ptype to represent the
! instantaneous weather type on return.
print *,'in calwxtbg, jsta,jend=',jsta,jend,' im=',im
print *,'in calwxtbg,me=',me,'iseed=',iseed
!
!
!$omp parallel do
do j=jsta,jend
do i=1,im
Expand All @@ -100,9 +100,12 @@ subroutine calwxt_bourg_post(im,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1, &
enddo
!
jlen = jend - jsta + 1
call random_setseed(iseed)

call random_seed(size = rn_seed_size)
allocate(rn_seed(rn_seed_size))
rn_seed = iseed
call random_seed(put = rn_seed)
call random_number(rn)
! call random_number(rn,iseed)
!
!!$omp parallel do &
! & private(a,lmhk,tlmhk,iwrml,psfck,lhiwrm,pintk1,pintk2,area1, &
Expand All @@ -115,7 +118,7 @@ subroutine calwxt_bourg_post(im,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1, &
lmhk = min(nint(lmh(i,j)),lm)
psfck = pint(i,j,lmhk+1)
!
if (prec(i,j) <= pthresh) cycle ! skip this point if no precip this time step
if (prec(i,j) <= pthresh) cycle ! skip this point if no precip this time step

! find the depth of the warm layer based at the surface
! this will be the cut off point between computing
Expand Down Expand Up @@ -156,7 +159,7 @@ subroutine calwxt_bourg_post(im,jm,jsta_2l,jend_2u,jsta,jend,lm,lp1, &
ifrzl = 0
areane = 0.0
areape = 0.0
surfw = 0.0
surfw = 0.0

do l = lmhk, 1, -1
if (ifrzl == 0.and.t(i,j,l) <= 273.15) ifrzl = 1
Expand Down
1 change: 0 additions & 1 deletion sorc/ncep_post.fd/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -215,7 +215,6 @@ target_link_libraries(${LIBNAME} PUBLIC

target_link_libraries(${LIBNAME} PRIVATE
sp::sp_4
w3emc::w3emc_4
w3nco::w3nco_4)

if(OpenMP_Fortran_FOUND)
Expand Down
4 changes: 2 additions & 2 deletions sorc/ncep_post.fd/TIMEF.f
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,15 @@
function timef()
implicit none
real et(2)
real*8 timef
real*8 timef, etime
timef=etime(et)
timef=timef*1.e3
end

function rtc()
implicit none
real et(2)
real*8 rtc
real*8 rtc, etime
rtc=etime(et)
rtc=rtc*1.e3
end