Complete issue NOAA-EMC#607 (Optimization of multiscale regional runs) (

NOAA-EMC#670)

src/enkf/controlvec.f90

@@ -191,7 +191,7 @@ subroutine read_control()
 ! read ensemble members on IO tasks
 implicit none
 real(r_double)  :: t1,t2
-integer(i_kind) :: nb,nlev,ne
+integer(i_kind) :: nb,ne
 integer(i_kind) :: q_ind
 integer(i_kind) :: ierr
 

src/enkf/letkf.f90

@@ -172,8 +172,8 @@ subroutine letkf_update()
 if (nproc == 0) print *,'using',nthreads,' openmp threads'
 
 ! define a few frequently used parameters
-r_nanals=one/float(nanals)
-r_nanalsm1=one/float(nanals-1)
+r_nanals=one/real(nanals,r_kind)
+r_nanalsm1=one/real(nanals-1,r_kind)
 mincorrlength_factsq = mincorrlength_fact**2
 
 kdobs=associated(kdtree_obs2)
@@ -541,31 +541,34 @@ subroutine letkf_update()
 enddo
 !$omp end parallel do
 
+tmean=zero
+tmin=zero
+tmax=zero
 tend = mpi_wtime()
 call mpi_reduce(tend-tbegin,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(tend-tbegin,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(tend-tbegin,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,'min/max/mean time to do letkf update ',tmin,tmax,tmean
 t2 = t2/nthreads; t3 = t3/nthreads; t4 = t4/nthreads; t5 = t5/nthreads
 if (nproc == 0) print *,'time to process analysis on gridpoint = ',t2,t3,t4,t5,' secs on task',nproc
 call mpi_reduce(t2,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t2,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t2,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t2 = ',tmin,tmax,tmean
 call mpi_reduce(t3,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t3,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t3,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t3 = ',tmin,tmax,tmean
 call mpi_reduce(t4,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t4,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t4,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t4 = ',tmin,tmax,tmean
 call mpi_reduce(t5,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t5,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t5,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t5 = ',tmin,tmax,tmean
@@ -590,7 +593,7 @@ subroutine letkf_update()
    call mpi_reduce(nobslocal_max,nobslocal_maxall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)
    call mpi_reduce(nobslocal_min,nobslocal_minall,1,mpi_integer,mpi_min,0,mpi_comm_world,ierr)
    call mpi_reduce(nobslocal_mean,nobslocal_meanall,1,mpi_integer,mpi_sum,0,mpi_comm_world,ierr)
-   if (nproc == 0) print *,'min/max/mean number of obs in local volume',nobslocal_minall,nobslocal_maxall,nint(nobslocal_meanall/float(numproc))
+   if (nproc == 0) print *,'min/max/mean number of obs in local volume',nobslocal_minall,nobslocal_maxall,nint(nobslocal_meanall/real(numproc,r_kind))
 endif
 call mpi_reduce(nobslocal_max,nobslocal_maxall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)
 call mpi_reduce(nobslocal_min,nobslocal_minall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)

src/gsi/adjtest.f90

@@ -38,7 +38,7 @@ module adjtest
 use gsi_bundlemod, only: assignment(=)
 use bias_predictors, only: predictors,allocate_preds,deallocate_preds, &
     assignment(=)
-use control2state_mod, only: control2state,c2sset,control2state_ad
+use control2state_mod, only: control2state,control2state_ad
 
 implicit none
 private

src/gsi/apply_scaledepwgts.f90

@@ -151,7 +151,6 @@ subroutine apply_scaledepwgts(m,grd_in,sp_in)
   use general_specmod, only: spec_vars
   use general_sub2grid_mod, only: sub2grid_info
   use hybrid_ensemble_parameters, only: spc_multwgt,en_perts,nsclgrp,n_ens
-  use mpimod, only: mype
   implicit none
 
 ! Declare passed variables

src/gsi/balmod.f90

@@ -689,13 +689,7 @@ subroutine balance(t,p,st,vp,fpsproj,fut2ps)
 
 !!   Strong balance constraint
 !!   Pass uvflag=.false.
-    if(lsqrtb) then
-       call strong_bk(st,vp,p,t,.false.)
-     else
-       if(tlnmc_option==1 .or. tlnmc_option==4) call strong_bk(st,vp,p,t,.false.)
-     endif
-
-
+    if(lsqrtb .or. tlnmc_option==1 .or. tlnmc_option==4) call strong_bk(st,vp,p,t,.false.)
 
     return
   end subroutine balance
@@ -777,11 +771,7 @@ subroutine tbalance(t,p,st,vp,fpsproj,fut2ps)
 
 !  Adjoint of strong balance constraint
 !  pass uvflag=.false.
-    if(lsqrtb) then
-       call strong_bk_ad(st,vp,p,t,.false.)
-    else
-       if(tlnmc_option==1 .or. tlnmc_option==4) call strong_bk_ad(st,vp,p,t,.false.)
-    endif
+    if(lsqrtb .or. tlnmc_option==1 .or. tlnmc_option==4) call strong_bk_ad(st,vp,p,t,.false.)
 
 !   REGIONAL BRANCH
     if (regional) then

src/gsi/berror.f90

@@ -844,8 +844,7 @@ subroutine create_berror_vars_reg
 
 !   Grid constant for background error
 
-    allocate(be(ndeg), &
-         qvar3d(lat2,lon2,nsig))
+    allocate(be(ndeg),qvar3d(lat2,lon2,nsig))
     if(nc3d>0)then
        allocate(alv(llmin:llmax,ndeg,nsig,nc3d), &
             dssv(lat2,lon2,nsig,nc3d))

src/gsi/calctends.f90

@@ -62,6 +62,7 @@ subroutine calctends(mype,teta,pri,guess,xderivative,yderivative,tendency)
   use gsi_bundlemod, only: gsi_bundlegetpointer
 
   use mpeu_util, only: die
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -357,7 +358,7 @@ subroutine calctends(mype,teta,pri,guess,xderivative,yderivative,tendency)
       end do
     end do  !end do k
 
-    call turbl(u,v,pri,t,teta,z,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
+    if(use_pbl)call turbl(u,v,pri,t,teta,z,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then
       do k=1,nsig

src/gsi/calctends_ad.f90

@@ -67,6 +67,7 @@ subroutine calctends_ad(fields,fields_dt,mype)
   use mpeu_util, only: die
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -356,7 +357,7 @@ subroutine calctends_ad(fields,fields_dt,mype)
       end do                         
     end if
 
-    call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                 u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     do k=nsig,1,-1               

src/gsi/calctends_no_ad.f90

@@ -72,6 +72,7 @@ subroutine calctends_no_ad(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
   use gsi_bundlemod, only: gsi_bundlegetpointer
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -210,7 +211,7 @@ subroutine calctends_no_ad(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
       end do                         
     end if
 
-    call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                 u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     do k=nsig,1,-1               

src/gsi/calctends_no_tl.f90

@@ -37,7 +37,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
 !     v        - meridional wind on subdomain
 !     t        - virtual temperature on subdomain
 !     mype     - task id
-!     uvflag   - logical, set to true for st,vp wind components, instead of stream/potential function
+!     uvflag   - logical, set to true for u,v wind components, instead of stream/potential function
 !
 !   output argument list:
 !     u_t      - time tendency of u
@@ -64,6 +64,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
   use gsi_bundlemod, only: gsi_bundlegetpointer
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -364,7 +365,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
       end do   !end do j
     end do  !end do k
 
-    call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then

src/gsi/calctends_tl.f90

@@ -69,6 +69,7 @@ subroutine calctends_tl(fields,fields_dt,mype)
   use mpeu_util, only: die, getindex
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -474,7 +475,7 @@ subroutine calctends_tl(fields,fields_dt,mype)
       end do   !end do j
     end do  !end do k
 
-    call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then