diff --git a/src/enkf/controlvec.f90 b/src/enkf/controlvec.f90 index 40dff4dbad..808eae2e28 100644 --- a/src/enkf/controlvec.f90 +++ b/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 diff --git a/src/enkf/letkf.f90 b/src/enkf/letkf.f90 index 9b74cecd75..510b0429d9 100644 --- a/src/enkf/letkf.f90 +++ b/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) @@ -276,24 +276,24 @@ subroutine letkf_update() ! Update ensemble on model grid. ! Loop for each horizontal grid points on this task. -!$omp parallel do schedule(dynamic) default(none) private(npt,nob,nobsl, & -!$omp nobsl2,ngrd1,corrlength,ens_tmp,coslat, & -!$omp nf,vdist,obens,indxassim,indxob,maxdfs, & -!$omp nn,hxens,wts_ensmean,dfs,rdiag,dep,rloc,i, & -!$omp oindex,deglat,dist,corrsq,nb,nlev,nanal,sresults, & -!$omp wts_ensperts,pa,trpa,trpa_raw) shared(anal_ob, & -!$omp anal_ob_modens,anal_chunk,obsprd_post,obsprd_prior, & -!$omp oberrvar,oberrvaruse,nobsl_max,grdloc_chunk, & -!$omp obloc,corrlengthnh,corrlengthsh,corrlengthtr,& -!$omp vlocal_evecs,vlocal,oblnp,lnp_chunk,lnsigl,corrlengthsq,& -!$omp getkf,denkf,getkf_inflation,ensmean_chunk,ob,ensmean_ob, & -!$omp nproc,numptsperproc,nnmax,r_nanalsm1,kdtree_obs2,kdobs, & -!$omp mincorrlength_factsq,robs_local,coslats_local, & -!$omp lupd_obspace_serial,eps,dfs_sort,nanals,index_pres,& -!$omp neigv,nlevs,lonsgrd,latsgrd,nobstot,nens,ncdim,nbackgrounds,indxproc,rad2deg) & -!$omp reduction(+:t1,t2,t3,t4,t5) & -!$omp reduction(max:nobslocal_max) & -!$omp reduction(min:nobslocal_min) +! !$omp parallel do schedule(dynamic) default(none) private(npt,nob,nobsl, & +! !$omp nobsl2,ngrd1,corrlength,ens_tmp,coslat, & +! !$omp nf,vdist,obens,indxassim,indxob,maxdfs, & +! !$omp nn,hxens,wts_ensmean,dfs,rdiag,dep,rloc,i, & +! !$omp oindex,deglat,dist,corrsq,nb,nlev,nanal,sresults, & +! !$omp wts_ensperts,pa,trpa,trpa_raw) shared(anal_ob, & +! !$omp anal_ob_modens,anal_chunk,obsprd_post,obsprd_prior, & +! !$omp oberrvar,oberrvaruse,nobsl_max,grdloc_chunk, & +! !$omp obloc,corrlengthnh,corrlengthsh,corrlengthtr,& +! !$omp vlocal_evecs,vlocal,oblnp,lnp_chunk,lnsigl,corrlengthsq,& +! !$omp getkf,denkf,getkf_inflation,ensmean_chunk,ob,ensmean_ob, & +! !$omp nproc,numptsperproc,nnmax,r_nanalsm1,kdtree_obs2,kdobs, & +! !$omp mincorrlength_factsq,robs_local,coslats_local, & +! !$omp lupd_obspace_serial,eps,dfs_sort,nanals,index_pres,& +! !$omp neigv,nlevs,lonsgrd,latsgrd,nobstot,nens,ncdim,nbackgrounds,indxproc,rad2deg) & +! !$omp reduction(+:t1,t2,t3,t4,t5) & +! !$omp reduction(max:nobslocal_max) & +! !$omp reduction(min:nobslocal_min) grdloop: do npt=1,numptsperproc(nproc+1) t1 = mpi_wtime() @@ -524,7 +524,7 @@ subroutine letkf_update() if (allocated(sresults)) deallocate(sresults) if (allocated(ens_tmp)) deallocate(ens_tmp) end do grdloop -!$omp end parallel do +! !$omp end parallel do ! make sure posterior perturbations still have zero mean. ! (roundoff errors can accumulate) @@ -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) diff --git a/src/gsi/apply_scaledepwgts.f90 b/src/gsi/apply_scaledepwgts.f90 index e4952b28fa..585711c90b 100644 --- a/src/gsi/apply_scaledepwgts.f90 +++ b/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 diff --git a/src/gsi/convthin_time.f90 b/src/gsi/convthin_time.f90 index ac219baf1d..ae2a7bb6c3 100644 --- a/src/gsi/convthin_time.f90 +++ b/src/gsi/convthin_time.f90 @@ -78,7 +78,7 @@ subroutine make3grids_tm(rmesh,nlevpp,ntmm) real(r_kind),parameter:: r360 = 360.0_r_kind - integer(i_kind) i,j,it + integer(i_kind) i,j integer(i_kind) mlonx,mlonj real(r_kind) delonx,delat,dgv,halfpi,dx,dy diff --git a/src/gsi/deter_sfc_mod.f90 b/src/gsi/deter_sfc_mod.f90 index 0e64c9a357..087666fc26 100644 --- a/src/gsi/deter_sfc_mod.f90 +++ b/src/gsi/deter_sfc_mod.f90 @@ -600,7 +600,7 @@ subroutine deter_sfc2(dlat_earth,dlon_earth,obstime,idomsfc,tsavg,ff10,sfcr,zz) ! Get time interpolation factors for surface files - if(obstime > hrdifsfc(1) .and. obstime <= hrdifsfc(nfldsfc))then + if(obstime > hrdifsfc(1) .and. obstime < hrdifsfc(nfldsfc))then do j=1,nfldsfc-1 if(obstime > hrdifsfc(j) .and. obstime <= hrdifsfc(j+1))then itsfc=j diff --git a/src/gsi/get_gefs_ensperts_dualres.f90 b/src/gsi/get_gefs_ensperts_dualres.f90 index ca551efa21..ca5db84a1a 100644 --- a/src/gsi/get_gefs_ensperts_dualres.f90 +++ b/src/gsi/get_gefs_ensperts_dualres.f90 @@ -49,10 +49,9 @@ subroutine get_gefs_ensperts_dualres !$$$ end documentation block use mpeu_util, only: die - use gridmod, only: idsl5 use hybrid_ensemble_parameters, only: n_ens,write_ens_sprd,oz_univ_static,ntlevs_ens use hybrid_ensemble_parameters, only: en_perts,ps_bar,nelen - use constants,only: zero,zero_single,half,fv,rd_over_cp,one,qcmin + use constants,only: zero,zero_single,half,fv,one,qcmin use mpimod, only: mpi_comm_world,mype,npe use kinds, only: r_kind,i_kind,r_single use hybrid_ensemble_parameters, only: grd_ens,q_hyb_ens,limqens diff --git a/src/gsi/gsdcloudanalysis.F90 b/src/gsi/gsdcloudanalysis.F90 index 21fc21b8a2..9369db32ad 100644 --- a/src/gsi/gsdcloudanalysis.F90 +++ b/src/gsi/gsdcloudanalysis.F90 @@ -64,8 +64,8 @@ subroutine gsdcloudanalysis(mype) !_____________________________________________________________________ ! ! - use constants, only: zero,one,rad2deg,fv - use constants, only: rd_over_cp, h1000 + use constants, only: zero,one + use constants, only: h1000 use kinds, only: r_single,i_kind, r_kind use gridmod, only: pt_ll,eta1_ll,aeta1_ll,eta2_ll,aeta2_ll use gridmod, only: regional,wrf_mass_regional,regional_time diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index d2e1c8261b..db4fe6d0b6 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -545,7 +545,6 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) use netcdf, only: nf90_inquire_variable use mpimod, only: mype use mod_fv3_lola, only: definecoef_regular_grids - use gridmod, only:nsig,regional_time,regional_fhr,regional_fmin,aeta1_ll,aeta2_ll use gridmod, only:nlon_regionalens,nlat_regionalens use gridmod, only:grid_type_fv3_regional use kinds, only: i_kind,r_kind @@ -556,7 +555,7 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr) integer(i_kind), intent( out) :: ierr integer(i_kind) gfile_grid_spec - integer(i_kind) i,k,ndimensions,iret,nvariables,nattributes,unlimiteddimid + integer(i_kind) k,ndimensions,iret,nvariables,nattributes,unlimiteddimid integer(i_kind) gfile_loc,len character(len=128) :: name integer(i_kind) :: nio,nylen @@ -2451,7 +2450,7 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin,ens integer(i_kind) nz,nzp1,mm1,nx_phy integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror - integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + integer(i_kind),dimension(npe):: members,members_read,mype_read_rank logical:: procuse ! for io_layout > 1 @@ -2788,7 +2787,7 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin,ensgrid) integer(i_kind) nz,nzp1,mm1 integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror - integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + integer(i_kind),dimension(npe):: members,members_read,mype_read_rank logical:: procuse ! for fv3_io_layout_y > 1 @@ -3965,7 +3964,7 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) real(r_kind),allocatable,dimension(:,:):: workbu2,workbv2 integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,ierror - integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + integer(i_kind),dimension(npe):: members,members_read,mype_read_rank logical:: procuse ! for fv3_io_layout_y > 1 @@ -4543,7 +4542,7 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file real(r_kind),allocatable,dimension(:,:):: work_b_tmp integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror - integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank + integer(i_kind),dimension(npe):: members,members_read,mype_read_rank logical:: procuse ! for io_layout > 1 diff --git a/src/gsi/hdraobmod.f90 b/src/gsi/hdraobmod.f90 index 12451c58be..3444c96fcc 100644 --- a/src/gsi/hdraobmod.f90 +++ b/src/gsi/hdraobmod.f90 @@ -1272,7 +1272,7 @@ subroutine read_hdraob(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Write header record and data to output file for further processing - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/m_extOzone.F90 b/src/gsi/m_extOzone.F90 index bf2b137466..5dead0551a 100644 --- a/src/gsi/m_extOzone.F90 +++ b/src/gsi/m_extOzone.F90 @@ -1481,7 +1481,7 @@ subroutine ozlay_ncread_(dfile,dtype,ozout,nmrecs,ndata,nodata, gstime,twind) use gridmod, only: nlat,nlon,regional,tll2xy,rlats,rlons use gsi_4dvar, only: l4dvar,iwinbgn,winlen,l4densvar - use constants, only: deg2rad,zero,rad2deg,one_tenth,r60inv + use constants, only: deg2rad,zero,one_tenth,r60inv use ozinfo, only: jpch_oz,nusis_oz,iuse_oz use mpeu_util, only: perr,die ! use mpeu_util, only: mprefix,stdout diff --git a/src/gsi/mod_fv3_lola.f90 b/src/gsi/mod_fv3_lola.f90 index 4ec3c0cb93..accb05c150 100644 --- a/src/gsi/mod_fv3_lola.f90 +++ b/src/gsi/mod_fv3_lola.f90 @@ -631,8 +631,7 @@ subroutine definecoef_regular_grids(nxen,nyen,grid_lon,grid_lont,grid_lat,grid_l real(r_kind),allocatable,dimension(:)::xbh_a,xa_a,xa_b real(r_kind),allocatable,dimension(:)::ybh_a,ya_a,ya_b,yy real(r_kind),allocatable,dimension(:,:)::xbh_b,ybh_b - real(r_kind) dlat,dlon,dyy,dxx,dyyi,dxxi - real(r_kind) dyyh,dxxh + real(r_kind) dlat,dlon real(r_kind),allocatable:: region_lat_tmp(:,:),region_lon_tmp(:,:) integer(i_kind), intent(in ) :: nxen,nyen ! fv3 tile x- and y-dimensions @@ -642,18 +641,15 @@ subroutine definecoef_regular_grids(nxen,nyen,grid_lon,grid_lont,grid_lat,grid_l real(r_kind) , intent(inout) :: grid_latt(nxen,nyen) ! fv3 cell center latitudes integer(i_kind) i,j,ir,jr,n real(r_kind),allocatable,dimension(:,:) :: xc,yc,zc,gclat,gclon,gcrlat,gcrlon,rlon_in,rlat_in - real(r_kind),allocatable,dimension(:,:) :: glon_an,glat_an real(r_kind) xcent,ycent,zcent,rnorm,centlat,centlon - integer(i_kind) nlonh,nlath,nxh,nyh + integer(i_kind) nxh,nyh integer(i_kind) ib1,ib2,jb1,jb2,jj integer (i_kind):: index0 - real(r_kind) region_lat_in(nlat_ens,nlon_ens),region_lon_in(nlat_ens,nlon_ens) integer(i_kind) nord_e2a real(r_kind)gxa,gya real(r_kind) x(nxen+1,nyen+1),y(nxen+1,nyen+1),z(nxen+1,nyen+1),xr,yr,zr,xu,yu,zu,rlat,rlon real(r_kind) xv,yv,zv,vval - real(r_kind) cx,cy real(r_kind) uval,ewval,nsval real(r_kind) d(4),ds @@ -984,11 +980,11 @@ subroutine definecoef_regular_grids(nxen,nyen,grid_lon,grid_lont,grid_lat,grid_l do i=1,nxen+1 rlat=half*(grid_lat(i,j)+grid_lat(i,j+1)) ! rlon=half*(grid_lon(i,j)+grid_lon(i,j+1)) - diff=(grid_lon(i,j)-grid_lon(i+1,j))**2 + diff=(grid_lon(i,j)-grid_lon(i,j+1))**2 if(diff < sq180)then - rlon=half*(grid_lon(i,j)+grid_lon(i+1,j)) + rlon=half*(grid_lon(i,j)+grid_lon(i,j+1)) else - rlon=half*(grid_lon(i,j)+grid_lon(i+1,j)-360._r_kind) + rlon=half*(grid_lon(i,j)+grid_lon(i,j+1)-360._r_kind) endif xr=cos(rlat*deg2rad)*cos(rlon*deg2rad) yr=cos(rlat*deg2rad)*sin(rlon*deg2rad) @@ -1258,7 +1254,6 @@ subroutine fv3_h_to_ll_ens(b_in,a,nb,mb,na,ma,rev_flg) ! machine: ! !$$$ end documentation block - use mpimod, only: mype use constants, only: zero,one implicit none diff --git a/src/gsi/obs_para.f90 b/src/gsi/obs_para.f90 index 5150e93c78..869efa5e78 100644 --- a/src/gsi/obs_para.f90 +++ b/src/gsi/obs_para.f90 @@ -341,7 +341,8 @@ subroutine count_obs(ndata,nn_obs,lat_data,lon_data,obs_data,nobs_s) integer(i_kind) ,intent(in ) :: ndata,lat_data,lon_data integer(i_kind) ,intent(in ) :: nn_obs integer(i_kind),dimension(npe),intent(inout) :: nobs_s - real(r_kind),dimension(nn_obs,ndata),intent(in) :: obs_data + real(r_kind),dimension(nn_obs,*),intent(in) :: obs_data +! real(r_kind),dimension(nn_obs,ndata),intent(in) :: obs_data ! Declare local variables integer(i_kind) lon,lat,n,k diff --git a/src/gsi/read_dbz_nc.f90 b/src/gsi/read_dbz_nc.f90 index 8861023a06..f06545afa1 100644 --- a/src/gsi/read_dbz_nc.f90 +++ b/src/gsi/read_dbz_nc.f90 @@ -141,8 +141,7 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no logical :: luse !--General declarations - integer(i_kind) :: ierror,i,j,k,nvol, & - ikx,mins_an + integer(i_kind) :: ierror,i,j,k,ikx,mins_an integer(i_kind) :: maxobs,nchanl,ilat,ilon,scount real(r_kind) :: thistiltr,thisrange,this_stahgt,thishgt @@ -155,8 +154,8 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no real(r_double) rstation_id logical, allocatable,dimension(:) :: rusage,rthin logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot character(8) cstaid character(4) this_staid diff --git a/src/gsi/read_fed.f90 b/src/gsi/read_fed.f90 index 3d3d098b08..9ba799e341 100644 --- a/src/gsi/read_fed.f90 +++ b/src/gsi/read_fed.f90 @@ -36,7 +36,7 @@ subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs) ! use kinds, only: r_kind,r_double,i_kind use constants, only: zero,one,deg2rad,r60inv - use convinfo, only: nconvtype,ctwind,icuse,ioctype + use convinfo, only: nconvtype,icuse,ioctype use gsi_4dvar, only: iwinbgn use gridmod, only: tll2xy use mod_wrfmass_to_a, only: wrfmass_obs_to_a8 @@ -83,15 +83,14 @@ subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs) integer(i_kind) :: kint_maxloc real(r_kind) :: fed_max integer(i_kind) :: ndata2 - integer(i_kind) :: ppp character(8) station_id real(r_double) :: rstation_id equivalence(rstation_id,station_id) integer(i_kind) :: maxlvl - integer(i_kind) :: numlvl,numfed,nmsgmax,maxobs - integer(i_kind) :: k,iret + integer(i_kind) :: numfed,maxobs + integer(i_kind) :: k real(r_kind),allocatable,dimension(:,:) :: fed3d_column ! 3D fed in column real(r_kind),allocatable,dimension(:) :: fed3d_hgt ! fed height diff --git a/src/gsi/read_fl_hdob.f90 b/src/gsi/read_fl_hdob.f90 index 31da56c2dc..1ef3d8617f 100644 --- a/src/gsi/read_fl_hdob.f90 +++ b/src/gsi/read_fl_hdob.f90 @@ -138,8 +138,8 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si logical, allocatable,dimension(:) :: rusage,rthin logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) pmot,iqm,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) pmot,iqm integer(i_kind) nxdata ! Real variables @@ -174,7 +174,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si real(r_kind) :: es,qsat,rhob_calc,tdob_calc,tdry real(r_kind) :: dummy real(r_kind) :: del,ediff,errmin,jbmin - real(r_kind) :: tvflg + real(r_kind) :: tvflg,log100 real(r_kind) :: presl(nsig) real(r_kind) :: obstime(6,1) @@ -237,6 +237,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si ierr_uv = 0 var_jb=zero jbmin=zero + log100=log(100._r_kind) lim_qm = 4 @@ -611,6 +612,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si obserr = max(obserr,errmin) endif ! Read extrapolated surface pressure [pa] and convert to [cb] + dlnpsob = log100 ! default (1000mb) if (lpsob) then call ufbint(lunin,obspsf,1,1,nlv,psfstr) if (obspsf(1,1) >= missing .or. & @@ -1221,7 +1223,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si ! Write header record and data to output file for further processing ! deallocate(etabl) - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) deallocate(cdata_all,rusage,rthin) diff --git a/src/gsi/read_goesglm.f90 b/src/gsi/read_goesglm.f90 index 068f2fd50f..8746fa27dd 100644 --- a/src/gsi/read_goesglm.f90 +++ b/src/gsi/read_goesglm.f90 @@ -76,9 +76,8 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis) character(8) subset character(1) sidchr(8) - integer(i_kind) ireadmg,ireadsb,icntpnt,icount + integer(i_kind) ireadmg,ireadsb,icntpnt integer(i_kind) lunin,i - integer(i_kind) itx integer(i_kind) ihh,idd,idate,iret,im,iy,k integer(i_kind) nchanl,nreal,ilat,ilon integer(i_kind) lqm diff --git a/src/gsi/read_goesimgr_skycover.f90 b/src/gsi/read_goesimgr_skycover.f90 index 4688b5df1b..97eeb5e695 100644 --- a/src/gsi/read_goesimgr_skycover.f90 +++ b/src/gsi/read_goesimgr_skycover.f90 @@ -50,9 +50,9 @@ subroutine read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti use constants, only: zero,one_tenth,one,deg2rad,half,& three,four, r60inv,r10,r100,r2000 - use convinfo, only: nconvtype, & - icuse,ictype,ioctype,icsubtype,& + use convinfo, only: nconvtype,icuse,ictype,ioctype,& ithin_conv,rmesh_conv,pmesh_conv,ctwind,pmot_conv +! use convinfo, only: icsubtype use convthin, only: make3grids,map3grids_m,del3grids,use_all use gridmod, only: regional,nlon,nlat,nsig,tll2xy,txy2ll,& rlats,rlons @@ -95,7 +95,7 @@ subroutine read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti integer(i_kind) :: iret,kx,pflag,nlevp,nmind,levs,idomsfc integer(i_kind) :: low_cldamt_qc,mid_cldamt_qc,hig_cldamt_qc,tcamt_qc integer(i_kind) :: ithin,klat1,klon1,klonp1,klatp1,kk,k,ilat,ilon,nchanl - integer(i_kind) :: iout,maxobs,itx,iuse,idate,ierr + integer(i_kind) :: iout,maxobs,iuse,idate,ierr integer(i_kind),dimension(5) :: idate5 real(r_kind) :: dlat,dlon,dlat_earth,dlon_earth,toff,t4dv real(r_kind) :: dlat_earth_deg,dlon_earth_deg @@ -110,8 +110,8 @@ subroutine read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti real(r_double),dimension(3):: goescld logical,allocatable,dimension(:)::rthin,rusage logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot logical :: outside,ithinp,luse @@ -412,7 +412,7 @@ subroutine read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti do i=1,nxdata if(rthin(i))then cdata_all(9,i)=100._r_kind - cdata_all(7,i)=14 + cdata_all(8,i)=14 end if end do end if @@ -441,7 +441,7 @@ subroutine read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti ! Write header record and data to output file for further processing - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/read_prepbufr.f90 b/src/gsi/read_prepbufr.f90 index 8a8dc625ef..8dd91fc298 100644 --- a/src/gsi/read_prepbufr.f90 +++ b/src/gsi/read_prepbufr.f90 @@ -223,7 +223,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& use aircraftobsqc, only: init_aircraft_rjlists,get_aircraft_usagerj,& destroy_aircraft_rjlists use adjust_cloudobs_mod, only: adjust_convcldobs,adjust_goescldobs - use mpimod, only: npe,mype + use mpimod, only: npe use rapidrefresh_cldsurf_mod, only: i_gsdsfc_uselist,i_gsdqc,i_ens_mean use gsi_io, only: verbose use phil2, only: denest ! hilbert curve @@ -381,8 +381,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& integer(i_kind) ndata_hil,nor,ncc,nnrand integer(i_kind) indexx real(r_kind) dentrip,dentrip_tmp,vmin,vmax,rmesh_tmp,pmesh_tmp,prest - integer(i_kind) ntime_max,ntime_tmp,itype,ikx,numall -! integer(i_kind) numthin,numqc,numrem + integer(i_kind) ntime_max,ntime_tmp,itype,ikx +! integer(i_kind) numthin,numqc,numrem,numall integer(i_kind),dimension(24) :: ntype_arr integer(i_kind),allocatable,dimension(:,:) :: index_arr real(r_kind),allocatable,dimension(:,:,:) :: data_hilb @@ -503,7 +503,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& else if(qob) then nreal=26 iqm = 11 - iuse = 12 + iuse = 13 else if(pwob) then nreal=20 iqm = 9 @@ -551,7 +551,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& else if(goesctpobs) then nreal=8 iqm = 0 - iuse = 22 + iuse = 8 else if(tcamtob) then nreal=20 iqm = 8 @@ -961,7 +961,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& enddo endif endif - if(print_verbose) write(6,*)'READ_PREPBUFR: at line 779: obstype,ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime=',& + if(print_verbose) write(6,*)'READ_PREPBUFR: obstype,ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime=',& trim(ioctype(nc)),ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime,ithin,ndata,nc endif endif @@ -3060,7 +3060,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Apply hilbert curve for cross validation if requested if(lhilbert) & - call apply_hilbertcurve(maxobs,obstype,cdata_all(thisobtype_usage,1:ndata)) + call apply_hilbertcurve(ndata,obstype,cdata_all(thisobtype_usage,1:ndata)) ! the following is gettin the types which will be applied hilbert curve to ! estimate the density diff --git a/src/gsi/read_radar.f90 b/src/gsi/read_radar.f90 index cdb87537f9..95c9994d9e 100644 --- a/src/gsi/read_radar.f90 +++ b/src/gsi/read_radar.f90 @@ -355,6 +355,8 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu dlonmax=-huge(dlonmax) dlatmin=huge(dlatmin) dlonmin=huge(dlonmin) + toff=zero !uncertainty +! uncertainty means that there is an issue with defining the variable. if(ianldate > 2016092000)then hdrstr(2)='PTID YEAR MNTH DAYS HOUR MINU SECO CLAT CLON FLVLST ANAZ ANEL' @@ -1985,7 +1987,6 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr) - write(6,*) ' radar3 ',height cdata(1) = error ! wind obs error (m/s) cdata(2) = dlon ! grid relative longitude cdata(3) = dlat ! grid relative latitude @@ -2482,12 +2483,11 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu if(usage >= 100._r_kind) rusage(ndata)=.false. call deter_zsfc_model(dlat,dlon,zsges) - + ! Get information from surface file necessary for conventional data here call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr) - write(6,*) ' radar4 ',height cdata(1) = error ! wind obs error (m/s) cdata(2) = dlon ! grid relative longitude cdata(3) = dlat ! grid relative latitude @@ -3002,7 +3002,6 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx) end if if(usage >= 100._r_kind) rusage(ndata)=.false. - call deter_zsfc_model(dlat,dlon,zsges) ! Get information from surface file necessary for conventional data here @@ -3281,7 +3280,7 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs) use gridmod, only: regional,nlat,nlon,tll2xy,rlats,rlons,rotate_wind_ll2xy,& fv3_regional use convinfo, only: nconvtype,ncmiter,ncgroup,ncnumgrp,icuse,ioctype,pmot_conv - use deter_sfc_mod, only: deter_sfc2 + use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model use mpimod, only: npe use obsmod, only: reduce_diag @@ -3426,6 +3425,7 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs) notgood0=0 nsuper2_in=0 nsuper2_kept=0 + toff=zero !uncertainty if(loop==0) outmessage='level 2 superobs:' @@ -3479,6 +3479,7 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs) timeo=thistime if(abs(timeo)>half ) cycle endif + t4dv = thistime ! uncertainty ! Get observation (lon,lat). Compute distance from radar. dlat_earth=thislat @@ -3587,6 +3588,7 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs) end if if(usage >= 100._r_kind)rusage(ndata)=.true. + call deter_zsfc_model(dlat,dlon,zsges) call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr) cdata(1) = error ! wind obs error (m/s) @@ -3700,11 +3702,11 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) use obsmod, only: doradaroneob,oneobradid,time_offset,reduce_diag use mpeu_util, only: gettablesize,gettable use convinfo, only: nconvtype,icuse,ioctype - use deter_sfc_mod, only: deter_sfc2 use mpimod, only: npe use read_l2bufr_mod, only: radar_sites,radar_rmesh,radar_zmesh,elev_angle_max,del_time,range_max,radar_pmot use constants, only: eccentricity,somigliana,grav_ratio,grav,semi_major_axis,flattening,grav_equator use obsmod,only: radar_no_thinning,iadate + use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model use convthin, only: make3grids,map3grids_m implicit none @@ -3807,8 +3809,6 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) ! integer(i_kind) numthin,numqc,numrem integer(i_kind) nxdata,pmot,numall - - ! following variables are for fore/aft separation integer(i_kind) irec @@ -3854,7 +3854,8 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) nmrecs=0 irec=0 errzmax=zero - + toff=zero !uncertainty + timemax=-huge(timemax) timemin=huge(timemin) errmax=-huge(errmax) @@ -4237,8 +4238,9 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) usage=r100 end if + call deter_zsfc_model(dlat,dlon,zsges) + nsuper2_kept=nsuper2_kept+1 - write(6,*) ' radar7 ',height cdata(1) = error ! wind obs error (m/s) cdata(2) = dlon ! grid relative longitude cdata(3) = dlat ! grid relative latitude @@ -4287,7 +4289,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full) ! end if ! end do ! write(6,*) ' radar2 ',numall,numrem,numqc,numthin -! If thinned data set quality mark to 16 +! If thinned data set quality mark to 14 if (ithin == 1 ) then do i=1,nxdata if(rthin(i))cdata_all(12,i)=101._r_kind diff --git a/src/gsi/read_radar_wind_ascii.f90 b/src/gsi/read_radar_wind_ascii.f90 index 3ea62abd4d..b79904273e 100644 --- a/src/gsi/read_radar_wind_ascii.f90 +++ b/src/gsi/read_radar_wind_ascii.f90 @@ -207,8 +207,8 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg real(r_double) rstation_id logical, allocatable,dimension(:) :: rusage,rthin logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot character(8) cstaid character(4) this_staid @@ -644,7 +644,7 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg ! end do ! write(6,*) ' asciiradar ',trim(ioctype(ikx)),ikx,numall,& ! numrem,numqc,numthin -! If thinned data set quality mark to 16 +! If thinned data set quality mark to 14 if (ithin == 1 ) then do i=1,nxdata if(rthin(i))cdata_all(12,i)=101._r_kind @@ -694,12 +694,13 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg !---------------DEALLOCATE ARRAYS-------------! - deallocate(cdata_all,rusage,rthin) else !fileopen write(6,*) 'READ_RADAR_WIND_ASCII: ERROR OPENING RADIAL VELOCITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...' end if fileopen + deallocate(cdata_all,rusage,rthin) + end subroutine read_radar_wind_ascii diff --git a/src/gsi/read_rapidscat.f90 b/src/gsi/read_rapidscat.f90 index 1ff840c3b1..f1fffd43a8 100644 --- a/src/gsi/read_rapidscat.f90 +++ b/src/gsi/read_rapidscat.f90 @@ -43,7 +43,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind, use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,& tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,& rlats,rlons,fv3_regional - use qcmod, only: errormod,noiqc + use qcmod, only: errormod use convthin, only: make3grids,map3grids_m,del3grids,use_all use constants, only: deg2rad,zero,rad2deg,one_tenth,& tiny_r_kind,huge_r_kind,r60inv,one_tenth,& @@ -158,8 +158,8 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind, logical,allocatable,dimension(:)::rthin,rusage logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot ! equivalence to handle character names equivalence(r_prvstg(1,1),c_prvstg) @@ -722,7 +722,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind, nodata=nodata+ndata deallocate(rusage,rthin) - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/read_satmar.f90 b/src/gsi/read_satmar.f90 index 44c66aea31..e9062a65f6 100644 --- a/src/gsi/read_satmar.f90 +++ b/src/gsi/read_satmar.f90 @@ -71,7 +71,8 @@ subroutine read_satmar (nread, ndata, nodata, & twodvar_regional use satthin, only: map2tgrid,destroygrids,makegrids use convinfo, only: ithin_conv,rmesh_conv,nconvtype,icuse,ictype,ioctype,ctwind, & - pmot_conv,icsubtype + pmot_conv +! use convinfo, only: icsubtype use convthin, only: make3grids,use_all,map3grids_m,del3grids use obsmod, only: bmiss,hilbert_curve,reduce_diag use mpimod, only: npe @@ -173,8 +174,8 @@ subroutine read_satmar (nread, ndata, nodata, & real(r_kind),parameter :: howvDistm = 10000.0_r_kind logical,allocatable,dimension(:)::rthin,rusage logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot ! ! call init_constants_derived @@ -517,7 +518,7 @@ subroutine read_satmar (nread, ndata, nodata, & call del3grids end if - call count_obs(ndata,nreal,ilat,ilon,data_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,data_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata write(lunout) ((data_all(k,i1),k=1,nreal),i1=1,ndata) diff --git a/src/gsi/read_satwnd.f90 b/src/gsi/read_satwnd.f90 index bccc296412..238badc9f9 100644 --- a/src/gsi/read_satwnd.f90 +++ b/src/gsi/read_satwnd.f90 @@ -178,7 +178,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread integer(i_kind) kk,klon1,klat1,klonp1,klatp1 integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k - integer(i_kind) nreal,ithin,iout,iiout,ii + integer(i_kind) nreal,ithin,iout,ii integer(i_kind) itype,iosub,ixsub,isubsub,iobsub,itypey,ierr,ihdr9 integer(i_kind) qm integer(i_kind) nlevp ! vertical level for thinning @@ -224,8 +224,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis logical,allocatable,dimension(:)::rthin,rusage logical save_all - !integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall + !integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot ! GOES-16 new BUFR related variables @@ -677,10 +677,10 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis if(nx >1) then nc=ntx(nx) ithin=ithin_conv(nc) + pmot = pmot_conv(nc) if (ithin > 0 .and. ithin <5) then rmesh=rmesh_conv(nc) pmesh=pmesh_conv(nc) - pmot = pmot_conv(nc) ptime=ptime_conv(nc) if(pmesh > zero) then pflag=1 @@ -706,7 +706,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis enddo endif endif - write(6,'(a52,a16,I5,f10.2,2i5,f10.2,i5,2f10.2)') & + write(6,*) ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc,pmot,ptime + write(6,'(a52,a16,I5,f10.2,2i5,f10.2,i5,i5,f10.2)') & ' READ_SATWND: ictype(nc),rmesh,pflag,nlevp,pmesh,nc ', & ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc,pmot,ptime endif @@ -1709,7 +1710,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! Write header record and data to output file for further processing - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/read_sfcwnd.f90 b/src/gsi/read_sfcwnd.f90 index d4e11947ef..07fed808c7 100644 --- a/src/gsi/read_sfcwnd.f90 +++ b/src/gsi/read_sfcwnd.f90 @@ -48,7 +48,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,& tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,& rlats,rlons,fv3_regional - use qcmod, only: errormod,noiqc,njqc + use qcmod, only: errormod,njqc use convthin, only: make3grids,map3grids_m,del3grids,use_all use constants, only: deg2rad,zero,rad2deg,one_tenth,& @@ -146,8 +146,8 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis logical,allocatable,dimension(:)::rthin,rusage logical save_all -! integer(i_kind) numthin,numqc,numrem - integer(i_kind) nxdata,pmot,numall +! integer(i_kind) numthin,numqc,numrem,numall + integer(i_kind) nxdata,pmot ! equivalence to handle character names @@ -782,7 +782,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ! deallocate(etabl) close(lunin) - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/read_wcpbufr.f90 b/src/gsi/read_wcpbufr.f90 index 50ffae3f63..65e70f4be8 100644 --- a/src/gsi/read_wcpbufr.f90 +++ b/src/gsi/read_wcpbufr.f90 @@ -128,7 +128,7 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& real(r_kind),allocatable,dimension(:,:):: cdata_all logical,allocatable,dimension(:)::rthin,rusage logical save_all - integer(i_kind) numthin,numqc,numrem +! integer(i_kind) numthin,numqc,numrem integer(i_kind) nxdata,pmot,numall @@ -730,7 +730,7 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Write header record and data to output file for further processing - call count_obs(ndata,nreal,ilat,ilon,cdata_all(1,1:ndata),nobs) + call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs) write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata) diff --git a/src/gsi/setupfed.f90 b/src/gsi/setupfed.f90 index 00d4cfa3dc..682c056adf 100644 --- a/src/gsi/setupfed.f90 +++ b/src/gsi/setupfed.f90 @@ -42,7 +42,7 @@ subroutine setupfed(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,fed_diagsa use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close use m_obsLList, only: obsLList use gsi_4dvar, only: nobs_bins,hr_obsbin - use oneobmod, only: oneobtest,maginnov,magoberr + use oneobmod, only: magoberr use guess_grids, only: hrdifsig,nfldsig,ges_prsi use guess_grids, only: ges_lnprsl, geop_hgtl use gridmod, only: lat2, lon2 diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90 index b16a33b414..c4cc36601d 100644 --- a/src/gsi/setupoz.f90 +++ b/src/gsi/setupoz.f90 @@ -217,7 +217,6 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& real(r_kind),dimension(nsig,nloz_omi+1):: doz_dz1 integer(i_kind) :: oz_ind, nind, nnz type(sparr2) :: dhx_dx - real(r_single), dimension(nsdim) :: dhx_dx_array integer(i_kind) i,nlev,ii,jj,iextra,ibin, kk, nperobs integer(i_kind) k1,k2,k,j,nz,jc,idia,irdim1,istatus,ioff0,ioff1 @@ -1170,7 +1169,6 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& real(r_kind),dimension(nsig):: prsltmp real(r_single),dimension(ireal,nobs):: diagbuf real(r_single),allocatable,dimension(:,:,:)::rdiagbuf - real(r_kind),dimension(nsig+1)::prsitmp real(r_kind),dimension(nsig)::ozgestmp integer(i_kind) i,ii,jj,iextra,ibin diff --git a/src/gsi/setuprad.f90 b/src/gsi/setuprad.f90 index 1ff2474e20..8b3dd32ea1 100644 --- a/src/gsi/setuprad.f90 +++ b/src/gsi/setuprad.f90 @@ -1102,10 +1102,12 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,& endif predbias=zero - abi2km_bc = zero - abi2km_bc(2) = 233.5_r_kind - abi2km_bc(3) = 241.7_r_kind - abi2km_bc(4) = 250.5_r_kind + if (abi2km .and. regional) then + abi2km_bc = zero + abi2km_bc(2) = 233.5_r_kind + abi2km_bc(3) = 241.7_r_kind + abi2km_bc(4) = 250.5_r_kind + end if !$omp parallel do schedule(dynamic,1) private(i,mm,j,k,tlap,node,bias) do i=1,nchanl diff --git a/src/gsi/setupw.f90 b/src/gsi/setupw.f90 index 7e0a962d14..e350c7deba 100644 --- a/src/gsi/setupw.f90 +++ b/src/gsi/setupw.f90 @@ -271,7 +271,8 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav real(r_kind) err_input,err_adjst,err_final,skint,sfcr real(r_kind) dudiff_opp, dvdiff_opp, vecdiff, vecdiff_opp real(r_kind) dudiff_opp_rs, dvdiff_opp_rs, vecdiff_rs, vecdiff_opp_rs - real(r_kind) oscat_vec,ascat_vec,rapidscat_vec + real(r_kind) oscat_vec,rapidscat_vec +! real(r_kind) ascat_vec real(r_kind),dimension(nele,nobs):: data real(r_kind),dimension(nobs):: dup real(r_kind),dimension(nsig)::prsltmp,tges,zges diff --git a/src/gsi/stpfed.f90 b/src/gsi/stpfed.f90 index 2a69dd08ec..6511a27968 100644 --- a/src/gsi/stpfed.f90 +++ b/src/gsi/stpfed.f90 @@ -55,14 +55,12 @@ subroutine stpfed(fedhead,rval,sval,out,sges,nstep) use constants, only: half,one,two,tiny_r_kind,cg_term,zero_quad,r3600 use gsi_bundlemod, only: gsi_bundle use gsi_bundlemod, only: gsi_bundlegetpointer - use gridmod, only: wrf_mass_regional, fv3_regional use wrf_vars_mod, only : fed_exist use m_obsNode, only: obsNode use m_fedNode , only: fedNode use m_fedNode , only: fedNode_typecast use m_fedNode , only: fedNode_nextcast ! use directDA_radaruse_mod, only: l_use_fed_directDA - use radarz_cst, only: mphyopt implicit none