Replace mersenne twister in CALWXT_BOURG.f with standard Fortran RNG (N…

…OAA-EMC#244) * Replace mersenne twister in CALWXT_BOURG.f with standard Fortran RNG * Update TIMEF.f * Update VERSION to 10.0.1
lgannoaa · Dec 22, 2020 · 194d4a1 · 194d4a1
1 parent 2c43340
commit 194d4a1
Show file tree

Hide file tree

Showing 6 changed files with 14 additions and 14 deletions.
diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -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)

diff --git a/VERSION b/VERSION
@@ -1 +1 @@
-10.0.0
+10.0.1
diff --git a/cmake/PackageConfig.cmake.in b/cmake/PackageConfig.cmake.in
@@ -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.

diff --git a/sorc/ncep_post.fd/CALWXT_BOURG.f b/sorc/ncep_post.fd/CALWXT_BOURG.f
@@ -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:
@@ -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
@@ -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,  &
@@ -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
@@ -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

diff --git a/sorc/ncep_post.fd/CMakeLists.txt b/sorc/ncep_post.fd/CMakeLists.txt
@@ -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)

diff --git a/sorc/ncep_post.fd/TIMEF.f b/sorc/ncep_post.fd/TIMEF.f
@@ -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