A draft PR with non-functional changes to make ctests pass

regression/regression_param.sh

@@ -72,8 +72,8 @@ case $regtest in
            topts[1]="0:10:00" ; popts[1]="18/8/" ; ropts[1]="/1"
            topts[2]="0:10:00" ; popts[2]="18/10/" ; ropts[2]="/2"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1"
-           topts[2]="0:10:00" ; popts[2]="12/10/" ; ropts[2]="/2"
+           topts[1]="1:10:00" ; popts[1]="12/8/" ; ropts[1]="/1"
+           topts[2]="1:10:00" ; popts[2]="12/10/" ; ropts[2]="/2"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -102,8 +102,8 @@ case $regtest in
            topts[1]="0:15:00" ; popts[1]="18/1/"  ; ropts[1]="/1"
            topts[2]="0:15:00" ; popts[2]="18/2/"  ; ropts[2]="/1"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
-           topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
+           topts[1]="1:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
+           topts[2]="1:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -132,8 +132,8 @@ case $regtest in
            topts[1]="0:15:00" ; popts[1]="18/1/"  ; ropts[1]="/1"
            topts[2]="0:15:00" ; popts[2]="18/2/"  ; ropts[2]="/1"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
-           topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
+           topts[1]="1:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
+           topts[2]="1:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -161,8 +161,8 @@ case $regtest in
            topts[1]="0:15:00" ; popts[1]="18/1/"  ; ropts[1]="/1"
            topts[2]="0:15:00" ; popts[2]="18/2/"  ; ropts[2]="/1"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
-           topts[2]="0:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
+           topts[1]="1:15:00" ; popts[1]="64/1/" ; ropts[1]="/1"
+           topts[2]="1:15:00" ; popts[2]="128/2/" ; ropts[2]="/1"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -191,8 +191,8 @@ case $regtest in
            topts[1]="0:15:00" ; popts[1]="4/4/"  ; ropts[1]="/1"
            topts[2]="0:15:00" ; popts[2]="6/6/"  ; ropts[2]="/1"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:15:00" ; popts[1]="28/1/" ; ropts[1]="/1"
-           topts[2]="0:15:00" ; popts[2]="28/2/" ; ropts[2]="/1"
+           topts[1]="1:15:00" ; popts[1]="28/1/" ; ropts[1]="/1"
+           topts[2]="1:15:00" ; popts[2]="28/2/" ; ropts[2]="/1"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -221,8 +221,8 @@ case $regtest in
            topts[1]="0:30:00" ; popts[1]="8/6/"  ; ropts[1]="/1"
            topts[2]="0:30:00" ; popts[2]="8/8/"  ; ropts[2]="/1"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:30:00" ; popts[1]="14/8/" ; ropts[1]="/1"
-           topts[2]="0:30:00" ; popts[2]="14/14/" ; ropts[2]="/2"
+           topts[1]="1:30:00" ; popts[1]="14/8/" ; ropts[1]="/1"
+           topts[2]="1:30:00" ; popts[2]="14/14/" ; ropts[2]="/2"
         fi
 
         if [ "$debug" = ".true." ] ; then
@@ -251,8 +251,8 @@ case $regtest in
            topts[1]="0:10:00" ; popts[1]="12/3/" ; ropts[1]="/1"
            topts[2]="0:10:00" ; popts[2]="12/5/" ; ropts[2]="/2"
         elif [[ "$machine" = "wcoss2" ]]; then
-           topts[1]="0:10:00" ; popts[1]="16/2/" ; ropts[1]="/1"
-           topts[2]="0:10:00" ; popts[2]="16/4/" ; ropts[2]="/2"
+           topts[1]="1:10:00" ; popts[1]="16/2/" ; ropts[1]="/1"
+           topts[2]="1:10:00" ; popts[2]="16/4/" ; ropts[2]="/2"
         fi
 
         if [ "$debug" = ".true." ] ; then

src/enkf/observer_fv3reg.f90

@@ -45,7 +45,7 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely,  &
   use params, only: nstatefields, nlons, nlats, nlevs, nhr_state, fhr_assim
   use gridinfo, only: npts, latsgrd, lonsgrd
   use statevec, only: nsdim
-  use constants, only: zero,one,pi
+  use constants, only: izero,zero,one,pi
   use mpisetup
   implicit none
 
@@ -54,6 +54,18 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely,  &
   real(r_single)                                   ,intent(in   ) :: time         ! observation time relative to middle of window
   integer(i_kind), intent(out) :: ix, iy, it, ixp, iyp, itp
   real(r_kind), intent(out) :: delx, dely, delxp, delyp, delt, deltp
+  ix=izero
+  iy=izero
+  it=izero
+  ixp=izero
+  iyp=izero
+  itp=izero
+  delx=zero
+  dely=zero
+  delxp=zero
+  delyp=zero
+  delt=zero
+  deltp=zero
    write(6,*)'this is a dummy subroutine, running this means something wrong ,stop'
    call stop2(555)
 
