Merge remote-tracking branch 'origin/develop' into feature/ss_160

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