diff --git a/src/Applications/GAAS_App/CMakeLists.txt b/src/Applications/GAAS_App/CMakeLists.txt index 79ef8578..38b28bc0 100644 --- a/src/Applications/GAAS_App/CMakeLists.txt +++ b/src/Applications/GAAS_App/CMakeLists.txt @@ -13,6 +13,7 @@ esma_add_library(${this} SRCS ${SRCS} DEPENDENCIES GMAO_psas GMAO_ods GMAO_hermes Chem_Base) +target_link_libraries(${this} PRIVATE OpenMP::OpenMP_Fortran) ecbuild_add_executable(TARGET ana_aod.x SOURCES ana_aod.F LIBS ${this} GMAO_gfio_r4 Chem_Base Chem_Shared) ecbuild_add_executable(TARGET mpana_aod.x SOURCES mpana_aod.F90 LIBS ${this} GMAO_gfio_r4 Chem_Base Chem_Shared) diff --git a/src/Applications/GAAS_App/ana.rc.tmpl b/src/Applications/GAAS_App/ana.rc.tmpl index f52f2cb2..0260efbf 100644 --- a/src/Applications/GAAS_App/ana.rc.tmpl +++ b/src/Applications/GAAS_App/ana.rc.tmpl @@ -37,10 +37,17 @@ ODS_files:: #___AQUA___${FVWORK}/nnr_003.MYD04_L2a.ocean.%y4%m2%d2_%h200z.ods #___AQUA___${FVWORK}/nnr_003.MYD04_L2a.deep.%y4%m2%d2_%h200z.ods +#___NOAA20___${FVWORK}/nnr_001.NOAA20_L2a.dt_land.%y4%m2%d2_%h200z.ods +#___NOAA20___${FVWORK}/nnr_001.NOAA20_L2a.dt_ocean.%y4%m2%d2_%h200z.ods +#___NOAA20___${FVWORK}/nnr_001.NOAA20_L2a.db_deep.%y4%m2%d2_%h200z.ods + + #___MISR___${FVWORK}/misr_F12_0022.bright_tc8.obs.%y4%m2%d2.ods #___AERONET___${FVWORK}/aeronet.obs.%y4%m2%d2_%h2z.ods +#___LUNAR_AERONET___${FVWORK}/aeronet.obs.%y4%m2%d2_%h2z.ods + # Passive data #/nobackup/3/PARASOL/Level2/ODS/Y%y4/M%m2/PARASOL_L2.aero_tc8.obs.%y4%m2%d2.ods #/nobackup/3/OMI/Level2/ODS/Y%y4/M%m2/omi.aero_tc8.obs.%y4%m2%d2.ods diff --git a/src/Applications/GAAS_App/m_sqc.F90 b/src/Applications/GAAS_App/m_sqc.F90 index 2ef84f1a..d0884b1c 100644 --- a/src/Applications/GAAS_App/m_sqc.F90 +++ b/src/Applications/GAAS_App/m_sqc.F90 @@ -148,7 +148,7 @@ subroutine SQC ( y, ntotal, npassed ) ! ! 15May2002 Dee Created this module from psas_qc.f version 1.61 ! 31Mar2003 (Dee/Rukh) Minor changes to the buddy check -! 13Oct2020 (Todling) Store sigO in xvec +! 13Oct2020 (Todling) Store sigO in xvec! ! !EOP !------------------------------------------------------------------------- @@ -801,7 +801,7 @@ subroutine Get_ErrVar_( nobs, nexcl, y, varF, varO ) ktPSAS(np) = kta end if end do - + ! Move those data up... ! --------------------- nmoved = 0 @@ -1267,6 +1267,7 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) ! Index vector for sorts (cannot be allocatable because of OMP) ! ------------------------------------------------------------- integer indx(nobs) + integer, allocatable :: indx2(:) ! List of suspect observations ! ---------------------------- @@ -1275,8 +1276,9 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) ! List of buddies ! --------------- - integer :: ki_buddy(nobs) ! index of buddy - real*8 :: wt_buddy(nobs) ! weight of buddy + integer, allocatable :: ki_buddy(:) ! index of buddy + real*8, allocatable :: wt_buddy(:) ! weight of buddy + real, allocatable :: mysep(:,:) ! Suspect and reaccept flags ! -------------------------- @@ -1304,7 +1306,7 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) integer rc, iter, ireg, ibeg, iend, ilen, i, is, ib, ibb, j integer kis, kts, krs, niter integer maxreg ! number of PSAS regions - real*8 tol2, exponent, scgain + real*8 tol2, myexponent, scgain real*8 dist2, z_dist2 @@ -1448,16 +1450,37 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) ' with ', n_susp, ' suspect observations' n_reacc = 0 + allocate(mysep(n_susp, maxreg)) + + !!!$omp parallel do default(none) private(is, krs) shared(n_susp, maxreg, kr_susp, partition, mysep) + do is = 1, n_susp + krs = kr_susp(is) + do ireg = 1, maxreg + mysep(is,ireg) = Separation(GetRegion(ireg,partition),GetRegion(krs,partition),SEPANG_MIN) + end do + end do + !!!$omp end parallel do + !$omp parallel do & -!$omp default(shared), & -!$omp private(is,kis,kts,krs,nbuddy,ireg,ibeg,iend,i,exponent, & -!$omp scgain,ki_buddy,wt_buddy,indx,accum_del,accum_de2, & -!$omp accum_wgt,accum_var,ib,ibb,del_star,alpha,tol2), & -!$omp reduction(+:n_reacc) +!$omp& schedule(dynamic) & +!$omp& default(none) & +!$omp& firstprivate(nobs) & +!$omp& private(lvs,is,kis,kts,krs,nbuddy,ireg,ibeg,iend,i,myexponent, & +!$omp& scgain,accum_del,accum_de2, ki_buddy, wt_buddy, indx2,& +!$omp& accum_wgt,accum_var,ib,ibb,del_star,alpha,tol2) & +!$omp& shared(n_susp, ki_susp, kt, kr_susp, lev, maxreg, & +!$omp& ireglen, seplim, iregbeg, single_level, issuspect, & +!$omp& qcx, xobs, yobs, zobs, ls_h, ls_v, search_rad, & +!$omp& varF, VarO, nbuddy_max, OmF, nstar, tau_buddy, reaccept,mysep) & +!$omp& reduction(+:n_reacc) - do is = 1, n_susp ! for each suspect obs + do is = 1, n_susp ! for each suspect obs + allocate(ki_buddy(nobs)) + allocate(wt_buddy(nobs)) + allocate(indx2(nobs)) + kis = ki_susp(is) ! this suspect's index kts = kt(kis) ! this suspect's kt krs = kr_susp(is) ! this suspect's region @@ -1468,9 +1491,8 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) nbuddy = 0 do ireg = 1, maxreg - if ((Separation(GetRegion(ireg,partition),GetRegion(krs,partition),SEPANG_MIN) <= seplim) & + if ( (mysep(is,ireg) <= seplim) & .and. (ireglen(ireg) >0 ) ) then ! nearby region with data - ibeg = iregbeg(ireg) iend = ibeg + ireglen(ireg) - 1 @@ -1484,15 +1506,15 @@ subroutine Buddy_Check_ ( nobs, nfailed, y, varF, varO ) if ( .not. issuspect(i) .AND. qcx(i)==0 .AND. & kt(i)==kts) then - exponent = dist2(kis,i)/ls_h(kts)**2 + myexponent = dist2(kis,i)/ls_h(kts)**2 if ( ls_v(kts)>tol_rel ) then ! upper-air data - exponent = exponent + z_dist2(kis,i)/ls_v(kts)**2 + myexponent = myexponent + z_dist2(kis,i)/ls_v(kts)**2 end if ! only if not too far (search_rad length scales): - if ( exponent