@@ -110,6 +122,7 @@ subroutine calc_linhx(hx, dens, dhx_dx, hxpert, hx_ens, &
   type(raggedarr)                                  ,intent(inout) :: hxpert       ! interpolated background
   real(r_single)                                   ,intent(  out) :: hx_ens       ! H (x_ens)
   integer(i_kind) i,j
+  hx_ens=zero
    write(6,*)'this is a dummy subroutine, running this means something wrong ,stop'
    call stop2(555)
 
@@ -145,6 +158,7 @@ subroutine calc_linhx_modens(hx, dhx_dx, hxpert, hx_ens, vscale)
 !$$$
   use kinds, only: r_kind,i_kind,r_single
   use sparsearr, only: sparr, raggedarr
+  use constants, only: zero
   use mpisetup
   implicit none
 
@@ -155,6 +169,7 @@ subroutine calc_linhx_modens(hx, dhx_dx, hxpert, hx_ens, vscale)
   real(r_single)                                   ,intent(  out) :: hx_ens(neigv)! H (x_ens)
   real(r_double),dimension(neigv,nlevs+1)          ,intent(in   ) :: vscale       ! vertical scaling (for modulated ens)
   integer(i_kind) i
+  hx_ens=zero
   write(6,*)'this is a dummy subroutine, running this means something wrong ,stop'
    call stop2(555)
 

src/gsi/CMakeLists.txt

@@ -62,6 +62,7 @@ find_package(NetCDF REQUIRED Fortran)
 if(OPENMP)
   find_package(OpenMP REQUIRED)
 endif()
+find_package(ZLIB REQUIRED)
 
 # NCEPLibs dependencies
 find_package(bacio REQUIRED)
@@ -157,6 +158,7 @@ target_link_libraries(gsi_fortran_obj PUBLIC w3emc::w3emc_d)
 target_link_libraries(gsi_fortran_obj PUBLIC sp::sp_d)
 target_link_libraries(gsi_fortran_obj PUBLIC bufr::bufr_d)
 target_link_libraries(gsi_fortran_obj PUBLIC crtm::crtm)
+target_link_libraries(gsi_fortran_obj PUBLIC ZLIB::ZLIB)
 if(GSI_MODE MATCHES "Regional")
   target_link_libraries(gsi_fortran_obj PUBLIC wrf_io::wrf_io)
 endif()

src/gsi/cmake/gsiapp_compiler_flags_Intel_Fortran.cmake

@@ -8,13 +8,14 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback -assume byterecl -
 # RELEASE FLAGS
 ####################################################################
 
-set(CMAKE_Fortran_FLAGS_RELEASE "-O3 -fp-model strict")
+#clt set(CMAKE_Fortran_FLAGS_RELEASE "-O3 -fp-model strict")
+set(CMAKE_Fortran_FLAGS_RELEASE "-O3 -fp-model strict -fimf-precision=hight -assume protect_parens -fma -qopt-report=3")
 
 ####################################################################
 # DEBUG FLAGS
 ####################################################################
 
-set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -init=snan,arrays -fp-model source -debug -ftrapuv -warn all,nointerfaces -check all,noarg_temp_created -fp-stack-check -fstack-protector")
+set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -init=snan,arrays -fp-model source -debug -ftrapuv -warn all,nointerfaces -check all,noarg_temp_created -fp-stack-check -fstack-protector -fpe0")
 
 ####################################################################
 # LINK FLAGS

src/gsi/combine_radobs.f90

@@ -116,6 +116,7 @@ subroutine combine_radobs(mype_sub,mype_root,&
      end if
      deallocate(icrit)
      allocate(data_all_in(nele,ndata))
+     data_all_in=zero 
 !$omp parallel do private(kk,k,l)
      do kk=1,ndata
         k=nloc(kk)
@@ -133,7 +134,7 @@ subroutine combine_radobs(mype_sub,mype_root,&
      deallocate(nloc)
 
 !    get all data on process mype_root
-!    data_all(:,:) = zero
+     data_all(:,:) = zero
      call mpi_reduce(data_all_in,data_all,nele*ndata,mpi_rtype,mpi_sum,&
           mype_root,mpi_comm_sub,ierror)
      deallocate(data_all_in)

src/gsi/cplr_get_fv3_regional_ensperts.f90

@@ -76,6 +76,7 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
      use netcdf_mod , only: nc_check
      use gsi_rfv3io_mod, only: fv3lam_io_phymetvars3d_nouv
      use obsmod, only: if_model_dbz,if_model_fed
+     use mpi, only : MPI_Wtime, MPI_REAL8, MPI_SUCCESS, MPI_MAX
 
 
      implicit none
@@ -119,6 +120,8 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
      integer(i_kind):: imem_start,n_fv3sar
 
      integer(i_kind):: i_caseflag
+     real(kind=8) :: time_beg,time_end,walltime, tb,te,wt
+     integer(i_kind) :: ierr
 
      if(n_ens/=(n_ens_gfs+n_ens_fv3sar)) then
         write(6,*)'wrong, the sum of  n_ens_gfs and n_ens_fv3sar not equal n_ens, stop'
@@ -275,7 +278,7 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
        end if
     end if
 
-
+    tb=MPI_Wtime()
     do m=1,ntlevs_ens
 
 
@@ -452,7 +455,8 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
            if( .not. parallelization_over_ensmembers )then
               if (mype == 0) write(6,'(a,a)') &
                  'CALL READ_FV3_REGIONAL_ENSPERTS FOR ENS DATA with the filename str : ',trim(ensfilenam_str)
-
+
+              time_beg=MPI_Wtime()
               select case (i_caseflag)
                 case (0)
                   call this%general_read_fv3_regional(fv3_filename,ps,u,v,tv,rh,oz)
@@ -469,9 +473,15 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
                   call this%general_read_fv3_regional(fv3_filename,ps,u,v,tv,rh,oz,   &
                             g_ql=ql,g_qi=qi,g_qr=qr,g_qs=qs,g_qg=qg,g_qnr=qnr,g_w=w,g_fed=fed)
                 case (5)
+                  !write(6,'("get_fv3_regional_ensperts_run: Before general_read_fv3_regional")')
                   call this%general_read_fv3_regional(fv3_filename,ps,u,v,tv,rh,oz,   &
                             g_ql=ql,g_qi=qi,g_qr=qr,g_qs=qs,g_qg=qg,g_qnr=qnr,g_w=w,g_dbz=dbz,g_fed=fed)
               end select
+              time_end=MPI_Wtime()
+              call MPI_Reduce(time_end-time_beg, walltime, 1, MPI_REAL8, MPI_MAX, 0, MPI_COMM_WORLD, ierr)
+              if(ierr /= MPI_SUCCESS) print*,'MPI_Reduce ',ierr
+              if(mype==0) write(6,'("Maximum Walltime for general_read_fv3_regional" f15.4,I4)') walltime,i_caseflag
+
            end if
 
            if( parallelization_over_ensmembers )then 
@@ -792,6 +802,11 @@ subroutine get_fv3_regional_ensperts_run(this,en_perts,nelen,ps_bar)
         end do
 
     enddo ! it 4d loop
+    te=MPI_Wtime()
+    call MPI_Reduce(te-tb, wt, 1, MPI_REAL8, MPI_MAX, 0, MPI_COMM_WORLD, ierr)
+    if(ierr /= MPI_SUCCESS) print*,'MPI_Reduce ',ierr
+    if(mype==0) write(6,'("Maximum Walltime to read ",I4," ensemble members ", f15.4)') n_ens_fv3sar,wt
+
  ! CALCULATE ENSEMBLE SPREAD
     if(write_ens_sprd ) then
         call this%ens_spread_dualres_regional(mype,en_perts,nelen)
@@ -851,7 +866,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     use hybrid_ensemble_parameters, only: grd_ens,q_hyb_ens
     use hybrid_ensemble_parameters, only: fv3sar_ensemble_opt,dual_res
 
-    use mpimod, only: mpi_comm_world,mpi_rtype
+    use mpimod, only: mpi_comm_world,mpi_rtype,mype
     use gsi_rfv3io_mod,only: type_fv3regfilenameg
     use gsi_rfv3io_mod,only:n2d 
     use constants, only: half,zero
@@ -870,6 +885,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     use directDA_radaruse_mod, only: l_use_cvpqx, cvpqx_pval, cld_nt_updt
     use directDA_radaruse_mod, only: l_cvpnr, cvpnr_pval
     use obsmod, only:if_model_dbz,if_model_fed
+    use mpi, only : MPI_Wtime, MPI_REAL8, MPI_MAX, MPI_SUCCESS
 
 
     implicit none
@@ -913,6 +929,8 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     character(len=:),allocatable :: sfcdata   !='fv3_sfcdata'
     character(len=:),allocatable :: couplerres!='coupler.res'
     integer (i_kind) ier,istatus
+    real(kind=8) :: time_beg,time_end,walltime
+    integer(i_kind) :: ierr
 
 
     associate( this => this ) ! eliminates warning for unused dummy argument needed for binding
@@ -930,6 +948,7 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     couplerres=fv3_filenameginput%couplerres
 
 
+    !write(6,'("general_read_fv3_regional: fv3sar_ensemble_opt= " I4)') fv3sar_ensemble_opt
 
 
     if (allocated(fv3lam_ens_io_dynmetvars2d_nouv) ) then   
@@ -956,16 +975,28 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     end if
 
 
-    if(fv3sar_ensemble_opt == 0 ) then  
+    if(fv3sar_ensemble_opt == 0 ) then
+      time_beg=MPI_Wtime()
       call gsi_fv3ncdf_readuv(grd_fv3lam_ens_uv,g_u,g_v,fv3_filenameginput,dual_res)
+      time_end=MPI_Wtime()
+      call MPI_Reduce(time_end-time_beg, walltime, 1, MPI_REAL8, MPI_MAX, 0, MPI_COMM_WORLD, ierr)
+      if(ierr /= MPI_SUCCESS) print*,'MPI_Reduce ',ierr
+      if(mype==0) write(6,'("general_read_fv3_regional: Maximum Walltime for gsi_fv3ncdf_readuv" f15.4)') walltime
+
     else
       call gsi_fv3ncdf_readuv_v1(grd_fv3lam_ens_uv,g_u,g_v,fv3_filenameginput,dual_res)
     endif
     if(fv3sar_ensemble_opt == 0) then
+      time_beg=MPI_Wtime()
       call gsi_fv3ncdf_read(grd_fv3lam_ens_dynvar_io_nouv,gsibundle_fv3lam_ens_dynvar_nouv,&
                             fv3_filenameginput%dynvars,fv3_filenameginput,dual_res)
       call gsi_fv3ncdf_read(grd_fv3lam_ens_tracer_io_nouv,gsibundle_fv3lam_ens_tracer_nouv,&
                             fv3_filenameginput%tracers,fv3_filenameginput,dual_res)
+      time_end=MPI_Wtime()
+      call MPI_Reduce(time_end-time_beg, walltime, 1, MPI_REAL8, MPI_MAX, 0, MPI_COMM_WORLD, ierr)
+      if(ierr /= MPI_SUCCESS) print*,'MPI_Reduce ',ierr
+      if(mype==0) write(6,'("general_read_fv3_regional: Maximum Walltime for gsi_fv3ncdf_read" f15.4)') walltime
+
       if( if_model_dbz .or. if_model_fed ) then
          call gsi_fv3ncdf_read(grd_fv3lam_ens_phyvar_io_nouv,gsibundle_fv3lam_ens_phyvar_nouv,&
                                fv3_filenameginput%phyvars,fv3_filenameginput,dual_res)
@@ -1013,6 +1044,8 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     endif
 
 !!  tsen2tv  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !$omp parallel do default(none),private(k,i,j) &
+    !$omp shared(grd_ens,g_q,g_tsen,g_tv,fv)
     do k=1,grd_ens%nsig
        do j=1,grd_ens%lon2
           do i=1,grd_ens%lat2
@@ -1023,6 +1056,8 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
     if (.not.q_hyb_ens) then
       ice=.true.
       iderivative=0
+      !$omp parallel do default(none),private(k,i,j,kp) &
+      !$omp shared(grd_ens,g_prsi,g_prsl)
       do k=1,grd_ens%nsig
         kp=k+1
         do j=1,grd_ens%lon2
@@ -1032,6 +1067,8 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
         end do
       end do
       call genqsat(g_rh,g_tsen(1,1,1),g_prsl(1,1,1),grd_ens%lat2,grd_ens%lon2,grd_ens%nsig,ice,iderivative)
+      !$omp parallel do default(none),private(k,i,j) &
+      !$omp shared(grd_ens,g_rh,g_q)
       do k=1,grd_ens%nsig
         do j=1,grd_ens%lon2
           do i=1,grd_ens%lat2
@@ -1051,6 +1088,8 @@ subroutine general_read_fv3_regional(this,fv3_filenameginput,g_ps,g_u,g_v,g_tv,g
 
 
 ! CV transform
+    !$omp parallel do default(none),private(k,i,j) &
+    !$omp shared(grd_ens,l_use_cvpqx,g_qr,cvpqx_pval,g_qs,g_qg,g_qnr,cld_nt_updt,l_cvpnr,cvpnr_pval)
     do k=1,grd_ens%nsig
        do i=1,grd_ens%lon2
           do j=1,grd_ens%lat2

src/gsi/crc32.F90

@@ -0,0 +1,23 @@
+module crc32
+  use iso_c_binding
+  implicit none
+  public :: digest
+
+  interface
+    integer function digest_c(message) bind(c)
+      use iso_c_binding, only: c_char
+      character(kind=c_char), intent(in) :: message(*)
+    end function digest_c
+  end interface
+
+  contains
+
+  integer function digest(m)
+    use iso_c_binding, only: c_null_char
+    implicit none
+    character(len=*), intent(in) :: m
+    !m='nid001019'
+    digest=abs(digest_c(trim(m)//c_null_char))
+    !write(6,'("Digest ",I12)') digest
+  end function digest
+end module crc32