From 9e5aa09c0a31ec3f4f8352f2a6de0dbf487d0b0d Mon Sep 17 00:00:00 2001 From: Jack Woollen Date: Tue, 8 Aug 2023 11:19:38 -0400 Subject: [PATCH 1/6] changes for reanalysis runs (#591) --- src/gsi/gsi_obOperTypeManager.F90 | 8 +- src/gsi/m_extOzone.F90 | 319 ++++++++++++++++++++++++++++-- src/gsi/read_bufrtovs.f90 | 2 +- src/gsi/read_obs.F90 | 9 +- src/gsi/read_satwnd.f90 | 110 ++++++++--- src/gsi/read_ssmi.f90 | 6 +- src/gsi/setupoz.f90 | 156 +++++++++++---- 7 files changed, 518 insertions(+), 92 deletions(-) diff --git a/src/gsi/gsi_obOperTypeManager.F90 b/src/gsi/gsi_obOperTypeManager.F90 index ea306953c4..5df899825a 100644 --- a/src/gsi/gsi_obOperTypeManager.F90 +++ b/src/gsi/gsi_obOperTypeManager.F90 @@ -276,6 +276,9 @@ function dtype2index_(dtype) result(index_) case("ompstc8"); index_= iobOper_oz case("ompsnp" ); index_= iobOper_oz case("ompsnm" ); index_= iobOper_oz + case("omieff" ); index_= iobOper_oz + case("tomseff" ); index_= iobOper_oz + case("ompsnmeff"); index_= iobOper_oz case("o3l" ,"[o3loper]" ); index_= iobOper_o3l case("o3lev" ); index_= iobOper_o3l @@ -283,11 +286,10 @@ function dtype2index_(dtype) result(index_) case("mls22" ); index_= iobOper_o3l case("mls30" ); index_= iobOper_o3l case("mls55" ); index_= iobOper_o3l - case("omieff" ); index_= iobOper_o3l - case("tomseff" ); index_= iobOper_o3l + case("ompslp" ); index_= iobOper_o3l case("ompslpuv" ); index_= iobOper_o3l case("ompslpvis"); index_= iobOper_o3l - case("ompslp" ); index_= iobOper_o3l + case("ompslpnc" ); index_= iobOper_o3l case("gpsbend","[gpsbendoper]"); index_= iobOper_gpsbend case("gps_bnd"); index_= iobOper_gpsbend diff --git a/src/gsi/m_extOzone.F90 b/src/gsi/m_extOzone.F90 index 3d4b6783c1..a28209292f 100644 --- a/src/gsi/m_extOzone.F90 +++ b/src/gsi/m_extOzone.F90 @@ -158,32 +158,36 @@ function is_extOzone_(dfile,dtype,dplat,class) is_extOzone_= & ifile_==iBUFR .and. dtype == 'o3lev' .or. & ifile_==iNC .and. dtype == 'mls55' .or. & + ifile_==iNC .and. dtype == 'ompslpnc' .or. & ifile_==iNC .and. dtype == 'ompslpvis' .or. & ifile_==iNC .and. dtype == 'ompslpuv' .or. & - ifile_==iNC .and. dtype == 'ompslp' .or. & ifile_==iNC .and. dtype == 'lims' .or. & ifile_==iNC .and. dtype == 'uarsmls' .or. & ifile_==iNC .and. dtype == 'mipas' .or. & ifile_==iNC .and. dtype == 'omieff' .or. & + ifile_==iNC .and. dtype == 'ompsnmeff' .or. & + ifile_==iNC .and. dtype == 'ompsnpnc' .or. & ifile_==iNC .and. dtype == 'tomseff' case(iLEVEL) is_extOzone_= & ifile_==iBUFR .and. dtype == 'o3lev' .or. & ifile_==iNC .and. dtype == 'mls55' .or. & + ifile_==iNC .and. dtype == 'ompslpnc' .or. & ifile_==iNC .and. dtype == 'ompslpvis' .or. & ifile_==iNC .and. dtype == 'ompslpuv' .or. & - ifile_==iNC .and. dtype == 'ompslp' .or. & ifile_==iNC .and. dtype == 'lims' .or. & ifile_==iNC .and. dtype == 'uarsmls' .or. & ifile_==iNC .and. dtype == 'mipas' case(iLAYER) - is_extOzone_= .false. + is_extOzone_= & + ifile_==iNC .and. dtype == 'ompsnpnc' case(iTOTAL) is_extOzone_= & - ifile_==iNC .and. dtype == 'omieff' .or. & + ifile_==iNC .and. dtype == 'omieff' .or. & + ifile_==iNC .and. dtype == 'ompsnmeff' .or. & ifile_==iNC .and. dtype == 'tomseff' case default @@ -332,7 +336,7 @@ subroutine read_(dfile,dtype,dplat,dsis, & ! intent(in), keys for type mana endif select case(dtype) - case('omieff','tomseff') ! layer-ozone or total-ozone types + case('omieff','tomseff','ompsnmeff') ! layer-ozone or total-ozone types select case(dfile_format(dfile)) case('nc') call oztot_ncInquire_(nreal,nchan,ilat,ilon, & @@ -381,7 +385,7 @@ subroutine read_(dfile,dtype,dplat,dsis, & ! intent(in), keys for type mana jsatid, gstime,twind) end select - case('mls55','ompslpvis','ompslpuv','ompslp','lims','uarsmls','mipas') + case('mls55','ompslpnc','ompslpvis','ompslpuv','lims','uarsmls','mipas') select case(dfile_format(dfile)) case('nc') call ozlev_ncInquire_( nreal,nchan,ilat,ilon,maxobs) @@ -393,6 +397,17 @@ subroutine read_(dfile,dtype,dplat,dsis, & ! intent(in), keys for type mana end select + case('ompsnpnc') + select case(dfile_format(dfile)) + case('nc') + call ozlay_ncInquire_( nreal,nchan,ilat,ilon,maxobs) + allocate(p_out(nreal+nchan,maxobs)) + p_out(:,:)=RMISS + + call ozlay_ncRead_(dfile,dtype, p_out,nread,npuse,nouse, gstime,twind) + + end select + end select if(nouse<0 .or. .not.associated(p_out)) then @@ -706,7 +721,7 @@ subroutine oztot_ncread_(dfile,dtype,dsis, ozout,nmrecs,ndata,nodata, & ! Apply data screening based on quality flags ! Bit 10 (from the left) in TOQF represents row anomaly. All 17 bits in toqf is ! supposed to converted into array elements of binary(:), either for "tomseff" or -! "omieff". +! "omieff" or "ompsnmeff". binary(:)=0 select case(dtype) case('omieff') @@ -731,6 +746,9 @@ subroutine oztot_ncread_(dfile,dtype,dsis, ozout,nmrecs,ndata,nodata, & ! 0 - good data, 1 - good data with SZA > 84 deg if (toqf /= 0) cycle recloop + case('ompsnmeff') + !! data in NetCDF are prescreened + case default end select @@ -764,10 +782,10 @@ subroutine oztot_ncread_(dfile,dtype,dsis, ozout,nmrecs,ndata,nodata, & ozout(7,itx)=real(toqf) ! - total ozone quality code (not used) ozout(8,itx)=real(sza) ! solar zenith angle ozout(9,itx)=binary(10) ! row anomaly flag, is actually fixed to 0 - ozout(10,itx)=0. ! - cloud amount (not used) - ozout(11,itx)=0. ! - vzan (not used) - ozout(12,itx)=0. ! - aerosol index (not used) - ozout(13,itx)=0. ! - ascending/descending (not used) + ozout(10,itx)=zero ! - cloud amount (not used) + ozout(11,itx)=zero ! - vzan (not used) + ozout(12,itx)=zero ! - aerosol index (not used) + ozout(13,itx)=zero ! - ascending/descending (not used) ozout(14,itx)=real(fovn) ! scan position ! "(not used)" flags above imply that they ! are not used in setupozlay(). @@ -1421,13 +1439,286 @@ subroutine ozlev_bufrread_(dfile,dtype,dsis, ozout,nmrecs,ndata,nodata, & call warn(myname_,' actual retained =',nodata) call warn(myname_,' size(ozout,2) =',maxobs) endif - call closbf(lunin) - close(lunin) ! write(stdout,'(3a,3i8,f8.2)') mprefix('read_ozone'), & ! ' obstype,nmrecs,ndata,nodata,no/ndata = ',dtype,nmrecs,ndata,nodata,real(nodata)/ndata -end subroutine ozlev_bufrread_ + end subroutine ozlev_bufrread_ + + subroutine ozlay_ncInquire_( nreal,nchan,ilat,ilon, maxrec) + implicit none + + integer(kind=i_kind), intent(out):: nreal ! number of real parameters per record + integer(kind=i_kind), intent(out):: nchan ! number of channels or levels per record + integer(kind=i_kind), intent(out):: ilat ! index to latitude in nreal parameters. + integer(kind=i_kind), intent(out):: ilon ! index to longitude in nreal parameters. + + integer(kind=i_kind), intent(out):: maxrec ! extimated input record count + + character(len=*), parameter:: myname_=myname//'::ozlay_ncInquire_' + + ! Configure the record, they are not (dfile,dtype,dplat) dependent in this case. + nreal = 9 + nchan = 22 + ilat=4 + ilon=3 + + maxrec = MAXOBS_ + end subroutine ozlay_ncInquire_ + + !.................................................................................. + subroutine ozlay_ncread_(dfile,dtype,ozout,nmrecs,ndata,nodata, gstime,twind) + !.................................................................................. + use netcdf, only: nf90_open + use netcdf, only: nf90_nowrite + use netcdf, only: nf90_noerr + use netcdf, only: nf90_inq_dimid + use netcdf, only: nf90_inquire_dimension + use netcdf, only: nf90_inq_varid + use netcdf, only: nf90_get_var + use netcdf, only: nf90_close + + 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 ozinfo, only: jpch_oz,nusis_oz,iuse_oz + use mpeu_util, only: perr,die + ! use mpeu_util, only: mprefix,stdout + + implicit none + character(len=*), intent(in):: dfile ! obs_input filename + character(len=*), intent(in):: dtype ! obs_input dtype + real (kind=r_kind), dimension(:,:), intent(out):: ozout + integer(kind=i_kind), intent(out):: nmrecs ! count of records read + integer(kind=i_kind), intent(out):: ndata ! count of processed + integer(kind=i_kind), intent(out):: nodata ! count of retained + real (kind=r_kind), intent(in):: gstime ! analysis time (minute) from reference date + real (kind=r_kind), intent(in):: twind ! input group time window (hour) + + character(len=*), parameter:: myname_=myname//'::ozlay_ncRead_' + + integer(kind=i_kind):: ier,nprofs,levs,ikx,i,k0,ilev,iprof + integer(kind=i_kind):: nrecDimId,lonVarID,latVarID,yyVarID,mmVarID,levsDimId + integer(kind=i_kind):: szaVarID,ozoneVarID,nmind,k + integer(kind=i_kind):: ddVarID,hhVarID,minVarID,ssVarID,maxobs,ncid + real (kind=r_kind):: dlon,dlon_earth,dlon_earth_deg + real (kind=r_kind):: dlat,dlat_earth,dlat_earth_deg + real (kind=r_kind):: slons0,slats0 + real (kind=r_kind):: tdiff,sstime,t4dv,rsat + integer(kind=i_kind):: idate5(5) + integer(kind=i_kind),allocatable,dimension(:):: ipos + real(r_kind),allocatable,dimension(:):: poz + + integer(kind=i_kind), allocatable :: iya(:),ima(:),idda(:),ihha(:),imina(:),iseca(:) + real (kind=r_kind), allocatable :: slatsa(:),slonsa(:),ozone(:,:),sza(:) + real(r_kind) totoz + + logical:: outside + logical:: first + real(r_kind),parameter:: badoz = 10000.0_r_kind + + maxobs=size(ozout,2) + rsat=999._r_kind + ndata = 0 + nmrecs=0 + nodata=-1 + + ! Open file and read dimensions + call check(nf90_open(trim(dfile),nf90_nowrite,ncid),stat=ier) + + ! ignore if the file is not actually present. + if(ier/=nf90_noerr) then + nodata = 0 + return + endif + + ! Get dimensions from the input file + call check(nf90_inq_dimid(ncid, "nrec", nrecDimId),stat=ier) + + ! ignore if error + if(ier/=nf90_noerr) then + nodata = 0 + call check(nf90_close(ncid),stat=ier) + return + endif + + ! Get dimensions from the input file: # of profiles and # of levels + nprofs=0 + call check(nf90_inquire_dimension(ncid, nrecDimId, len = nprofs),stat=ier) + ! ignore if error + if(ier/=nf90_noerr) then + call check(nf90_close(ncid),stat=ier) + return + endif + + if(nprofs==0) then + nodata=0 + call check(nf90_close(ncid),stat=ier) + return + endif + + ! Continue the input + call check(nf90_inq_dimid(ncid, "nlevs", levsDimId)) + call check(nf90_inquire_dimension(ncid, levsDimId, len = levs)) + !!!!! if (levs /= nchan) + + allocate(ipos(levs)) + ipos=999 + ikx = 0 + first=.false. + do i=1,jpch_oz + if( (.not. first) .and. index(nusis_oz(i), trim(dtype))/=0) then + k0=i + first=.true. + end if + if(first.and.index(nusis_oz(i),trim(dtype))/=0) then + ikx=ikx+1 + ipos(ikx)=k0+ikx-1 + end if + end do + + if (ikx/=levs+1) call die(myname_//': inconsistent levs for '//dtype) + + ! Allocate space and read data + allocate(iya(nprofs),ima(nprofs),idda(nprofs),ihha(nprofs),imina(nprofs), & + iseca(nprofs),slatsa(nprofs),slonsa(nprofs),sza(nprofs),ozone(levs,nprofs)) + allocate (poz(levs+1)) + + call check(nf90_inq_varid(ncid, "lon", lonVarId)) + call check(nf90_get_var(ncid, lonVarId, slonsa)) + + call check(nf90_inq_varid(ncid, "lat", latVarId)) + call check(nf90_get_var(ncid, latVarId, slatsa)) + + call check(nf90_inq_varid(ncid, "yy", yyVarId)) + call check(nf90_get_var(ncid, yyVarId, iya)) + + call check(nf90_inq_varid(ncid, "mm", mmVarId)) + call check(nf90_get_var(ncid, mmVarId, ima)) + + call check(nf90_inq_varid(ncid, "dd", ddVarId)) + call check(nf90_get_var(ncid, ddVarId, idda)) + + call check(nf90_inq_varid(ncid, "hh", hhVarId)) + call check(nf90_get_var(ncid, hhVarId, ihha)) + + call check(nf90_inq_varid(ncid, "min", minVarId)) + call check(nf90_get_var(ncid, minVarId, imina)) + + call check(nf90_inq_varid(ncid, "ss", ssVarId)) + call check(nf90_get_var(ncid, ssVarId, iseca)) + + call check(nf90_inq_varid(ncid, "sza", szaVarId)) + call check(nf90_get_var(ncid, szaVarId, sza)) + + call check(nf90_inq_varid(ncid, "ozone", ozoneVarId)) + call check(nf90_get_var(ncid, ozoneVarId, ozone)) + + ! close the data file + call check(nf90_close(ncid)) + + ! 'Unpack' the data + nmrecs = 0 + nodata = 0 + read_loop1: do iprof = 1, nprofs + do ilev = 1, levs + if (ozone(ilev, iprof) .lt. -900.0_r_kind) cycle ! undefined + end do +!!$ if (iuse_oz(ipos(ilev)) < 0) then +!!$ usage = 10000._r_kind +!!$ else +!!$ usage = zero +!!$ endif + nmrecs=nmrecs+levs+1 + + ! convert observation location to radians + slons0=slonsa(iprof) + slats0=slatsa(iprof) + if(abs(slats0)>90._r_kind .or. abs(slons0)>r360) cycle + if(slons0< zero) slons0=slons0+r360 + if(slons0==r360) slons0=zero + dlat_earth_deg = slats0 + dlon_earth_deg = slons0 + dlat_earth = slats0 * deg2rad + dlon_earth = slons0 * deg2rad + + if(regional)then + call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside) + if(outside) cycle + else + dlat = dlat_earth + dlon = dlon_earth + call grdcrd1(dlat,rlats,nlat,1) + call grdcrd1(dlon,rlons,nlon,1) + endif + + idate5(1) = iya(iprof) !year + idate5(2) = ima(iprof) !month + idate5(3) = idda(iprof) !day + idate5(4) = ihha(iprof) !hour + idate5(5) = imina(iprof) !minute + call w3fs21(idate5,nmind) + t4dv=real((nmind-iwinbgn),r_kind)*r60inv + if (l4dvar.or.l4densvar) then + if (t4dvwinlen) then + write(6,*)'read_ozone: ', dtype,' obs time idate5=',idate5,', t4dv=',& + t4dv,' is outside time window, sstime=',sstime*r60inv + cycle + end if + else + sstime=real(nmind,r_kind) + tdiff=(sstime-gstime)*r60inv + if(abs(tdiff) > twind)then + write(6,*)'read_ozone: ',dtype,' obs time idate5=',idate5,', tdiff=',& + tdiff,' is outside time window=',twind + cycle + end if + end if + + !! Compute total ozone + totoz=zero + do k=1,levs + poz(k) = ozone(k,iprof) + totoz=totoz+ozone(k,iprof) + end do + poz(levs+1) = totoz + + !Check ozone layer values. If any layer value is bad, toss entire profile + do k=1,levs + if (poz(k)>badoz) cycle read_loop1 + end do + + ! Write ozone record to output file + ndata=min(ndata+1,maxobs) + if(ndata<=maxobs) then + nodata=nodata+levs+1 + ozout(1,ndata)=rsat + ozout(2,ndata)=t4dv + ozout(3,ndata)=dlon ! grid relative longitude + ozout(4,ndata)=dlat ! grid relative latitude + ozout(5,ndata)=dlon_earth_deg ! earth relative longitude (degrees) + ozout(6,ndata)=dlat_earth_deg ! earth relative latitude (degrees) + ozout(7,ndata)=zero ! total ozone error flag + ozout(8,ndata)=zero ! profile ozone error flag + ozout(9,ndata)=sza(iprof) ! solar zenith angle + do k=1,levs+1 + ozout(k+9,ndata)=poz(k) + end do + end if + end do read_loop1 + + deallocate(iya,ima,idda,ihha,imina,iseca,slatsa,slonsa, ozone, poz,sza) + deallocate(ipos) + if (ndata > maxobs) then + call perr('read_ozone','Number of layer obs reached maxobs = ', maxobs) + call perr(myname_,'Number of layer obs reached maxobs = ', maxobs) + call perr(myname_,' ndata = ', ndata) + call perr(myname_,' nodata = ', nodata) + call die(myname_) + endif + + end subroutine ozlay_ncread_ !.................................................................................. subroutine check(status,stat) diff --git a/src/gsi/read_bufrtovs.f90 b/src/gsi/read_bufrtovs.f90 index 0c954c7c1d..a819acd2c3 100644 --- a/src/gsi/read_bufrtovs.f90 +++ b/src/gsi/read_bufrtovs.f90 @@ -683,7 +683,7 @@ subroutine read_bufrtovs(mype,val_tovs,ithin,isfcalc,& if (llll > 1) then sacv = nint(bfr1bhdr(14)) if (sacv > spc_coeff_versions) then - write(6,*) 'READ_BUFRTOVS WARNING sacv greater than spc_coeff_versions' + write(6,*) 'READ_BUFRTOVS WARNING sacv greater than spc_coeff_versions',' ',jsatid,' ',obstype end if else ! normal feed doesn't have antenna correction, so set sacv to 0 sacv = 0 diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90 index 9017c498c2..86c7e4ce45 100644 --- a/src/gsi/read_obs.F90 +++ b/src/gsi/read_obs.F90 @@ -891,6 +891,7 @@ subroutine read_obs(ndata,mype) if(obstype == 'mls20' ) nmls_type=nmls_type+1 if(obstype == 'mls22' ) nmls_type=nmls_type+1 if(obstype == 'mls30' ) nmls_type=nmls_type+1 + if(obstype == 'mls55' ) nmls_type=nmls_type+1 if(nmls_type>1) then write(6,*) '******ERROR***********: there is more than one MLS data type, not allowed, please check' call stop2(339) @@ -934,6 +935,7 @@ subroutine read_obs(ndata,mype) .or. obstype == 'ompsnp' & .or. obstype == 'gome' & .or. index(obstype, 'omps') /= 0 & + .or. index(obstype, 'omi' ) /= 0 & .or. mls & ) then ditype(i) = 'ozone' @@ -1080,7 +1082,12 @@ subroutine read_obs(ndata,mype) if (ii>npem1) ii=0 if(mype==ii)then call gsi_inquire(lenbytes,lexist,trim(dfile(i)),mype) - call read_obs_check (lexist,trim(dfile(i)),dplat(i),dtype(i),minuse,read_rec1(i)) + + if (is_extOzone(dfile(i),obstype,dplat(i))) then + print*,'reading ',trim(dfile(i)),' ',obstype,' ',trim(dplat(i)),lexist,lenbytes + else + call read_obs_check (lexist,trim(dfile(i)),dplat(i),dtype(i),minuse,read_rec1(i)) + endif ! If no data set starting record to be 999999. Note if this is not large ! enough code should still work - just does a bit more work. diff --git a/src/gsi/read_satwnd.f90 b/src/gsi/read_satwnd.f90 index 7a372b9e15..1679708787 100644 --- a/src/gsi/read_satwnd.f90 +++ b/src/gsi/read_satwnd.f90 @@ -155,12 +155,12 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis real(r_kind),parameter:: r799=799.0_r_kind real(r_kind),parameter:: r1200= 1200.0_r_kind real(r_kind),parameter:: r10000= 10000.0_r_kind - - + + real(r_double),parameter:: rmiss=10d7 ! Declare local variables logical outside,inflate_error - logical luse,ithinp + logical luse,ithinp,do_qc logical,allocatable,dimension(:,:):: lmsg ! set true when convinfo entry id found in a message character(70) obstr_v1, obstr_v2,hdrtr_v1,hdrtr_v2 @@ -170,7 +170,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis character(8) c_prvstg,c_sprvstg character(8) c_station_id,stationid - integer(i_kind) mxtb,nmsgmax + integer(i_kind) mxtb,nmsgmax,qcret integer(i_kind) ireadmg,ireadsb,iuse integer(i_kind) i,maxobs,idomsfc,nsattype,ncount integer(i_kind) nc,nx,isflg,itx,j,nchanl @@ -192,6 +192,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis integer(i_kind),dimension(5):: idate5 integer(i_kind),allocatable,dimension(:):: nrep,isort,iloc integer(i_kind),allocatable,dimension(:,:):: tab + integer(i_kind) :: icnt(1000) integer(i_kind) ntime,itime @@ -263,6 +264,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis wjbmax=5.0_r_kind pflag=0 var_jb=zero + icnt=0 ! allocate(etabl(302,33,6)) ! add 2 ObsErr profiles for GOES-R IR(itype=301) and WV(itype=300) (not used yet, 2015-07-08, Genkova) @@ -276,8 +278,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ntx(ntread)=0 ntxall=0 do nc=1,nconvtype - if( (trim(ioctype(nc)) == 'uv' .or. trim(ioctype(nc)) == 'wspd10m' .or. trim(ioctype(nc)) == 'uwnd10m' .or. trim(ioctype(nc)) == 'vwnd10m') .and. ictype(nc) >=240 & - .and. ictype(nc) <=265) then + if((trim(ioctype(nc)) == 'uv' .or. trim(ioctype(nc)) == 'wspd10m' .or. trim(ioctype(nc)) == 'uwnd10m' .or. & + trim(ioctype(nc)) == 'vwnd10m') .and. ictype(nc) >=240 .and. ictype(nc) <=265) then ntmatch=ntmatch+1 ntxall(ntmatch)=nc ithin=ithin_conv(nc) @@ -287,6 +289,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis end if end if end do + if(ntmatch == 0)then write(6,*) ' READ_SATWND: no matching obstype found in obsinfo ',obstype return @@ -299,7 +302,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis call getcount_bufr(infile,nmsgmax,mxtb) allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax)) - lmsg = .false. maxobs=0 @@ -338,6 +340,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis iobsub=0 itype=-1 iobsub=int(hdrdat(1)) + if(trim(subset) == 'NC005064' .or. trim(subset) == 'NC005065' .or. & trim(subset) == 'NC005066') then if( hdrdat(1) = r50) then !the range of EUMETSAT satellite IDS @@ -351,6 +354,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=254 endif endif + else if(trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or.& trim(subset) == 'NC005069') then ! read new EUM BURF if( hdrdat(1) = r50) then !the range of EUMETSAT satellite IDS @@ -364,6 +368,21 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=254 endif endif + + else if(trim(subset) == 'NC005041' .or. trim(subset) == 'NC005042' .or. & + trim(subset) == 'NC005043') then + if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then ! the range of JMA satellite IDS + if(hdrdat(9) == one) then ! IR winds + itype=252 + else if(hdrdat(9) == two) then ! visible winds + itype=242 + else if(hdrdat(9) == three) then ! WV cloud top + itype=250 + else if(hdrdat(9) >= four) then ! WV deep layer,monitored + itype=250 + endif + endif + else if(trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or. & trim(subset) == 'NC005046') then if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then ! the range of JMA satellite IDS @@ -377,6 +396,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=250 endif endif + else if(trim(subset) == 'NC005047' .or. trim(subset) == 'NC005048' .or.& trim(subset) == 'NC005049') then ! read new Him-8 BURF if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then ! the range of JMA satellite IDS @@ -390,6 +410,25 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=250 endif endif + + else if(trim(subset) == 'NC005001' .or. trim(subset) == 'NC005002' .or. & + trim(subset) == 'NC005003' ) then + if( hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then ! the range of NESDIS satellite IDS + if(hdrdat(9) == one) then ! IR winds + if(hdrdat(12) <50000000000000.0_r_kind) then + itype=245 + else + itype=240 ! short wave IR winds + endif + else if(hdrdat(9) == two ) then ! visible winds + itype=251 + else if(hdrdat(9) == three ) then ! WV cloud top + itype=246 + else if(hdrdat(9) >= four ) then ! WV deep layer,monitored + itype=247 + endif + endif + else if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or. & trim(subset) == 'NC005012' ) then if( hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then ! the range of NESDIS satellite IDS @@ -407,6 +446,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis itype=247 endif endif + else if(trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071' ) then if( hdrdat(1) >=r700 .and. hdrdat(1) <= r799 ) then ! the range of NASA Terra and Aqua satellite IDs if(hdrdat(9) == one) then ! IR winds @@ -434,6 +474,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis write(6,*) 'READ_SATWND: wrong derived method value' endif endif + else if( trim(subset) == 'NC005019') then ! GOES shortwave winds if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then ! The range of NESDIS satellite IDS if(hdrdat(9) == one) then ! short wave IR winds @@ -546,6 +587,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis enddo msg_report + allocate(cdata_all(nreal,maxobs),isort(maxobs),rusage(maxobs)) isort = 0 cdata_all=zero @@ -557,10 +599,9 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ilat=3 rusage=101.0_r_kind -! Open, then read date from bufr data -!! read satellite winds one type a time - loop_convinfo: do nx=1,ntread + + ! set parameters for processing the next satwind type use_all = .true. use_all_tm = .true. ithin=0 @@ -602,8 +643,8 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis endif endif + ! Open and read the file once for each satwnd type call closbf(lunin) - close(lunin) open(lunin,file=trim(infile),form='unformatted') call openbf(lunin,'IN',lunin) call datelen(10) @@ -626,7 +667,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis derdwdat=bmiss qcdat=bmiss iobsub=0 - itype=-1 uob=bmiss vob=bmiss ppb=bmiss @@ -637,8 +677,9 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis ee=r110 qifn=r110 qify=r110 + qm=2 -! Test for BUFR version using lat/lon mnemonics + ! test for BUFR version using lat/lon mnemonics call ufbint(lunin,hdrdat_test,2,1,iret, 'CLAT CLON') if ( hdrdat_test(1) > 100000000.0_r_kind .and. hdrdat_test(2) > 100000000.0_r_kind ) then call ufbint(lunin,hdrdat,13,1,iret,hdrtr_v2) @@ -648,18 +689,19 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis call ufbint(lunin,obsdat,4,1,iret,obstr_v1) endif + ! reject data with missing pressure or wind ppb=obsdat(2) - if (ppb > 100000000.0_r_kind .or. & - hdrdat(3) >100000000.0_r_kind .or. & - obsdat(4) > 100000000.0_r_kind) cycle loop_readsb - if(ppb >r10000) ppb=ppb/r100 + if(ppb>rmiss .or. hdrdat(3)>rmiss .or. obsdat(4)>rmiss) cycle loop_readsb + if(ppb>r10000) ppb=ppb/r100 ! ppb<10000 may indicate data reported in daPa or hPa + + ! reject date above 125mb (or 850 for regional) if (ppb r90 ) cycle loop_readsb if( hdrdat(3) =240.and.itype<=279) icnt(itype)=icnt(itype)+1 + + ! test for QCSTR or MANDATORY QC - if not skip over the extra blocks + call ufbrep(lunin,qcdat,3,12,qcret,qcstr) + do_qc = subset(1:7)=='NC00503'.and.nint(hdrdat(1))>=270 + do_qc = do_qc.or.subset(1:7)=='NC00501' + do_qc = do_qc.or.subset=='NC005081'.or.subset=='NC005091' + do_qc = do_qc.or.qcret>0 + + ! assign types and get quality info: start + + if(.not.do_qc) then + continue + else if(trim(subset) == 'NC005064' .or. trim(subset) == 'NC005065' .or. & trim(subset) == 'NC005066') then if( hdrdat(1) = r50) then ! the range of EUMETSAT satellite IDs c_prvstg='EUMETSAT' @@ -1034,7 +1090,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis endif ! get quality information THIS SECTION NEEDS TO BE TESTED!!! call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}') - irep_array = int(rep_array) + irep_array = max(1,int(rep_array)) allocate( amvivr(2,irep_array)) call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD') pct1 = amvivr(2,1) ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova @@ -1238,10 +1294,10 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis cycle loop_readsb endif - if ( itype == -1 ) cycle loop_readsb ! unassigned itype - ! assign types and get quality info : end + if ( itype == -1 ) cycle loop_readsb ! unassigned itype + if ( qify == zero) qify=r110 if ( qifn == zero) qifn=r110 if ( ee == zero) ee=r110 @@ -1590,6 +1646,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis cdata_all(28,iout)=ran01dom()*perturb_fact ! v perturbation endif + enddo loop_readsb ! End of bufr read loop enddo loop_msg @@ -1609,7 +1666,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis deallocate(lmsg,tab,nrep) ! Close unit to bufr file call closbf(lunin) - ! Write header record and data to output file for further processing allocate(iloc(ndata)) diff --git a/src/gsi/read_ssmi.f90 b/src/gsi/read_ssmi.f90 index 3e47ee79b5..cece78ac03 100755 --- a/src/gsi/read_ssmi.f90 +++ b/src/gsi/read_ssmi.f90 @@ -132,7 +132,8 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& real(r_kind),parameter:: tbmin=70.0_r_kind real(r_kind),parameter:: tbmax=320.0_r_kind character(80),parameter:: hdr1b='SAID YEAR MNTH DAYS HOUR MINU SECO ORBN' !use for ufbint() - character(40),parameter:: str1='CLAT CLON SFTG POSN SAZA' !use for ufbint() + character(40),parameter:: str1='CLATH CLONH SFTG POSN SAZA' !use for ufbint() new + character(40),parameter:: strx='CLAT CLON SFTG POSN SAZA' !use for ufbint() old character(40),parameter:: str2='TMBR' !use for ufbrep() ! Declare local variables @@ -302,6 +303,7 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& ! SSM/I data are stored in groups of nscan, hence the loop. call ufbint(lnbufr,midat,nloc,nscan,iret,str1) + if(midat(1,1)>10e8) call ufbint(lnbufr,midat,nloc,nscan,iret,strx) !--- Extract brightness temperature data. Apply gross check to data. @@ -309,7 +311,6 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& call ufbrep(lnbufr,mirad,1,nchanl*nscan,iret,str2) - ij=0 scan_loop: do js=1,nscan @@ -511,7 +512,6 @@ subroutine read_ssmi(mype,val_ssmi,ithin,rmesh,jsatid,gstime,& end do read_loop end do read_subset call closbf(lnbufr) - close(lnbufr) ! If multiple tasks read input bufr file, allow each tasks to write out ! information it retained and then let single task merge files together diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90 index 24381df447..2008f37559 100644 --- a/src/gsi/setupoz.f90 +++ b/src/gsi/setupoz.f90 @@ -83,6 +83,9 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& ! 2017-02-09 guo - Remove m_alloc, n_alloc. ! . Remove my_node with corrected typecast(). ! 2017-10-27 todling - revised netcdf output for lay case; obs-sens needs attention +! 2020-02-26 todling - reset obsbin from hr to min +! 2022-08-10 karpowicz - fixes to ncdiag air_pressure_levels, change mass output to +! ppmv/mole fraction, fix ompsnm scan positoin and solar zenith angle. ! ! input argument list: ! lunin - unit from which to read observations @@ -110,10 +113,10 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use mpeu_util, only: die,perr,getindex use kinds, only: r_kind,r_single,i_kind - use state_vectors, only: svars3d, levels + use state_vectors, only: svars3d, levels, nsdim use constants, only : zero,half,one,two,tiny_r_kind - use constants, only : rozcon,cg_term,wgtlim,h300,r10 + use constants, only : constoz,rozcon,cg_term,wgtlim,h300,r10,r100,r1000 use m_obsdiagNode, only : obs_diag use m_obsdiagNode, only : obs_diags @@ -131,6 +134,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use m_obsLList, only : obsLList use obsmod, only : nloz_omi use obsmod, only : luse_obsdiag +! use obsmod, only : wrtgeovals use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & @@ -155,8 +159,8 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& implicit none ! !INPUT PARAMETERS: - type(obsLList ),target,dimension(:),intent(in):: obsLL - type(obs_diags),target,dimension(:),intent(in):: odiagLL + type(obsLList ),target,dimension(:),intent(inout):: obsLL + type(obs_diags),target,dimension(:),intent(inout):: odiagLL integer(i_kind) , intent(in ) :: lunin ! unit from which to read observations integer(i_kind) , intent(in ) :: mype ! mpi task id @@ -191,9 +195,9 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& ! Declare local variables - real(r_kind) omg,rat_err2,dlat,dtime,dlon,rat_err4diag + real(r_kind) omg,rat_err2,dlat,dtime,dlon real(r_kind) cg_oz,wgross,wnotgross,wgt,arg,exp_arg,term - real(r_kind) psi,errorinv + real(r_kind) psi,errorinv,rat_err4diag real(r_kind),dimension(nlevs):: ozges,varinv3,ozone_inv,ozobs,varinv4diag real(r_kind),dimension(nlevs):: ratio_errors,error real(r_kind),dimension(nlevs-1):: ozp @@ -201,6 +205,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& real(r_kind),dimension(nlevs):: pobs,gross,tnoise real(r_kind),dimension(nreal+nlevs,nobs):: data real(r_kind),dimension(nsig+1)::prsitmp + real(r_kind),dimension(nsig)::ozgestmp real(r_single),dimension(nlevs):: pob4,grs4,err4 real(r_single),dimension(ireal,nobs):: diagbuf real(r_single),allocatable,dimension(:,:,:)::rdiagbuf @@ -212,9 +217,10 @@ 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) k,j,nz,jc,idia,irdim1,istatus,ioff0 + integer(i_kind) k1,k2,k,j,nz,jc,idia,irdim1,istatus,ioff0,ioff1 integer(i_kind) ioff,itoss,ikeep,ierror_toq,ierror_poq integer(i_kind) isolz,ifovn,itoqf integer(i_kind) mm1,itime,ilat,ilon,ilate,ilone,itoq,ipoq @@ -280,7 +286,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& iouse(jc)=iuse_oz(j) tnoise(jc)=error_oz(j) gross(jc)=min(r10*gross_oz(j),h300) - if (obstype == 'sbuv2' .or. obstype == 'ompsnp') then + if (obstype == 'sbuv2' .or. obstype == 'ompsnp' .or. obstype == 'ompsnpnc') then pobs(jc)=pob_oz(j) * 1.01325_r_kind else pobs(jc)=pob_oz(j) @@ -319,6 +325,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& irdim1=7 ioff0=irdim1 if(lobsdiagsave) irdim1=irdim1+4*miter+1 + ioff1=irdim1 if (save_jacobian) then nnz = nsig ! number of non-zero elements in dH(x)/dx profile nind = 1 @@ -363,7 +370,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& dlon=data(ilon,i) dtime=data(itime,i) - if (obstype == 'sbuv2' .or. obstype == 'ompsnp') then + if (obstype == 'sbuv2' .or. obstype == 'ompsnp' .or. obstype == 'ompsnpnc') then if (nobskeep>0) then ! write(6,*)'setupozlay: nobskeep',nobskeep call stop2(259) @@ -388,7 +395,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& enddo end if - if (obstype == 'omieff' .or. obstype == 'tomseff') then + if (obstype == 'omieff' .or. obstype == 'tomseff' .or. obstype == 'ompsnmeff') then pob_oz_omi(nloz_omi) = 1000.0_r_kind* 1.01325_r_kind do j=nloz_omi-1, 1, -1 pob_oz_omi(j) = pob_oz_omi(j+1)/2.0 @@ -410,7 +417,16 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& call grdcrd1(ozp_omi(nloz_omi),prsitmp,nsig+1,-1) end if - if (obstype /= 'omieff' .and. obstype /= 'tomseff') then + call tintrp2a1(ges_oz,ozgestmp,dlat,dlon,dtime,hrdifsig,& + nsig,mype,nfldsig) + + ! need call to get pressures for pressure level output in ncdiags + call tintrp2a1(ges_prsi,prsitmp,dlat,dlon,dtime,hrdifsig,& + nsig+1,mype,nfldsig) + + + if (obstype /= 'omieff' .and. obstype /= 'tomseff' .and. & + obstype /= 'ompsnmeff' ) then call intrp3oz1(ges_oz,ozges,dlat,dlon,ozp,dtime,& nlevs,mype,doz_dz) endif @@ -441,7 +457,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& ! For OMI/GOME, nlev=1 do k=1,nlev j=ipos(k) - if (obstype == 'omieff' .or. obstype == 'tomseff' ) then + if (obstype == 'omieff' .or. obstype == 'tomseff' .or. obstype == 'ompsnmeff') then ioff=ifovn+1 ! else ioff=nreal+k ! SBUV and OMI w/o efficiency factors @@ -449,7 +465,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& ! Compute innovation and load obs error into local array ! KW OMI and TOMS have averaging kernels - if (obstype == 'omieff' .or. obstype == 'tomseff' ) then + if (obstype == 'omieff' .or. obstype == 'tomseff' .or. obstype == 'ompsnmeff') then ! everything in data is from top to bottom nlayers = nloz_omi + 1 apriori(1:nloz_omi) = data(ioff:ioff+nloz_omi -1, i) @@ -542,7 +558,8 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& rdiagbuf(3,k,ii) = errorinv ! inverse observation error if (obstype == 'gome' .or. obstype == 'omieff' .or. & obstype == 'omi' .or. obstype == 'tomseff' .or. & - obstype == 'ompstc8') then + obstype == 'ompsnmeff' .or. obstype == 'ompstc8' .or. & + obstype == 'ompsnm') then rdiagbuf(4,k,ii) = data(isolz,i) ! solar zenith angle rdiagbuf(5,k,ii) = data(ifovn,i) ! field of view number else @@ -556,7 +573,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& endif rdiagbuf(7,k,ii) = 1.e+10_r_single ! spread (filled in by EnKF) - idia = ioff0 + idia = ioff1 if (save_jacobian) then oz_ind = getindex(svars3d, 'oz') if (oz_ind < 0) then @@ -574,18 +591,39 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& endif if (netcdf_diag) then + k1 = k + k2 = k - 1 + if(k2 == 0)k2 = 1 + if(k == nlevs)then + k1=nlevs-1 + k2=1 + endif + if (obstype == 'sbuv2' .or. obstype == 'ompsnp' .or. obstype == 'ompsnpnc' ) then + call nc_diag_metadata("TopLevelPressure",sngl(pobs(k2)*r100)) + call nc_diag_metadata("BottomLevelPressure", & + sngl(pobs(k1)*r100)) + else + call & + nc_diag_metadata("TopLevelPressure",sngl(prsitmp(nsig+1)*r1000) ) + call nc_diag_metadata("BottomLevelPressure", & + sngl(prsitmp(1)*r1000) ) + endif call nc_diag_metadata("MPI_Task_Number", mype ) call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) call nc_diag_metadata("Time", sngl(data(itime,i)-time_offset) ) - call nc_diag_metadata("Reference_Pressure", sngl(pobs(k)) ) + call nc_diag_metadata("Reference_Pressure",sngl(pobs(k)*r100) ) call nc_diag_metadata("Analysis_Use_Flag", iouse(k) ) call nc_diag_metadata("Observation", sngl(ozobs(k))) call nc_diag_metadata("Inverse_Observation_Error", sngl(errorinv)) + call nc_diag_metadata("Input_Observation_Error", sngl(error(k))) call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv(k))) call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv(k))) + call nc_diag_metadata("Forecast_unadjusted", sngl(ozges(k))) + call nc_diag_metadata("Forecast_adjusted",sngl(ozges(k))) if (obstype == 'gome' .or. obstype == 'omieff' .or. & - obstype == 'omi' .or. obstype == 'tomseff' ) then + obstype == 'omi' .or. obstype == 'tomseff' .or. & + obstype == 'ompsnmeff' .or. obstype == 'ompsnm') then call nc_diag_metadata("Solar_Zenith_Angle", sngl(data(isolz,i)) ) call nc_diag_metadata("Scan_Position", sngl(data(ifovn,i)) ) else @@ -598,10 +636,13 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& call nc_diag_metadata("Row_Anomaly_Index", sngl(rmiss) ) endif if (save_jacobian) then - call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) - call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) - call nc_diag_data2d("Observation_Operator_Jacobian_val", real(dhx_dx%val,r_single)) + call fullarray(dhx_dx, dhx_dx_array) + call nc_diag_data2d("Observation_Operator_Jacobian", dhx_dx_array) endif + !if (wrtgeovals) then + ! call nc_diag_data2d("mole_fraction_of_ozone_in_air", sngl(constoz*ozgestmp)) + ! call nc_diag_data2d("air_pressure_levels",sngl(prsitmp*r1000)) + !endif endif endif @@ -642,7 +683,8 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& my_head%elon= data(ilone,i) nlevp=max(nlev-1,1) - if (obstype == 'omieff' .or. obstype == 'tomseff' ) nlevp = nloz_omi + if (obstype == 'omieff' .or. obstype == 'tomseff' .or. & + obstype == 'ompsnmeff') nlevp = nloz_omi allocate(my_head%res(nlev), & my_head%err2(nlev), & my_head%raterr2(nlev), & @@ -679,11 +721,12 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& my_head%luse=luse(i) my_head%time=dtime - if (obstype == 'sbuv2'.or. obstype == 'ompsnp' ) then + if (obstype == 'sbuv2' .or. obstype == 'ompsnp' .or. obstype == 'ompsnpnc') then do k=1,nlevs-1 my_head%prs(k) = ozp(k) enddo - else if (obstype == 'omieff' .or. obstype == 'tomseff') then + else if (obstype == 'omieff' .or. obstype == 'tomseff' .or. & + obstype == 'ompsnmeff') then do k=1,nloz_omi my_head%prs(k) = ozp_omi(k) enddo @@ -742,7 +785,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& if (ozone_diagsave.and.lobsdiagsave.and.luse(i)) then associate(odiag => my_diag) - idia=6 + idia=ioff0 do jj=1,miter idia=idia+1 if (odiag%muse(jj)) then @@ -785,7 +828,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& if(in_curbin) then if (ozone_diagsave.and.lobsdiagsave.and.luse(i)) then - rdiagbuf(7:irdim1,1:nlevs,ii) = zero + rdiagbuf(ioff0+1:irdim1,1:nlevs,ii) = zero endif endif ! (in_curbin) @@ -932,6 +975,7 @@ subroutine init_netcdf_diag_ call nc_diag_header("Satellite_Sensor", isis) call nc_diag_header("Satellite", dplat(is)) call nc_diag_header("Observation_type", obstype) + call nc_diag_header("Number_of_state_vars", nsdim ) call nc_diag_header("pobs", pobs) call nc_diag_header("gross",gross) call nc_diag_header("tnoise",tnoise) @@ -995,7 +1039,9 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& ! 2016-12-09 mccarty - add netcdf_diag capability ! 2017-02-09 guo - Remove m_alloc, n_alloc. ! . Remove my_node with corrected typecast(). -! +! 2020-02-26 todling - reset obsbin from hr to min +! 2022-08-10 karpowicz/todling - replace ncdiag analysis use flag with +/-1 instead of zero +! ! input argument list: ! lunin - unit from which to read observations ! mype - mpi task id @@ -1036,6 +1082,7 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use obsmod, only : mype_diaghdr,dirname,time_offset,ianldate use obsmod, only : lobsdiag_allocated,lobsdiagsave,lobsdiag_forenkf use obsmod, only: netcdf_diag, binary_diag, dirname +! use obsmod, only: wrtgeovals use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & nc_diag_write, nc_diag_data2d use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close @@ -1048,7 +1095,7 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use guess_grids, only : nfldsig,ges_lnprsl,hrdifsig use constants, only : zero,half,one,two,tiny_r_kind,four - use constants, only : cg_term,wgtlim,r10,constoz + use constants, only : cg_term,wgtlim,r10,r100,r1000,constoz use gsi_4dvar, only: nobs_bins,hr_obsbin @@ -1066,8 +1113,8 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& implicit none ! !INPUT PARAMETERS: - type(obsLList ),target,dimension(:),intent(in):: obsLL - type(obs_diags),target,dimension(:),intent(in):: odiagLL + type(obsLList ),target,dimension(:),intent(inout):: obsLL + type(obs_diags),target,dimension(:),intent(inout):: odiagLL integer(i_kind) , intent(in ) :: lunin ! unit from which to read observations integer(i_kind) , intent(in ) :: mype ! mpi task id @@ -1106,26 +1153,30 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& real(r_kind) o3ges, o3ppmv real(r_kind) rlow,rhgh,sfcchk - real(r_kind) omg,rat_err2,dlat,dtime,dlon,rat_err4diag + real(r_kind) omg,rat_err2,dlat,dtime,dlon real(r_kind) cg_oz,wgross,wnotgross,wgt,arg,exp_arg,term real(r_kind) errorinv - real(r_kind) psges,ozlv,airnd,uvnd,visnd + real(r_kind) psges,ozlv, airnd, uvnd, visnd - real(r_kind) varinv3,ratio_errors,varinv4diag + real(r_kind) varinv3,ratio_errors + real(r_kind) varinv4diag,rat_err4diag real(r_kind) dpres,obserror,ozone_inv,preso3l real(r_kind),dimension(nreal+nlevs,nobs):: data 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 - integer(i_kind) k,j,idia,irdim1,ioff0 + integer(i_kind) k1,k2,k,j,idia,irdim1,ioff0,ioff1 integer(i_kind) isolz,iuse integer(i_kind) mm1,itime,ilat,ilon,ilate,ilone,iozmr,ilev,ipres,iprcs,imls_levs + integer(i_kind) iairnd, iuvnd, ivisnd integer(i_kind),dimension(iint,nobs):: idiagbuf - integer(i_kind) iairnd,iuvnd,ivisnd real(r_kind) gross,tnoise,pobs + character(12) string character(10) filex character(128) diag_ozone_file @@ -1178,6 +1229,7 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& irdim1=10 ioff0 = irdim1 if(lobsdiagsave) irdim1=irdim1+4*miter+1 + ioff1 = irdim1 if (save_jacobian) then nnz = 2 ! number of non-zero elements in dH(x)/dx profile nind = 1 @@ -1315,6 +1367,9 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& obserror=1.0e6_r_kind end if + call tintrp2a1(ges_oz,ozgestmp,dlat,dlon,dtime,hrdifsig,& + nsig,mype,nfldsig) + ! Interpolate guess ozone to observation location and time call tintrp31(ges_oz,o3ges,dlat,dlon,dpres,dtime, & hrdifsig,mype,nfldsig) @@ -1627,7 +1682,7 @@ subroutine contents_binary_diag_(odiag) rdiagbuf(10,1,ii) = visnd ! log10 ozone number density vis if (lobsdiagsave) then - idia=6 + idia=ioff0 do jj=1,miter idia=idia+1 if (odiag%muse(jj)) then @@ -1649,6 +1704,7 @@ subroutine contents_binary_diag_(odiag) rdiagbuf(idia,1,ii) = odiag%obssen(jj) enddo endif + idia = ioff1 if (save_jacobian) then call writearray(dhx_dx, rdiagbuf(idia+1:irdim1,1,ii)) idia = idia + size(dhx_dx) @@ -1668,19 +1724,33 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation", sngl(ozlv) ) call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv) ) call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv) ) - call nc_diag_metadata("Reference_Pressure", sngl(preso3l) ) + call nc_diag_metadata("Reference_Pressure", sngl(preso3l*r100) ) ! Pa + if(luse(i)) then + call nc_diag_metadata("Analysis_Use_Flag", one ) + else + call nc_diag_metadata("Analysis_Use_Flag", -one ) + endif call nc_diag_metadata("Input_Observation_Error", sngl(obserror) ) - if(obstype =="omps_lp")then + if(obstype =="ompslp")then call nc_diag_metadata("Log10 Air Number Density", sngl(airnd)) - call nc_diag_metadata("Log10 Ozone Number Density UV", sngl(uvnd)) + call nc_diag_metadata("Log10 Ozone Number Density UV", sngl(uvnd)) call nc_diag_metadata("Log10 Ozone Number Density VIS",sngl(visnd)) endif - - if(luse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", 1 ) - else - call nc_diag_metadata("Analysis_Use_Flag", -1 ) + call nc_diag_metadata("Forecast_adjusted", sngl(o3ppmv)) + call nc_diag_metadata("Forecast_unadjusted", sngl(o3ppmv)) + !if (wrtgeovals) then + ! ozgestmp = ozgestmp *constoz + ! call nc_diag_data2d("mole_fraction_of_ozone_in_air", sngl(ozgestmp)) + ! call nc_diag_data2d("air_pressure",sngl(exp(prsltmp)*r1000)) ! Pa + !endif + k1 = k + k2 = k - 1 + if(k2 == 0)k2 = 1 + if(k == nlevs)then + k1=nlevs-1 + k2=1 endif + if (save_jacobian) then call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) From be4a3d91c92731d3611c46737ca695ce05cb9527 Mon Sep 17 00:00:00 2001 From: jderber-NOAA <75998838+jderber-NOAA@users.noreply.github.com> Date: Fri, 1 Sep 2023 12:34:05 -0400 Subject: [PATCH 2/6] Error in processing VAD winds. (#617) --- src/gsi/constants.f90 | 2 + src/gsi/gsi_rfv3io_mod.f90 | 16 ++-- src/gsi/read_prepbufr.f90 | 158 +++++++++++++++++++------------------ src/gsi/setupw.f90 | 6 -- 4 files changed, 91 insertions(+), 91 deletions(-) diff --git a/src/gsi/constants.f90 b/src/gsi/constants.f90 index b4cf775068..291a18ec97 100644 --- a/src/gsi/constants.f90 +++ b/src/gsi/constants.f90 @@ -74,6 +74,7 @@ module constants public :: psv_a, psv_b, psv_c, psv_d public :: ef_alpha, ef_beta, ef_gamma public :: max_varname_length + public :: max_filename_length public :: z_w_max,tfrozen public :: qmin,qcmin,tgmin public :: i_missing, r_missing @@ -91,6 +92,7 @@ module constants ! Declare derived constants integer(i_kind):: huge_i_kind integer(i_kind), parameter :: max_varname_length=20 + integer(i_kind), parameter :: max_filename_length=80 real(r_single):: tiny_single, huge_single real(r_kind):: xai, xa, xbi, xb, dldt, rozcon,ozcon,fv, tpwcon,eps, rd_over_g real(r_kind):: el2orc, g_over_rd, rd_over_cp, cpr, omeps, epsm1, factor2 diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index 4fcb2aba1d..05f679cb60 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -48,7 +48,7 @@ module gsi_rfv3io_mod use kinds, only: r_kind,i_kind use gridmod, only: nlon_regional,nlat_regional - use constants, only:max_varname_length + use constants, only:max_varname_length,max_filename_length use gsi_bundlemod, only : gsi_bundle use general_sub2grid_mod, only: sub2grid_info use gridmod, only: fv3_io_layout_y @@ -2207,7 +2207,7 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork character(len=max_varname_length) :: varname,vgsiname character(len=max_varname_length) :: name - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 real(r_kind),allocatable,dimension(:,:):: uu2d_tmp integer(i_kind) :: countloc_tmp(3),startloc_tmp(3) @@ -2381,7 +2381,7 @@ subroutine gsi_fv3ncdf_read_v1(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) type(gsi_bundle),intent(inout) :: cstate_nouv real(r_kind),allocatable,dimension(:,:):: uu2d real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 character(len=max_varname_length) :: varname,vgsiname @@ -2482,7 +2482,7 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) character(:), allocatable:: filenamein real(r_kind),allocatable,dimension(:,:):: u2d,v2d real(r_kind),allocatable,dimension(:,:):: uc2d,vc2d - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 character(len=max_varname_length) :: varname,vgsiname real(r_kind),allocatable,dimension(:,:,:,:):: worksub integer(i_kind) u_grd_VarId,v_grd_VarId @@ -2658,7 +2658,7 @@ subroutine gsi_fv3ncdf_readuv_v1(grd_uv,ges_u,ges_v,fv3filenamegin) real(r_kind),allocatable,dimension(:,:):: us2d,vw2d real(r_kind),allocatable,dimension(:,:):: uorv2d real(r_kind),allocatable,dimension(:,:,:,:):: worksub - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 character(len=max_varname_length) :: varname integer(i_kind) nlatcase,nloncase integer(i_kind) kbgn,kend @@ -2778,7 +2778,7 @@ subroutine gsi_fv3ncdf_read_ens_parallel_over_ens(filenamein,fv3filenamegin, & real(r_kind),dimension(nlat,nlon,nsig),intent(out),optional:: delp,tsen,w,q,oz,ql,qr,qs,qi,qg,dbz character(len=max_varname_length) :: varname character(len=max_varname_length) :: name - character(len=max_varname_length), allocatable,dimension(:) :: varname_files + character(len=max_filename_length), allocatable,dimension(:) :: varname_files integer(i_kind) nlatcase,nloncase,nxcase,nycase,countloc(3),startloc(3),countloc_tmp(3),startloc_tmp(3) integer(i_kind) ilev,ilevtot,inative,ivar @@ -4097,7 +4097,7 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file character(len=:), allocatable, intent(in) :: filenamein type (type_fv3regfilenameg),intent (in) :: fv3filenamegin real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 character(len=max_varname_length) :: varname,vgsiname,name integer(i_kind) nlatcase,nloncase,nxcase,nycase,countloc(3),startloc(3) @@ -4321,7 +4321,7 @@ subroutine gsi_fv3ncdf_write_v1(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3f character(*),intent(in):: filenamein type (type_fv3regfilenameg),intent (in) :: fv3filenamegin real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork - character(len=max_varname_length) :: filenamein2 + character(len=max_filename_length) :: filenamein2 integer(i_kind) kbgn,kend integer(i_kind) inative,ilev,ilevtot diff --git a/src/gsi/read_prepbufr.f90 b/src/gsi/read_prepbufr.f90 index 355441e209..2bf3a7d05d 100644 --- a/src/gsi/read_prepbufr.f90 +++ b/src/gsi/read_prepbufr.f90 @@ -2003,6 +2003,85 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! don't use MESONET psfc obs if 8th character of station id is "x") if( kx==188 .and. psob .and. sidchr(8)=='x' ) usage=r100 +! Set inflate_error logical based on qm flag + inflate_error=.false. + if (qm==3 .or. qm==7) inflate_error=.true. + + if(uvob) then + selev=stnelev + oelev=obsdat(4,k) + if(kx >= 280 .and. kx < 300 )then + if (twodvar_regional.and.(kx==288.or.kx==295)) then + oelev=windsensht+selev !windsensht: read in from prepbufr + else + oelev=r10+selev + endif + if (kx == 280 )then + it29=nint(hdr(8)) + if(it29 == 522 .or. it29 == 523 .or. it29 == 531)then +! oelev=r20+selev + oelev=r20 + end if + end if + + if (kx == 282) oelev=r20+selev + if (kx == 285 .or. kx == 289 .or. kx == 290) then + oelev=selev + selev=zero + endif + else + if((kx >= 221 .and. kx <= 229) & + .and. selev >= oelev) oelev=r10+selev + end if + +! Rotate winds to rotated coordinate + uob=obsdat(5,k) + vob=obsdat(6,k) + !* thin new VAD wind and generate VAD superob + if(kx==224.and.newvad)then + klev=k+5 !*average over 6 points + ! klev=k !* no average + if(klev>levs) cycle loop_readsb + diffuu=obsdat(5,k)-fcstdat(1,k) + diffvv=obsdat(6,k)-fcstdat(2,k) + if(sqrt(diffuu**2+diffvv**2)>10.0_r_kind) cycle loop_k_levs + if(abs(diffvv)>8.0_r_kind) cycle loop_k_levs + !if(abs(diffvv)>5.0.and.oelev<5000.0.and.fcstdat(3,k)>276.3) cycle loop_k_levs + if(oelev>7000.0_r_kind) cycle loop_k_levs + if(abs(diffvv)>5.0_r_kind.and.oelev<5000.0_r_kind) cycle loop_k_levs + ! write(6,*)'sliu diffuu,vv::',diffuu, diffvv + uob=0.0 + vob=0.0 + oelev=0.0 + tkk=0 + do ikkk=k,klev + diffhgt=obsdat(4,ikkk)-obsdat(4,k) + if(diffhgt<301.0_r_kind)then + uob=uob+obsdat(5,ikkk) + vob=vob+obsdat(6,ikkk) + oelev=oelev+obsdat(4,ikkk) + tkk=tkk+1 + end if + end do + uob=uob/tkk + vob=vob/tkk + oelev=oelev/tkk + + diffuu=5.0_r_kind;diffvv=5.0_r_kind + diffhgt=0.0_r_kind + do ikkk=k,klev + diffuu=abs(obsdat(5,ikkk)-uob) + if(diffhgt5.0_r_kind)cycle LOOP_K_LEVS !* if u-u_avg>5.0, reject + if(tkk<3) cycle LOOP_K_LEVS !* obs numb<3, reject + !* unreasonable observation, will fix this in QC package + if(sqrt(uob**2+vob**2)>60.0_r_kind)cycle LOOP_readsb + end if + end if ! Get information from surface file necessary for conventional data here @@ -2088,9 +2167,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Extract pressure level and quality marks dlnpob=log(plevs(k)) ! ln(pressure in cb) -! Set inflate_error logical based on qm flag - inflate_error=.false. - if (qm==3 .or. qm==7) inflate_error=.true. ! Temperature if(tob) then @@ -2143,6 +2219,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! Winds else if(uvob) then + if (aircraftobs .and. aircraft_t_bc .and. acft_profl_file) then call errormod_aircraft(pqm,wqm,levs,plevs,errout,k,presl,dpres,nsig,lim_qm,hdr3) else @@ -2151,80 +2228,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& woe=obserr(5,k)*errout if (inflate_error) woe=woe*r1_2 if(obsdat(1,k) < r50)woe=woe*r1_2 - selev=stnelev - oelev=obsdat(4,k) - if(kx >= 280 .and. kx < 300 )then - if (twodvar_regional.and.(kx==288.or.kx==295)) then - oelev=windsensht+selev !windsensht: read in from prepbufr - else - oelev=r10+selev - endif - if (kx == 280 )then - it29=nint(hdr(8)) - if(it29 == 522 .or. it29 == 523 .or. it29 == 531)then -! oelev=r20+selev - oelev=r20 - end if - end if - - if (kx == 282) oelev=r20+selev - if (kx == 285 .or. kx == 289 .or. kx == 290) then - oelev=selev - selev=zero - endif - else - if((kx >= 221 .and. kx <= 229) & - .and. selev >= oelev) oelev=r10+selev - end if - -! Rotate winds to rotated coordinate - uob=obsdat(5,k) - vob=obsdat(6,k) - !* thin new VAD wind and generate VAD superob - if(kx==224.and.newvad)then - klev=k+5 !*average over 6 points - ! klev=k !* no average - if(klev>levs) cycle loop_readsb - diffuu=obsdat(5,k)-fcstdat(1,k) - diffvv=obsdat(6,k)-fcstdat(2,k) - if(sqrt(diffuu**2+diffvv**2)>10.0_r_kind) cycle loop_k_levs - if(abs(diffvv)>8.0_r_kind) cycle loop_k_levs - !if(abs(diffvv)>5.0.and.oelev<5000.0.and.fcstdat(3,k)>276.3) cycle loop_k_levs - if(oelev>7000.0_r_kind) cycle loop_k_levs - if(abs(diffvv)>5.0_r_kind.and.oelev<5000.0_r_kind) cycle loop_k_levs - ! write(6,*)'sliu diffuu,vv::',diffuu, diffvv - uob=0.0 - vob=0.0 - oelev=0.0 - tkk=0 - do ikkk=k,klev - diffhgt=obsdat(4,ikkk)-obsdat(4,k) - if(diffhgt<301.0_r_kind)then - uob=uob+obsdat(5,ikkk) - vob=vob+obsdat(6,ikkk) - oelev=oelev+obsdat(4,ikkk) - tkk=tkk+1 - end if - end do - uob=uob/tkk - vob=vob/tkk - oelev=oelev/tkk - - diffuu=5.0_r_kind;diffvv=5.0_r_kind - diffhgt=0.0_r_kind - do ikkk=k,klev - diffuu=abs(obsdat(5,ikkk)-uob) - if(diffhgt5.0_r_kind)cycle LOOP_K_LEVS !* if u-u_avg>5.0, reject - if(tkk<3) cycle LOOP_K_LEVS !* obs numb<3, reject - !* unreasonable observation, will fix this in QC package - if(sqrt(uob**2+vob**2)>60.0_r_kind)cycle LOOP_readsb - end if - if(regional .and. .not. fv3_regional)then u0=uob v0=vob @@ -2237,6 +2240,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if endif + cdata_all(1,iout)=woe ! wind error cdata_all(2,iout)=dlon ! grid relative longitude cdata_all(3,iout)=dlat ! grid relative latitude diff --git a/src/gsi/setupw.f90 b/src/gsi/setupw.f90 index 62b58a0485..97ed1f8883 100644 --- a/src/gsi/setupw.f90 +++ b/src/gsi/setupw.f90 @@ -419,14 +419,8 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav if (netcdf_diag) call init_netcdf_diag_ end if - num_bad_ikx=0 do i=1,nobs muse(i)=nint(data(iuse,i)) <= jiter - ikx=nint(data(ikxx,i)) - if(ikx < 1 .or. ikx > nconvtype) then - num_bad_ikx=num_bad_ikx+1 - if(num_bad_ikx<=10) write(6,*)' in setupw ',ikx,i,nconvtype,mype - end if end do ! If HD raobs available move prepbufr version to monitor if(nhduv > 0)then From d7ac706d9f307f8ddfb09c7cc908f6be614b0fae Mon Sep 17 00:00:00 2001 From: daviddowellNOAA <72174157+daviddowellNOAA@users.noreply.github.com> Date: Fri, 8 Sep 2023 10:36:03 -0500 Subject: [PATCH 3/6] Gsi fed (#590) **Description** Initialization of the operational RRFSv1 will include assimilation of flash-extent density (FED) observations from the GOES Geostationary Lightning Mapper (GLM). The current PR is the first of at least 3 that will be needed to introduce the capability of FED assimilation into the code and regional workflow. The new capabilities that are added to GSI are: * reading NetCDF FED observations * applying an observation operator that maps the model state to FED. Much of the code was originally developed by Rong Kong at OU-CAPS (Kong et al. 2020, Wang et al. 2021, Kong et al. 2022; https://doi.org/10.1175/MWR-D-19-0192.1, https://doi.org/10.1175/MWR-D-20-0406.1, https://doi.org/10.1175/MWR-D-21-0326.1). Recently, the observation operator has been modified by Amanda Back and Ashley Sebok based on tests with regional, convection-allowing FV3 forecasts. The new observation operator includes a cap of 8 flashes / minute for both the observed and simulated FED. The observation operator is specific to the 3-km regional FV3 application in RRFS. Development of a more general observation operator is left to future work. Fixes #588 **Type of change** Please delete options that are not relevant. - [ ] Bug fix (non-breaking change which fixes an issue) - [X] New feature (non-breaking change which adds functionality) - [ ] Breaking change (fix or feature that would cause existing functionality to not work as expected) - [ ] This change requires a documentation update **How Has This Been Tested?** Initial tests were with NOAA-EMC GSI-EnKF code obtained in April 2023 and modified to include the assimilation of FED observations. A prototype of RRFSv1 was cycled hourly for 2.5 days, and the EnKF assimilation included FED data assimilation. For the current PR, only the GSI observer with FED (and radar reflectivity) observations was tested. It produces identical results to those obtained in April 2023. **Checklist** - [ ] My code follows the style guidelines of this project - [X] I have performed a self-review of my own code - [ ] I have commented my code, particularly in hard-to-understand areas - [ ] New and existing tests pass with my changes - [ ] Any dependent changes have been merged and published **DUE DATE for this PR is 8/24/2023.** If this PR is not merged into `develop` by this date, the PR will be closed and returned to the developer. --------- Co-authored-by: Ming Hu --- src/gsi/gsi_fedOper.F90 | 174 +++++ src/gsi/gsi_files.cmake | 4 + src/gsi/gsi_obOperTypeManager.F90 | 7 + src/gsi/gsimod.F90 | 7 +- src/gsi/intjo.f90 | 4 +- src/gsi/m_fedNode.F90 | 248 +++++++ src/gsi/m_obsNodeTypeManager.F90 | 7 + src/gsi/m_rhs.F90 | 2 + src/gsi/obsmod.F90 | 15 +- src/gsi/read_fed.f90 | 525 ++++++++++++++ src/gsi/read_obs.F90 | 14 +- src/gsi/setupfed.f90 | 1100 +++++++++++++++++++++++++++++ src/gsi/setuprhsall.f90 | 3 +- src/gsi/statsconv.f90 | 72 +- 14 files changed, 2169 insertions(+), 13 deletions(-) create mode 100644 src/gsi/gsi_fedOper.F90 create mode 100644 src/gsi/m_fedNode.F90 create mode 100644 src/gsi/read_fed.f90 create mode 100644 src/gsi/setupfed.f90 diff --git a/src/gsi/gsi_fedOper.F90 b/src/gsi/gsi_fedOper.F90 new file mode 100644 index 0000000000..b2b2400ff0 --- /dev/null +++ b/src/gsi/gsi_fedOper.F90 @@ -0,0 +1,174 @@ +module gsi_fedOper +!$$$ subprogram documentation block +! . . . . +! subprogram: module gsi_fedOper +! +! abstract: an obOper extension for fedNode type +! +! program history log: +! 2023-07-10 D. Dowell - created new module for FED (flash extent +! density); gsi_dbzOper.F90 code used as a +! starting point for developing this new module +! +! input argument list: see Fortran 90 style document below +! +! output argument list: see Fortran 90 style document below +! +! attributes: +! language: Fortran 90 and/or above +! machine: +! +!$$$ end subprogram documentation block + +! module interface: + + use gsi_obOper, only: obOper + use m_fedNode , only: fedNode + implicit none + public:: fedOper ! data structure + public:: diag_fed + + type,extends(obOper):: fedOper + contains + procedure,nopass:: mytype + procedure,nopass:: nodeMold + procedure:: setup_ + procedure:: intjo1_ + procedure:: stpjo1_ + end type fedOper + +! def diag_fed- namelist logical to compute/write (=true) FED diag files + logical,save:: diag_fed=.false. + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + character(len=*),parameter :: myname='gsi_fedOper' + type(fedNode),save,target:: myNodeMold_ + +contains + function mytype(nodetype) + implicit none + character(len=:),allocatable:: mytype + logical,optional, intent(in):: nodetype + mytype="[fedOper]" + if(present(nodetype)) then + if(nodetype) mytype=myNodeMold_%mytype() + endif + end function mytype + + function nodeMold() + !> %nodeMold() returns a mold of its corresponding obsNode + use m_obsNode, only: obsNode + implicit none + class(obsNode),pointer:: nodeMold + nodeMold => myNodeMold_ + end function nodeMold + + subroutine setup_(self, lunin, mype, is, nobs, init_pass, last_pass) + use fed_setup, only: setup + use kinds, only: i_kind + use gsi_obOper, only: len_obstype + use gsi_obOper, only: len_isis + + use m_rhs , only: awork => rhs_awork + use m_rhs , only: bwork => rhs_bwork + use m_rhs , only: iwork => i_fed + + use obsmod , only: write_diag + use jfunc , only: jiter + + use mpeu_util, only: die + + use obsmod, only: dirname, ianldate + + implicit none + class(fedOper ), intent(inout):: self + integer(i_kind), intent(in):: lunin + integer(i_kind), intent(in):: mype + integer(i_kind), intent(in):: is + integer(i_kind), intent(in):: nobs + logical , intent(in):: init_pass ! supporting multi-pass setup() + logical , intent(in):: last_pass ! with incremental backgrounds. + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::setup_" + + character(len=len_obstype):: obstype + character(len=len_isis ):: isis + integer(i_kind):: nreal,nchanl,ier,nele + logical:: diagsave + integer(i_kind):: lu_diag + character(128):: diag_file + character(80):: string + + if(nobs == 0) then + + if( (mype == 0) .and. init_pass ) then + write(string,600) jiter +600 format('fed_',i2.2) + diag_file=trim(dirname) // trim(string) + write(6,*) 'write ianldate to ', diag_file + open(newunit=lu_diag,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + write(lu_diag) ianldate + close(lu_diag) + endif + + return + + endif + + read(lunin,iostat=ier) obstype,isis,nreal,nchanl + if(ier/=0) call die(myname_,'read(obstype,...), iostat =',ier) + nele = nreal+nchanl + + diagsave = write_diag(jiter) .and. diag_fed + + call setup(self%obsLL(:), self%odiagLL(:), & + lunin,mype,bwork,awork(:,iwork),nele,nobs,is,diagsave,init_pass) + + end subroutine setup_ + + subroutine intjo1_(self, ibin, rval,sval, qpred,sbias) + use gsi_bundlemod , only: gsi_bundle + use bias_predictors, only: predictors + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList_headNode + use kinds , only: i_kind, r_quad + implicit none + class(fedOper ),intent(in ):: self + integer(i_kind ),intent(in ):: ibin + type(gsi_bundle),intent(inout):: rval ! (ibin) + type(gsi_bundle),intent(in ):: sval ! (ibin) + real(r_quad ),target,dimension(:),intent(inout):: qpred ! (ibin) + type(predictors),target, intent(in ):: sbias + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::intjo1_" + class(obsNode),pointer:: headNode + + end subroutine intjo1_ + + subroutine stpjo1_(self, ibin, dval,xval,pbcjo,sges,nstep,dbias,xbias) + use gsi_bundlemod, only: gsi_bundle + use bias_predictors, only: predictors + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList_headNode + use kinds, only: r_quad,r_kind,i_kind + implicit none + class(fedOper ),intent(in):: self + integer(i_kind ),intent(in):: ibin + type(gsi_bundle),intent(in):: dval + type(gsi_bundle),intent(in):: xval + real(r_quad ),dimension(:),intent(inout):: pbcjo ! (1:4) + real(r_kind ),dimension(:),intent(in ):: sges + integer(i_kind),intent(in):: nstep + + type(predictors),target, intent(in):: dbias + type(predictors),target, intent(in):: xbias + + !---------------------------------------- + character(len=*),parameter:: myname_=myname//"::stpjo1_" + class(obsNode),pointer:: headNode + + end subroutine stpjo1_ + +end module gsi_fedOper diff --git a/src/gsi/gsi_files.cmake b/src/gsi/gsi_files.cmake index b98cd2d0da..b514e11c1e 100644 --- a/src/gsi/gsi_files.cmake +++ b/src/gsi/gsi_files.cmake @@ -217,6 +217,7 @@ gsi_colvkOper.F90 gsi_dbzOper.F90 gsi_dwOper.F90 gsi_enscouplermod.f90 +gsi_fedOper.F90 gsi_gpsbendOper.F90 gsi_gpsrefOper.F90 gsi_gustOper.F90 @@ -338,6 +339,7 @@ m_distance.f90 m_dtime.F90 m_dwNode.F90 m_extOzone.F90 +m_fedNode.F90 m_find.f90 m_gpsNode.F90 m_gpsrhs.F90 @@ -478,6 +480,7 @@ read_cris.f90 read_dbz_nc.f90 read_dbz_netcdf.f90 read_diag.f90 +read_fed.f90 read_files.f90 read_fl_hdob.f90 read_gfs_ozone_for_regional.f90 @@ -532,6 +535,7 @@ setupco.f90 setupdbz.f90 setupdbz_lib.f90 setupdw.f90 +setupfed.f90 setupgust.f90 setuphowv.f90 setuplag.f90 diff --git a/src/gsi/gsi_obOperTypeManager.F90 b/src/gsi/gsi_obOperTypeManager.F90 index 5df899825a..6db7921905 100644 --- a/src/gsi/gsi_obOperTypeManager.F90 +++ b/src/gsi/gsi_obOperTypeManager.F90 @@ -66,6 +66,7 @@ module gsi_obOperTypeManager use gsi_lightOper , only: lightOper use gsi_dbzOper , only: dbzOper + use gsi_fedOper , only: fedOper use gsi_cldtotOper , only: cldtotOper use kinds , only: i_kind @@ -136,6 +137,7 @@ module gsi_obOperTypeManager public:: iobOper_lwcp public:: iobOper_light public:: iobOper_dbz + public:: iobOper_fed public:: iobOper_cldtot enum, bind(C) @@ -181,6 +183,7 @@ module gsi_obOperTypeManager enumerator:: iobOper_lwcp enumerator:: iobOper_light enumerator:: iobOper_dbz + enumerator:: iobOper_fed enumerator:: iobOper_cldtot enumerator:: iobOper_extra_ @@ -242,6 +245,7 @@ module gsi_obOperTypeManager type( lwcpOper), target, save:: lwcpOper_mold type( lightOper), target, save:: lightOper_mold type( dbzOper), target, save:: dbzOper_mold + type( fedOper), target, save:: fedOper_mold type( cldtotOper), target, save:: cldtotOper_mold contains @@ -390,6 +394,7 @@ function dtype2index_(dtype) result(index_) case("goes_glm" ); index_= iobOper_light case("dbz" ,"[dbzoper]" ); index_= iobOper_dbz + case("fed" ,"[fedoper]" ); index_= iobOper_fed case("cldtot" ,"[cldtotoper]" ); index_= iobOper_cldtot case("mta_cld" ); index_= iobOper_cldtot @@ -487,6 +492,7 @@ function index2vmold_(iobOper) result(vmold_) case(iobOper_lwcp ); vmold_ => lwcpOper_mold case(iobOper_light ); vmold_ => lightOper_mold case(iobOper_dbz ); vmold_ => dbzOper_mold + case(iobOper_fed ); vmold_ => fedOper_mold case(iobOper_cldtot ); vmold_ => cldtotOper_mold case( obOper_undef ); vmold_ => null() @@ -602,6 +608,7 @@ subroutine cobstype_config_() cobstype(iobOper_lwcp ) ="lwcp " ! lwcp_ob_type cobstype(iobOper_light ) ="light " ! light_ob_type cobstype(iobOper_dbz ) ="dbz " ! dbz_ob_type + cobstype(iobOper_fed ) ="fed " ! fed_ob_type cobstype(iobOper_cldtot ) ="cldtot " ! using q_ob_type cobstype_configured_=.true. diff --git a/src/gsi/gsimod.F90 b/src/gsi/gsimod.F90 index cf885c2b64..de19c85fab 100644 --- a/src/gsi/gsimod.F90 +++ b/src/gsi/gsimod.F90 @@ -21,6 +21,7 @@ module gsimod lread_obs_save,lread_obs_skip,time_window_rad,tcp_posmatch,tcp_box, & neutral_stability_windfact_2dvar,use_similarity_2dvar,ta2tb use gsi_dbzOper, only: diag_radardbz + use gsi_fedOper, only: diag_fed use obsmod, only: doradaroneob,oneoblat,oneoblon,oneobheight,oneobvalue,oneobddiff,oneobradid,& radar_no_thinning,ens_hx_dbz_cut,static_gsi_nopcp_dbz,rmesh_dbz,& @@ -560,6 +561,7 @@ module gsimod ! diag_co - logical to turn off or on the diagnostic carbon monoxide file (true=on) ! diag_light - logical to turn off or on the diagnostic lightning file (true=on) ! diag_radardbz - logical to turn off or on the diagnostic radar reflectivity file (true=on) +! diag_fed - logical to turn off or on the diagnostic flash extent density file (true=on) ! write_diag - logical to write out diagnostic files on outer iteration ! lobsdiagsave - write out additional observation diagnostics ! ltlint - linearize inner loop @@ -738,8 +740,8 @@ module gsimod min_offset,pseudo_q2,& iout_iter,npredp,retrieval,& tzr_qc,tzr_bufrsave,& - diag_rad,diag_pcp,diag_conv,diag_ozone,diag_aero,diag_co,diag_light,diag_radardbz,iguess, & - write_diag,reduce_diag, & + diag_rad,diag_pcp,diag_conv,diag_ozone,diag_aero,diag_co,diag_light,diag_radardbz,diag_fed, & + iguess,write_diag,reduce_diag, & oneobtest,sfcmodel,dtbduv_on,ifact10,l_foto,offtime_data,& use_pbl,use_compress,nsig_ext,gpstop,commgpstop, commgpserrinf, & perturb_obs,perturb_fact,oberror_tune,preserve_restart_date, & @@ -1977,6 +1979,7 @@ subroutine gsimain_initialize diag_pcp=.false. diag_light=.false. diag_radardbz=.false. + diag_fed=.false. use_limit = 0 end if if(reduce_diag) use_limit = 0 diff --git a/src/gsi/intjo.f90 b/src/gsi/intjo.f90 index 91b811147e..a68355471b 100644 --- a/src/gsi/intjo.f90 +++ b/src/gsi/intjo.f90 @@ -31,7 +31,7 @@ module intjomod use gsi_obOperTypeManager, only: & iobOper_t, iobOper_pw, iobOper_q, & iobOper_cldtot, iobOper_w, iobOper_dw, & - iobOper_rw, iobOper_dbz, & + iobOper_rw, iobOper_dbz, iobOper_fed, & iobOper_spd, iobOper_oz, iobOper_o3l, iobOper_colvk, & iobOper_pm2_5, iobOper_pm10, iobOper_ps, iobOper_tcp, iobOper_sst, & iobOper_gpsbend, iobOper_gpsref, & @@ -60,7 +60,7 @@ module intjomod integer(i_kind),parameter,dimension(obOper_count):: ix_obtype = (/ & iobOper_t, iobOper_pw, iobOper_q, & iobOper_cldtot, iobOper_w, iobOper_dw, & - iobOper_rw, iobOper_dbz, & + iobOper_rw, iobOper_dbz, iobOper_fed, & iobOper_spd, iobOper_oz, iobOper_o3l, iobOper_colvk, & iobOper_pm2_5, iobOper_pm10, iobOper_ps, iobOper_tcp, iobOper_sst, & iobOper_gpsbend, iobOper_gpsref, & diff --git a/src/gsi/m_fedNode.F90 b/src/gsi/m_fedNode.F90 new file mode 100644 index 0000000000..84a319cd12 --- /dev/null +++ b/src/gsi/m_fedNode.F90 @@ -0,0 +1,248 @@ +module m_fedNode +!$$$ subprogram documentation block +! . . . . +! subprogram: module m_fedNode +! prgmmr: YPW +! org: CIMMS +! date: 2019-09-24 +! +! abstract: class-module of obs-type fedNode (GLM flash extent density) +! Modified based on m_tdNode.f90 +! +! program history log: +! 2019-09-24 YPW - added this document block for the initial polymorphic +! implementation. +! +! input argument list: see Fortran 90 style document below +! +! output argument list: see Fortran 90 style document below +! +! attributes: +! language: Fortran 90 and/or above +! machine: +! +!$$$ end subprogram documentation block + +! module interface: + use m_obsdiagNode, only: obs_diag + use m_obsdiagNode, only: obs_diags + use kinds , only: i_kind,r_kind + use mpeu_util, only: assert_,die,perr,warn,tell + use m_obsNode, only: obsNode + + implicit none + private + + public:: fedNode + + type,extends(obsNode):: fedNode + type(obs_diag), pointer :: diags => NULL() + real(r_kind) :: res ! flash extent density residual + real(r_kind) :: err2 ! flash extent density error squared + real(r_kind) :: raterr2 ! square of ratio of final obs error + ! to original obs error + real(r_kind) :: b ! variational quality control parameter + real(r_kind) :: pg ! variational quality control parameter + real(r_kind) :: jb ! variational quality control parameter + real(r_kind) :: wij(8) ! horizontal interpolation weights + real(r_kind) :: fedpertb ! random number adding to the obs + integer(i_kind) :: k1 ! level of errtable 1-33 + integer(i_kind) :: kx ! ob type + integer(i_kind) :: ij(8) ! horizontal locations + + real (r_kind) :: dlev ! reference to the vertical grid + contains + procedure,nopass:: mytype + procedure:: setHop => obsNode_setHop_ + procedure:: xread => obsNode_xread_ + procedure:: xwrite => obsNode_xwrite_ + procedure:: isvalid => obsNode_isvalid_ + procedure:: gettlddp => gettlddp_ + + end type fedNode + + public:: fedNode_typecast + public:: fedNode_nextcast + interface fedNode_typecast; module procedure typecast_ ; end interface + interface fedNode_nextcast; module procedure nextcast_ ; end interface + + public:: fedNode_appendto + interface fedNode_appendto; module procedure appendto_ ; end interface + + character(len=*),parameter:: MYNAME="m_fedNode" + +#include "myassert.H" +#include "mytrace.H" +contains +function typecast_(aNode) result(ptr_) +!-- cast a class(obsNode) to a type(tdNode) + use m_obsNode, only: obsNode + implicit none + type(fedNode),pointer:: ptr_ + class(obsNode),pointer,intent(in):: aNode + ptr_ => null() + if(.not.associated(aNode)) return + select type(aNode) + type is(fedNode) + ptr_ => aNode + end select +return +end function typecast_ + +function nextcast_(aNode) result(ptr_) +!-- cast an obsNode_next(obsNode) to a type(fedNode) + use m_obsNode, only: obsNode,obsNode_next + implicit none + type(fedNode),pointer:: ptr_ + class(obsNode),target,intent(in):: aNode + + class(obsNode),pointer:: inode_ + inode_ => obsNode_next(aNode) + ptr_ => typecast_(inode_) +return +end function nextcast_ + +subroutine appendto_(aNode,oll) +!-- append aNode to linked-list oLL + use m_obsNode , only: obsNode + use m_obsLList, only: obsLList,obsLList_appendNode + implicit none + type(fedNode),pointer,intent(in):: aNode + type(obsLList),intent(inout):: oLL + + class(obsNode),pointer:: inode_ + inode_ => aNode + call obsLList_appendNode(oLL,inode_) + inode_ => null() +end subroutine appendto_ + +! obsNode implementations + +function mytype() + implicit none + character(len=:),allocatable:: mytype + mytype="[fedNode]" +end function mytype + + +subroutine obsNode_xread_(aNode,iunit,istat,diagLookup,skip) + use m_obsdiagNode, only: obsdiagLookup_locate + implicit none + class(fedNode),intent(inout):: aNode + integer(i_kind),intent(in ):: iunit + integer(i_kind),intent( out):: istat + type(obs_diags),intent(in ):: diagLookup + logical,optional,intent(in ):: skip + + character(len=*),parameter:: myname_=MYNAME//'.obsNode_xread_' + logical:: skip_ +_ENTRY_(myname_) + skip_=.false. + if(present(skip)) skip_=skip + + istat=0 + if(skip_) then + read(iunit,iostat=istat) + if(istat/=0) then + call perr(myname_,'skipping read(%(res,err2,...)), iostat =',istat) + _EXIT_(myname_) + return + endif + + else + read(iunit,iostat=istat) aNode%res , & + aNode%err2 , & + aNode%raterr2 , & + aNode%b , & + aNode%pg , & + aNode%jb , & + aNode%k1 , & + aNode%kx , & + aNode%dlev , & + aNode%wij , & + aNode%ij + if(istat/=0) then + call perr(myname_,'read(%(res,err2,...), iostat =',istat) + _EXIT_(myname_) + return + endif + + aNode%diags => obsdiagLookup_locate(diagLookup,aNode%idv,aNode%iob,1_i_kind) + if(.not.associated(aNode%diags)) then + call perr(myname_,'obsdiagLookup_locate(), %idv =',aNode%idv) + call perr(myname_,' %iob =',aNode%iob) + call die(myname_) + endif + endif +_EXIT_(myname_) +return +end subroutine obsNode_xread_ + +subroutine obsNode_xwrite_(aNode,junit,jstat) + implicit none + class(fedNode),intent(in):: aNode + integer(i_kind),intent(in ):: junit + integer(i_kind),intent( out):: jstat + + character(len=*),parameter:: myname_=MYNAME//'.obsNode_xwrite_' +_ENTRY_(myname_) + + jstat=0 + write(junit,iostat=jstat) aNode%res , & + aNode%err2 , & + aNode%raterr2 , & + aNode%b , & + aNode%pg , & + aNode%jb , & + aNode%k1 , & + aNode%kx , & + aNode%dlev , & + aNode%wij , & + aNode%ij + if(jstat/=0) then + call perr(myname_,'write(%res,err2,...), iostat =',jstat) + _EXIT_(myname_) + return + endif +_EXIT_(myname_) +return +end subroutine obsNode_xwrite_ + +subroutine obsNode_setHop_(aNode) + use m_cvgridLookup, only: cvgridLookup_getiw + implicit none + class(fedNode),intent(inout):: aNode + + character(len=*),parameter:: myname_=MYNAME//'::obsNode_setHop_' +_ENTRY_(myname_) + call cvgridLookup_getiw(aNode%elat,aNode%elon,aNode%dlev,aNode%ij,aNode%wij) +_EXIT_(myname_) +return +end subroutine obsNode_setHop_ + +function obsNode_isvalid_(aNode) result(isvalid_) + implicit none + logical:: isvalid_ + class(fedNode),intent(in):: aNode + + character(len=*),parameter:: myname_=MYNAME//'::obsNode_isvalid_' +_ENTRY_(myname_) + isvalid_=associated(aNode%diags) +_EXIT_(myname_) +return +end function obsNode_isvalid_ + +pure subroutine gettlddp_(aNode,jiter,tlddp,nob) + use kinds, only: r_kind + implicit none + class(fedNode), intent(in):: aNode + integer(kind=i_kind),intent(in):: jiter + real(kind=r_kind),intent(inout):: tlddp + integer(kind=i_kind),optional,intent(inout):: nob + + tlddp = tlddp + aNode%diags%tldepart(jiter)*aNode%diags%tldepart(jiter) + if(present(nob)) nob=nob+1 +return +end subroutine gettlddp_ + +end module m_fedNode diff --git a/src/gsi/m_obsNodeTypeManager.F90 b/src/gsi/m_obsNodeTypeManager.F90 index b5ecc6e1ba..43b42e4bf2 100644 --- a/src/gsi/m_obsNodeTypeManager.F90 +++ b/src/gsi/m_obsNodeTypeManager.F90 @@ -70,6 +70,7 @@ module m_obsNodeTypeManager use m_lightNode, only: lightNode use m_dbzNode , only: dbzNode + use m_fedNode, only: fedNode use kinds, only: i_kind use m_obsNode, only: obsNode @@ -124,6 +125,7 @@ module m_obsNodeTypeManager public:: iobsNode_light public:: iobsNode_dbz + public:: iobsNode_fed public :: obsNode_typeMold public :: obsNode_typeIndex @@ -179,6 +181,7 @@ module m_obsNodeTypeManager type( lwcpNode), target, save:: lwcp_mold type( lightNode), target, save:: light_mold type( dbzNode), target, save:: dbz_mold + type( fedNode), target, save:: fed_mold !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ character(len=*),parameter :: myname='m_obsNodeTypeManager' @@ -245,6 +248,7 @@ module m_obsNodeTypeManager enumerator:: iobsNode_lwcp enumerator:: iobsNode_light enumerator:: iobsNode_dbz + enumerator:: iobsNode_fed enumerator:: iobsNode_extra_ end enum @@ -314,6 +318,7 @@ function vname2index_(vname) result(index_) case("light","[lightnode]"); index_ = iobsNode_light case("dbz" , "[dbznode]"); index_ = iobsNode_dbz + case("fed" , "[fednode]"); index_ = iobsNode_fed end select end function vname2index_ @@ -377,6 +382,7 @@ function vmold2index_select_(mold) result(index_) type is(lightNode); index_ = iobsNode_light type is( dbzNode); index_ = iobsNode_dbz + type is( fedNode); index_ = iobsNode_fed end select end function vmold2index_select_ @@ -434,6 +440,7 @@ function index2vmold_(i_obType) result(obsmold_) case(iobsNode_light); obsmold_ => light_mold case(iobsNode_dbz); obsmold_ => dbz_mold + case(iobsNode_fed); obsmold_ => fed_mold end select end function index2vmold_ diff --git a/src/gsi/m_rhs.F90 b/src/gsi/m_rhs.F90 index baee074688..aea417fe27 100644 --- a/src/gsi/m_rhs.F90 +++ b/src/gsi/m_rhs.F90 @@ -80,6 +80,7 @@ module m_rhs public:: i_lwcp public:: i_light public:: i_dbz + public:: i_fed public:: i_cldtot public:: awork_size @@ -146,6 +147,7 @@ module m_rhs enumerator:: i_lwcp enumerator:: i_light enumerator:: i_dbz + enumerator:: i_fed enumerator:: i_cldtot enumerator:: i_outbound diff --git a/src/gsi/obsmod.F90 b/src/gsi/obsmod.F90 index 3066cdb5ca..a059586e67 100644 --- a/src/gsi/obsmod.F90 +++ b/src/gsi/obsmod.F90 @@ -160,6 +160,7 @@ module obsmod ! 2021-11-16 Zhao - add option l_obsprvdiag (if true) to trigger the output of ! observation provider and sub-provider information into ! obsdiags files (used for AutoObsQC) +! 2023-07-10 Y. Wang, D. Dowell - add variables for flash extent density ! ! Subroutines Included: ! sub init_obsmod_dflts - initialize obs related variables to default values @@ -186,6 +187,7 @@ module obsmod ! def write_diag - namelist logical array to compute/write (=true) diag files ! def diag_radardbz- namelist logical to compute/write (=true) radar ! reflectiivty diag files +! def diag_fed - namelist logical to compute/write (=true) flash extent density diag files ! def reduce_diag - namelist logical to produce reduced radiance diagnostic files ! def use_limit - parameter set equal to -1 if diag files produced or 0 if not diag files or reduce_diag ! def obs_setup - prefix for files passing pe relative obs data to setup routines @@ -434,6 +436,7 @@ module obsmod public :: ran01dom,dval_use public :: iout_pcp,iout_rad,iadate,iadatemn,write_diag,reduce_diag,oberrflg,bflag,ndat,dthin,dmesh,l_do_adjoint public :: diag_radardbz + public :: diag_fed public :: lsaveobsens public :: iout_cldch, mype_cldch public :: nprof_gps,time_offset,ianldate,tcp_box @@ -483,7 +486,9 @@ module obsmod public :: iout_dbz, mype_dbz ! --- DBZ DA --- - + + public :: iout_fed, mype_fed + public :: obsmod_init_instr_table public :: obsmod_final_instr_table public :: nobs_sub @@ -583,12 +588,12 @@ module obsmod integer(i_kind) iout_co,iout_gust,iout_vis,iout_pblh,iout_tcamt,iout_lcbas integer(i_kind) iout_cldch integer(i_kind) iout_wspd10m,iout_td2m,iout_mxtm,iout_mitm,iout_pmsl,iout_howv - integer(i_kind) iout_uwnd10m,iout_vwnd10m + integer(i_kind) iout_uwnd10m,iout_vwnd10m,iout_fed integer(i_kind) mype_t,mype_q,mype_uv,mype_ps,mype_pw, & mype_rw,mype_dw,mype_gps,mype_sst, & mype_tcp,mype_lag,mype_co,mype_gust,mype_vis,mype_pblh, & mype_wspd10m,mype_td2m,mype_mxtm,mype_mitm,mype_pmsl,mype_howv,& - mype_uwnd10m,mype_vwnd10m, mype_tcamt,mype_lcbas, mype_dbz + mype_uwnd10m,mype_vwnd10m, mype_tcamt,mype_lcbas, mype_dbz, mype_fed integer(i_kind) mype_cldch integer(i_kind) iout_swcp, iout_lwcp integer(i_kind) mype_swcp, mype_lwcp @@ -638,6 +643,7 @@ module obsmod logical lobserver,l_do_adjoint, lobsdiag_forenkf logical,dimension(0:50):: write_diag logical diag_radardbz + logical diag_fed logical reduce_diag logical offtime_data logical hilbert_curve @@ -789,6 +795,7 @@ subroutine init_obsmod_dflts end do write_diag(1)=.true. diag_radardbz = .false. + diag_fed = .false. reduce_diag = .false. use_limit = -1 lobsdiagsave=.false. @@ -853,6 +860,7 @@ subroutine init_obsmod_dflts iout_lwcp=236 ! liquid-water content path iout_light=237 ! lightning iout_dbz=238 ! radar reflectivity + iout_fed=239 ! flash extent density mype_ps = npe-1 ! surface pressure mype_t = max(0,npe-2) ! temperature @@ -887,6 +895,7 @@ subroutine init_obsmod_dflts mype_lwcp=max(0,npe-31) ! liquid-water content path mype_light=max(0,npe-32)! GOES/GLM lightning mype_dbz=max(0,npe-33) ! radar reflectivity + mype_fed= max(0,npe-34) ! flash extent density ! Initialize arrays used in namelist obs_input diff --git a/src/gsi/read_fed.f90 b/src/gsi/read_fed.f90 new file mode 100644 index 0000000000..c478b3d93f --- /dev/null +++ b/src/gsi/read_fed.f90 @@ -0,0 +1,525 @@ +subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs) +!$$$ subprogram documentation block +! . . . . +! ABSTRACT: +! This routine reads in netcdf or prepbufr flash-extent density (FED) data. +! +! PROGRAM HISTORY LOG: +! 2018-07-25 Rong Kong (CAPS/OU) - modified based on read_radarref_mosaic.f90 +! 2019-09-20 Yaping Wang (CIMMS/OU) +! 2021-07-01 David Dowell (DCD; NOAA GSL) - added maximum flashes/min for observed FED +! +! input argument list: +! infile - unit from which to read observation information file +! obstype - observation type to process +! lunout - unit to which to write data for further processing +! twind - input group time window (hours) +! sis - observation variable name +! +! output argument list: +! nread - number of type "obstype" observations read +! ndata - number of type "obstype" observations retained for further processing +! nobs - array of observations on each subdomain for each processor +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! +!$$$ +! +!_____________________________________________________________________ +! + use kinds, only: r_kind,r_double,i_kind + use constants, only: zero,one,deg2rad + use convinfo, only: nconvtype,ctwind,icuse,ioctype + use gsi_4dvar, only: l4dvar,l4densvar,winlen + use gridmod, only: tll2xy + use mod_wrfmass_to_a, only: wrfmass_obs_to_a8 + use mpimod, only: npe + use obsmod, only: perturb_obs,iadatemn + + use netcdf + implicit none + + include 'netcdf.inc' +! + character(len=*), intent(in) :: infile,obstype + integer(i_kind), intent(in) :: lunout + integer(i_kind), intent(inout) :: nread,ndata + integer(i_kind), intent(inout) :: nodata + integer(i_kind), dimension(npe) ,intent(inout) :: nobs + real(r_kind), intent(in ) :: twind + character(len=*), intent(in) :: sis + +! Declare local parameters + real(r_kind),parameter:: r90 = 90.0_r_kind + real(r_kind),parameter:: r360 = 360.0_r_kind + real(r_kind),parameter:: oe_fed = 1.0_r_kind + real(r_kind),parameter:: fed_lowbnd = 0.1_r_kind ! use fed == fed_lowbnd + real(r_kind),parameter:: fed_lowbnd2 = 0.1_r_kind ! use fed >= fed_lowbnd2 +! real(r_kind),parameter:: fed_highbnd = 18.0_r_kind ! 18 flashes/min from Sebok and Back (2021, unpublished) + real(r_kind),parameter:: fed_highbnd = 8.0_r_kind ! 8 flashes/min from Back (2023) for regional FV3 tests + +! +! For fed observations +! + integer(i_kind) nreal,nchanl + + integer(i_kind) ifn,i + + integer(i_kind) :: ilon,ilat + + logical :: fedobs, fedob + real(r_kind),allocatable,dimension(:,:):: cdata_out + real(r_kind) :: federr, thiserr + real(r_kind) :: hgt_fed(1) + data hgt_fed / 6500.0 / + + real(r_kind) :: i_maxloc,j_maxloc,k_maxloc + integer(i_kind) :: kint_maxloc + real(r_kind) :: fed_max + integer(i_kind) :: ndata2 + integer(i_kind) :: ppp + +! +! for read in bufr +! + real(r_kind) :: hdr(5),obs(1,3) + character(80):: hdrstr='SID XOB YOB DHR TYP' + character(80):: obsstr='FED' + + character(8) subset + character(8) station_id + real(r_double) :: rstation_id + equivalence(rstation_id,station_id) + integer(i_kind) :: lunin,idate + integer(i_kind) :: ireadmg,ireadsb + + integer(i_kind) :: maxlvl + integer(i_kind) :: numlvl,numfed,nmsgmax,maxobs + integer(i_kind) :: k,iret + integer(i_kind) :: nmsg,ntb + + real(r_kind),allocatable,dimension(:,:) :: fed3d_column ! 3D fed in column + real(r_kind),allocatable,dimension(:) :: utime ! time + + integer(i_kind) :: ikx + real(r_kind) :: timeo,t4dv + + character*128 :: myname='read_fed' + + real(r_kind) :: dlat, dlon ! rotated corrdinate + real(r_kind) :: dlat_earth, dlon_earth ! in unit of degree + real(r_kind) :: rlat00, rlon00 ! in unit of rad + + logical :: l_psot_fed + logical :: l_latlon_fedobs + logical :: outside + integer :: unit_table + +! for read netcdf + integer(i_kind) :: sec70,mins_an + integer(i_kind) :: varID, ncdfID, status + real(r_kind) :: timeb,twindm,rmins_an,rmins_ob + + + unit_table = 23 +!********************************************************************** +! +! END OF DECLARATIONS....start of program +! + write(6,*) "r_kind=",r_kind + l_psot_fed = .FALSE. + l_latlon_fedobs = .TRUE. + + fedob = obstype == 'fed' + if(fedob) then + nreal=25 + else + write(6,*) ' illegal obs type in read_fed : obstype=',obstype + call stop2(94) + end if + if(perturb_obs .and. fedob)nreal=nreal+1 + write(6,*)'read_fed: nreal=',nreal + + fedobs = .false. + ikx=0 + do i=1,nconvtype + if(trim(obstype) == trim(ioctype(i)) .and. abs(icuse(i))== 1) then + fedobs=.true. + ikx=i + federr = oe_fed ! Obs error (flashes per minute) + thiserr = federr + exit ! Exit loop when finished with initial convinfo fields + else if (i == nconvtype ) then + write(6,*) 'read_fed: Obs Type for fed is not in CONVINFO !' + write(6,*) 'read_fed: PLEASE modify the CONVINFO file !' + write(6,*) 'read_fed: abort read_fed !' + return + endif + end do + write(6,'(1x,A,A30,I4,A15,F7.3,A7)') & + trim(myname),': fed in convinfo-->ikx=',ikx,' fed ob err:',thiserr," (fed)" + + nread=0 + ndata=0 + nchanl=0 + ifn = 15 + + if(fedobs) then + maxlvl= 1 ! fed only has one level + + if(trim(infile) .eq. "fedbufr") then ! prebufr or netcdf format + !! get message and subset counts + ! nmsgmax and maxobs are read in from BUFR data file, not pre-set. + call getcount_bufr(infile,nmsgmax,maxobs) + write(6,*)'read_fed: nmsgmax=',nmsgmax,' maxobs=',maxobs + +! read in fed obs in bufr code format + lunin = 10 + allocate(fed3d_column(maxlvl+2+2,maxobs)) + + open ( unit = lunin, file = trim(infile),form='unformatted',err=200) + call openbf ( lunin, 'IN', lunin ) + open(unit_table,file='prepobs_kr.bufrtable') !temporily dump the bufr table, which is already saved in file + call dxdump(lunin,unit_table) + call datelen ( 10 ) + + nmsg=0 + ntb = 0 + + ndata =0 + ppp = 0 + msg_report: do while (ireadmg(lunin,subset,idate) == 0) + nmsg=nmsg+1 + if (nmsg>nmsgmax) then + write(6,*)'read_fed: messages exceed maximum ',nmsgmax + call stop2(50) + endif + loop_report: do while (ireadsb(lunin) == 0) + ntb = ntb+1 + if (ntb>maxobs) then + write(6,*)'read_fed: reports exceed maximum ',maxobs + call stop2(50) + endif + + ! Extract type, date, and location information from BUFR file + call ufbint(lunin,hdr,5,1,iret,hdrstr) + if(hdr(3) .gt. r90 ) write(6,*) "Inside read_fed.f90, hdr(2)=",hdr(2),"hdr(3)=",hdr(3) + if ( l_latlon_fedobs ) then + if(abs(hdr(3))>r90 .or. abs(hdr(2))>r360) cycle loop_report + if(hdr(2)== r360)hdr(2)=hdr(2)-r360 + if(hdr(2) < zero)hdr(2)=hdr(2)+r360 + end if + +! check time window in subset + if (l4dvar.or.l4densvar) then + t4dv=hdr(4) + if (t4dvwinlen) then + write(6,*)'read_fed: time outside window ',& + t4dv,' skip this report' + cycle loop_report + endif + else + timeo=hdr(4) + if (abs(timeo)>ctwind(ikx) .or. abs(timeo) > twind) then + write(6,*)'read_fed: time outside window ',& + timeo,' skip this report' + cycle loop_report + endif + endif +! read in observations + call ufbint(lunin,obs,1,3,iret,obsstr) !Single level bufr data, Rong Kong + if(obs(1,1) .gt. 5 ) write(6,*) "Inside read_fed.f90, obs(1,1)=",obs(1,1) + numlvl=min(iret,maxlvl) + if (numlvl .ne. maxlvl) then + write(6,*)' read_fed: numlvl is not equalt to maxlvl:',numlvl,maxlvl + end if + if(hdr(3) .gt. 90) write(6,*) "hdr(3)=",hdr(3) + if ( l_latlon_fedobs ) then + if(hdr(2)>= r360)hdr(2)=hdr(2)-r360 + if(hdr(2) < zero)hdr(2)=hdr(2)+r360 + fed3d_column(1,ntb)=hdr(2) ! observation location, earth lon + fed3d_column(2,ntb)=hdr(3) ! observation location, earth lat +! write(6,*) "Inside read_fed.f90, fed3d_column(1,ntb)=",fed3d_column(1,ntb),"fed3d_column(2,ntb)=",fed3d_column(2,ntb) + else + fed3d_column(1,ntb)=hdr(2)*10.0_r_kind ! observation location, grid index i + fed3d_column(2,ntb)=hdr(3)*10.0_r_kind ! observation location, grid index j + end if + + if (l_psot_fed .and. .NOT. l_latlon_fedobs ) then + do k=1,numlvl + if (NINT(fed3d_column(1,ntb)) .eq. 175 .and. NINT(fed3d_column(2,ntb)) .eq. 105 .and. & + NINT(hgt_fed(k)) .ge. 100 ) then + write(6,*) 'read_fed: single point/column obs run on grid: 175 105' + write(6,*) 'read_fed: found the pseudo single(column) fed obs:',fed3d_column(1:2,ntb),hgt_fed(k) + else + obs(1,1) = -999.0 + end if + end do + end if + + fed3d_column(3,ntb)=obs(1,1) + fed3d_column(4,ntb)=obs(1,2) + fed3d_column(5,ntb)=obs(1,3) + if (obs(1,1) == fed_lowbnd .or. obs(1,1) >= fed_lowbnd2 ) then + if (obs(1,1) == 0.0) then + ppp = ppp + 1 + endif + ndata = ndata + 1 + endif + + enddo loop_report + enddo msg_report + + write(6,*)'read_fed: messages/reports = ',nmsg,'/',ntb + print*,'number of Z that is less than 0 is ppp = ', ppp + numfed=ntb + +! - Finished reading fed observations from BUFR format data file +! + call closbf(lunin) + close(lunin) + + else ! NETCDF format +!!!! Start reading fed observations from NETCDF format data file + ! CHECK IF DATA FILE EXISTS + + ! OPEN NETCDF FILE + status = nf90_open(TRIM(infile), NF90_NOWRITE, ncdfID) + print*, '*** OPENING GOES FED OBS NETCDF FILE: ', infile, status + + + !------------------------ + ! Get date information + !------------------------- + ! status = nf90_get_att( ncdfID, nf90_global, 'year', idate5s(1) ) + ! print*, 'year ',status + ! status = nf90_get_att( ncdfID, nf90_global, 'month', idate5s(2) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'day', idate5s(3) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'hour', idate5s(4) ) + ! status = nf90_get_att( ncdfID, nf90_global, 'minute', idate5s(5) ) + ! read(idate5s(:) , *) idate5(:) + ! print*, idate5 + + !------------------------ + ! Get Dimension Info (1-D) + !------------------------- + status = nf90_inq_varid( ncdfID, 'numobs', varID ) + status = nf90_get_var( ncdfID, varID, maxobs ) + + !------------------------ + ! Allocate data arrays + !------------------------- + ALLOCATE( fed3d_column( 5, maxobs ) ) + ALLOCATE( utime( 1 ) ) ! seconds since from 2000-01-01 12:00 + + !------------------------ + ! Get useful data arrays + !------------------------- + ! LON + status = nf90_inq_varid( ncdfID, 'lon', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(1, :) ) + ! LAT + status = nf90_inq_varid( ncdfID, 'lat', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(2, :) ) + ! FED value + status = nf90_inq_varid( ncdfID, 'value', varID ) + status = nf90_get_var( ncdfID, varID, fed3d_column(3, :) ) + ! TIME + status = nf90_inq_varid( ncdfID, 'time', varID ) + status = nf90_get_var( ncdfID, varID, utime ) + + ! CLOSE NETCDF FILE + status = nf90_close( ncdfID ) + + + !-Obtain analysis time in minutes since reference date + sec70 = 694267200.0 ! seconds since from 1978-01-01 00:00 to 2000-01-01 12:00 + ! because the official GOES prescribed epoch time for GLM data is 2000-01-01 12:00:00 + + call w3fs21(iadatemn,mins_an) !mins_an -integer number of mins snce 01/01/1978 + rmins_an=mins_an !convert to real number + + ! SINCE ALL OBS WILL HAVE THE SAME TIME, CHECK TIME HERE: + rmins_ob = ( utime(1) + sec70 )/60 !Convert to Minutes from seconds + twindm = twind*60. !Convert to Minutes from hours + timeb = rmins_ob-rmins_an + + if(abs(timeb) > abs(twindm)) then + print*, 'WARNING: ALL FED OBSERVATIONS OUTSIDE ASSIMILATION TIME WINDOW: ', timeb, twindm + ! goto 314 + endif + numfed = maxobs + do i=1,numfed + if (fed3d_column( 3, i ) >= fed_lowbnd2 .or. fed3d_column( 3, i ) == fed_lowbnd ) then + ndata = ndata + 1 + end if + end do + end if ! end if prebufr or netcdf format + + write(6,*)'read_fed: total no. of obs = ',ndata + nread=ndata + nodata=ndata +!!! - Finished reading fed observations from NETCDF format data file + + + + allocate(cdata_out(nreal,ndata)) +! +! + do i=1,numfed + do k=1,maxlvl + +! DCD 1 July 2021 + if (fed3d_column(k+2,i) .gt. fed_highbnd) fed3d_column(k+2,i) = fed_highbnd + + end do + end do + + write(6,*) ' ------- check max and min value of OBS: bufr fed -------' + write(6,*) ' level maxval(fed) minval(fed)' + do k=1,maxlvl + write(6,*) k,maxval(fed3d_column(k+2,:)),minval(fed3d_column(k+2,:)) + end do + + + i_maxloc=-1.0 + j_maxloc=-1.0 + k_maxloc=-1.0 + kint_maxloc=-1 + fed_max=-999.99 + ndata2=0 + do i=1,numfed + do k=1,maxlvl + if( fed3d_column(k+2,i) >= fed_lowbnd2 .or. fed3d_column(k+2,i) == fed_lowbnd) then !Rong Kong + dlon_earth = fed3d_column(1,i) ! longitude (degrees) of observation + ! ilone=18 ! index of longitude (degrees) + dlat_earth = fed3d_column(2,i) ! latitude (degrees) of observation + ! ilate=19 ! index of latitude (degrees) + !-Check format of longitude and correct if necessary + if(dlon_earth>=r360) dlon_earth=dlon_earth-r360 + if(dlon_earth=r360 .or. dlat_earth >90.0_r_kind) cycle + + !-Convert back to radians + rlon00 = dlon_earth*deg2rad + rlat00 = dlat_earth*deg2rad + call tll2xy(rlon00,rlat00,dlon,dlat,outside) + if (outside) cycle + + !If observation is outside the domain + ! then cycle, but don't increase + ! range right away. + ! Domain could be rectangular, so ob + ! may be out of + ! range at one end, but not the + ! other. + + ndata2=ndata2+1 + cdata_out( 1,ndata2) = thiserr ! obs error (flashes/min) - inflated/adjusted + + cdata_out( 2,ndata2) = dlon ! + + cdata_out( 3,ndata2) = dlat + + cdata_out( 4,ndata2) = hgt_fed(k) ! obs absolute height (m) above MSL + ! ipres=4 ! index of pressure + cdata_out( 5,ndata2) = fed3d_column(k+2,i) ! FED value + ! idbzob=5 ! index of dbz observation + cdata_out( 6,ndata2) = rstation_id ! station id (charstring equivalent to real double) + ! id=6 ! index of station id + + cdata_out( 7,ndata2) = 0.0_r_kind ! observation time in data array + ! itime=7 ! index of observation time in data array + cdata_out( 8,ndata2) = ikx ! ob type + ! ikxx=8 ! index of ob type + cdata_out( 9,ndata2) = thiserr*2.0_r_kind ! max error + ! iqmax=9 ! index of max error + cdata_out(10,ndata2) = 273.0_r_kind ! dry temperature + ! itemp=10 ! index of dry temperature + cdata_out(11,ndata2) = 1.0_r_kind ! quality mark + ! iqc=11 ! index of quality mark + cdata_out(12,ndata2) = thiserr ! original-original obs error ratio + ! ier2=12 ! index of original-original obs error ratio + cdata_out(13,ndata2) = icuse(ikx) ! index of use parameter + ! iuse=13 ! index of use parameter + cdata_out(14,ndata2) = icuse(ikx) ! dominant surface type + ! idomsfc=14 ! index of dominant surface type + cdata_out(15,ndata2) = 273.0_r_kind ! index of surface skin temperature + ! iskint=15 ! index of surface skin temperature + cdata_out(16,ndata2) = 0.5_r_kind ! 10 meter wind factor + ! iff10=16 ! index of 10 meter wind factor + cdata_out(17,ndata2) = 0.5_r_kind ! surface roughness + ! isfcr=17 ! index of surface roughness + + cdata_out(18,ndata2) = dlon_earth ! longitude (degrees) + + cdata_out(19,ndata2) = dlat_earth ! latitude (degrees) + + cdata_out(20,ndata2) = hgt_fed(k) ! station elevation (m) + ! istnelv=20 ! index of station elevation (m) + cdata_out(21,ndata2) = hgt_fed(k) ! observation height (m) + ! iobshgt=21 ! index of observation height (m) + cdata_out(22,ndata2) = hgt_fed(k) ! surface height + ! izz=22 ! index of surface height + cdata_out(23,ndata2) = fed3d_column(4,i) ! i index of obs grid for bufr resolution (i.e.,8km) + + cdata_out(24,ndata2) = fed3d_column(5,i) ! j index of obs grid for bufr resolution + + cdata_out(25,ndata2) = hgt_fed(k) ! data level category + ! icat =25 ! index of data level category + if(perturb_obs .and. fedob)then + cdata_out(26,ndata2) = 1.0_r_kind ! obs perturbation + ! iptrb=26 ! index of q perturbation + end if +! print*,'cdata_out(:,ndata2)=',cdata_out(:,ndata2) + if(fed3d_column(k+2,i) > fed_max)then + kint_maxloc=k + k_maxloc=real(k,r_kind) + j_maxloc=fed3d_column(2,i) + i_maxloc=fed3d_column(1,i) + fed_max =fed3d_column(k+2,i) + end if + endif + enddo + enddo + +!---all looping done now print diagnostic output + write(6,*)'READ_FED: Reached eof on FED file' + write(6,*)'READ_FED: # read in obs. number =',nread + write(6,*)'READ_FED: # read in obs. number for further processing =',ndata2 + ! write(6,*)'READ_FED: dlon_earth', cdata_out(18,10:15) + + ilon=2 ! array index for longitude + ilat=3 ! array index for latitude in obs information array + ndata=ndata2 + nodata=ndata2 + + !---Write observations to scratch file---! + +! if(ndata > 0 ) then + call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs) + write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata + write(lunout) ((cdata_out(k,i),k=1,nreal),i=1,ndata) + ! print*,'cdata_out',cdata_out +! endif + + deallocate(cdata_out) + if (allocated(fed3d_column)) deallocate(fed3d_column) + + write(6,'(1x,A,F12.5,1x,A,3(1x,F8.3),1x,I4)') & + 'read_fed: max fed =',fed_max, '@ i j k =', & + i_maxloc,j_maxloc,k_maxloc,kint_maxloc + + end if +! close(lunout) ! ???? + return + +200 continue + write(6,*) 'read_fed, Warning : cannot find or open bufr fed data file: ', trim(infile) + +314 continue +print* ,'FINISHED WITH READ_FED' +end subroutine read_fed +! +! diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90 index 86c7e4ce45..15476e2d04 100644 --- a/src/gsi/read_obs.F90 +++ b/src/gsi/read_obs.F90 @@ -192,6 +192,7 @@ subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread) if ( .not. l_use_dbz_directDA) then if(trim(dtype) == 'dbz' )return end if + if(trim(dtype) == 'fed' )return ! Use routine as usual @@ -911,7 +912,8 @@ subroutine read_obs(ndata,mype) obstype == 'mitm' .or. obstype=='pmsl' .or. & obstype == 'howv' .or. obstype=='tcamt' .or. & obstype=='lcbas' .or. obstype=='cldch' .or. obstype == 'larcglb' .or. & - obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' ) then + obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' .or. & + obstype=='fed') then ditype(i) = 'conv' else if (obstype == 'swcp' .or. obstype == 'lwcp') then ditype(i) = 'wcp' @@ -1302,6 +1304,10 @@ subroutine read_obs(ndata,mype) use_hgtl_full=.true. if(belong(i))use_hgtl_full_proc=.true. end if + if(obstype == 'fed')then + use_hgtl_full=.true. + if(belong(i))use_hgtl_full_proc=.true. + end if if(obstype == 'sst')then if(belong(i))use_sfc=.true. endif @@ -1639,6 +1645,12 @@ subroutine read_obs(ndata,mype) endif end if +! Process flash extent density + else if (obstype == 'fed' ) then + print *, "calling read_fed" + call read_fed(nread,npuse,nouse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i)) + string='READ_FED' + ! Process lagrangian data else if (obstype == 'lag') then call read_lag(nread,npuse,nouse,infile,lunout,obstype,& diff --git a/src/gsi/setupfed.f90 b/src/gsi/setupfed.f90 new file mode 100644 index 0000000000..cf6334e567 --- /dev/null +++ b/src/gsi/setupfed.f90 @@ -0,0 +1,1100 @@ +module fed_setup + implicit none + private + public:: setup + interface setup; module procedure setupfed; end interface + +contains +subroutine setupfed(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,fed_diagsave,init_pass) +!$$$ subprogram documentation block +! . . . . +! subprogram: setupfed compute rhs of flash extent density +! orig. prgmmr: +! Rong Kong CAPS/OU 2018-01-21 (modified based on setupdbz.f90) +! modified: +! Yaping Wang CIMMS/OU 2019-11-11 +! David Dowell (DCD) NOAA GSL 2021-07-01 +! - added a second option (tanh) for observation operator, based on the +! work of Sebok and Back (2021, unpublished) +! - capped maximum model FED +! +! + use mpeu_util, only: die,perr + use kinds, only: r_kind,r_single,r_double,i_kind + use m_obsdiagNode, only: obs_diag + use m_obsdiagNode, only: obs_diags + use m_obsdiagNode, only: obsdiagLList_nextNode + use m_obsdiagNode, only: obsdiagNode_set + use m_obsdiagNode, only: obsdiagNode_get + use m_obsdiagNode, only: obsdiagNode_assert + use obsmod, only: rmiss_single,& + lobsdiagsave,nobskeep,lobsdiag_allocated,time_offset + use obsmod, only: oberror_tune + use m_obsNode, only: obsNode + use m_fedNode, only: fedNode + use m_fedNode, only: fedNode_appendto + use obsmod, only: luse_obsdiag, netcdf_diag, binary_diag, dirname, ianldate + use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & + nc_diag_write, nc_diag_data2d + 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 guess_grids, only: hrdifsig,nfldsig,ges_prsi + use guess_grids, only: ges_lnprsl, geop_hgtl + use gridmod, only: lat2, lon2 + use gridmod, only: nsig, get_ij,get_ijk,tll2xy + use constants, only: flattening,semi_major_axis,grav_ratio,zero,grav,wgtlim + use constants, only: half,one,two,grav_equator,eccentricity,somigliana + use constants, only: deg2rad,r60,tiny_r_kind,cg_term,huge_single + use constants, only: r10,r100,r1000 + use constants, only: grav,tpwcon + use qcmod, only: npres_print,ptopq,pbotq + use jfunc, only: jiter,last,miter + use convinfo, only: nconvtype,cermin,cermax,cgross,cvar_b,cvar_pg,ictype + use convinfo, only: icsubtype + use converr, only: ptabl + use m_dtime, only: dtime_setup, dtime_check, dtime_show + use state_vectors, only: nsdim + + use gsi_bundlemod, only: GSI_BundleGetPointer + use gsi_metguess_mod, only: gsi_metguess_get, GSI_MetGuess_Bundle + + use netcdf + + + implicit none +! Declare passed variables + type(obsLList ),target,dimension(:),intent(in):: obsLL + type(obs_diags),target,dimension(:),intent(in):: odiagLL + + logical ,intent(in ) :: fed_diagsave + integer(i_kind) ,intent(in ) :: lunin,mype,nele,nobs + real(r_kind),dimension(100+7*nsig) ,intent(inout) :: awork + real(r_kind),dimension(npres_print,nconvtype,5,3),intent(inout) :: bwork + integer(i_kind) ,intent(in ) :: is ! ndat index + logical ,intent(in ) :: init_pass ! state of "setup" parameters + + +! Declare local parameters + integer(i_kind),parameter:: fed_obs_ob_shape = 2 ! 1 = linear (Allen et al.) + ! 2 = tanh (Sebok and Back) +! coefficients for tanh operator, from Sebok and Back (2021) +! real(r_kind),parameter:: a_coeff = 8.4_r_kind ! a (flashes/min) in tanh operator +! real(r_kind),parameter:: b_coeff = 12.248_r_kind ! b (flashes/min) in tanh operator +! real(r_kind),parameter:: c_coeff = 5.0e-10_r_kind ! c (radians/kg) in tanh operator +! real(r_kind),parameter:: d_coeff = 1.68e9_r_kind ! d (kg) in tanh operator +! real(r_kind),parameter:: fed_highbnd = 18.0_r_kind ! DCD: Sebok and Back (2021, unpublished) + +! coefficients for tanh operator, from work by A. Back with regional FV3 (2023) + real(r_kind),parameter:: a_coeff = -3.645_r_kind ! a (flashes/min) in tanh operator + real(r_kind),parameter:: b_coeff = 15.75_r_kind ! b (flashes/min) in tanh operator + real(r_kind),parameter:: c_coeff = 1.939e-10_r_kind ! c (radians/kg) in tanh operator + real(r_kind),parameter:: d_coeff = -1.215e9_r_kind ! d (kg) in tanh operator + real(r_kind),parameter:: fed_highbnd = 8.0_r_kind ! DCD: Back (2023, unpublished) for FV3 + + real(r_kind),parameter:: fed_height = 6500.0_r_kind ! assumed height (m) of FED observations + real(r_kind),parameter:: r0_001 = 0.001_r_kind + real(r_kind),parameter:: r8 = 8.0_r_kind + real(r_kind),parameter:: ten = 10.0_r_kind + real(r_kind),parameter:: D608=0.608_r_kind + character(len=*),parameter:: myname='setupfed' + +! Declare external calls for code analysis + external:: tintrp2a1 + external:: tintrp2a11 + external:: tintrp2a1116 + external:: tintrp31 + external:: grdcrd1 + external:: stop2 + +! Declare local variables + real(r_kind) rlow,rhgh,rsig + real(r_kind) dz + real(r_kind) jqg_num,jqg + real(r_kind) dlnp,pobl,zob + real(r_kind) sin2,termg,termr,termrg + real(r_kind) psges,zsges + real(r_kind),dimension(nsig):: zges,hges + real(r_kind) prsltmp(nsig) + real(r_kind) sfcchk + real(r_kind) residual,obserrlm,obserror,ratio,scale,val2 + real(r_kind) ress,ressw + real(r_kind) val,valqc,rwgt + real(r_kind) cg_w,wgross,wnotgross,wgt,arg,exp_arg,term,rat_err2 + real(r_double) rstation_id + real(r_kind) dlat,dlon,dtime,dpres,ddiff,error,slat,dlat8km,dlon8km + real(r_kind) ratio_errors + real(r_kind) presw + real(r_kind) errinv_input,errinv_adjst,errinv_final + real(r_kind) err_input,err_adjst,err_final + real(r_kind),dimension(nele,nobs):: data + real(r_kind),dimension(lat2,lon2,nfldsig)::rp + real(r_single),allocatable,dimension(:,:)::rdiagbuf + real(r_kind),allocatable,dimension(:,:,: ) :: ges_z + real(r_kind),allocatable,dimension(:,:,: ) :: ges_ps + real(r_kind),allocatable,dimension(:,:,:,:) :: ges_q + real(r_kind),allocatable,dimension(:,:,:,:) :: ges_qg,ges_qg_mask + + real(r_kind) :: presq + real(r_kind) :: T1D,RHO + real(r_kind) :: glmcoeff = 2.088_r_kind*10.0**(-8.0) ! Allen et al. (2016,MWR) + real(r_kind) :: CM = 0.5_r_kind ! tuning factor in eq. 14 of Kong et al. 2020 + + integer(i_kind) i,nchar,nreal,k,j,k1,ii,jj + integer(i_kind) mm1,k2 + integer(i_kind) jsig,ikxx,nn,ibin,ioff,ioff0 + integer(i_kind) ier,ilat,ilon,ifedob,ikx,itime,iuse + integer(i_kind) id,ilone,ilate + integer(i_kind) ier2 + + integer(i_kind) nlat_ll,nlon_ll,nsig_ll,nfld_ll + + integer(i_kind) ipres,iqmax,iqc,icat,itemp + integer(i_kind) istnelv,iobshgt,izz,iprvd,isprvd,iptrb + integer(i_kind) idomsfc,iskint,isfcr,iff10 + + character(8) station_id + character(8),allocatable,dimension(:):: cdiagbuf + character(80):: string + character(128):: diag_file + logical :: diagexist + logical,dimension(nobs):: luse,muse + integer(i_kind),dimension(nobs):: ioid ! initial (pre-distribution) obs ID + logical proceed + + equivalence(rstation_id,station_id) + integer(i_kind) numequal,numnotequal + + type(fedNode),pointer:: my_head + type(obs_diag),pointer:: my_diag + type(obs_diags),pointer:: my_diagLL + + real(r_kind),dimension(nsig+1):: prsitmp + + +!------------------------------------------------! + + integer(i_kind) :: itmp,jtmp + + integer(i_kind), parameter :: ntimesfed=1 + integer(i_kind),parameter :: nxfed=99, nyfed=99, nzfed=1, nfldfed=3 + real(r_kind),dimension(nobs) :: FEDMdiag,FEDMdiagTL + integer(i_kind) :: npt + real(r_kind) :: dlat_earth,dlon_earth + +! YPW added the next lines + logical :: l_set_oerr_ratio_fed=.False. + logical :: l_gpht2gmht = .True. + real(r_kind),dimension(nobs) :: dlatobs,dlonobs + integer(i_kind):: ngx,ngy,igx,jgy + real(r_kind):: dx_m, dy_m + + type(obsLList),pointer,dimension(:):: fedhead + fedhead => obsLL(:) + +!============================================================================================ +! Read and reformat observations in work arrays. + read(lunin)data,luse,ioid + + write(6,*)myname,'(pe=',mype,') nele nobs =',nele,nobs, & + 'luse_obsdiag=',luse_obsdiag,'lat2,lon2=',lat2,lon2 + + ier=1 ! index of obs error + ilon=2 ! index of grid relative obs location (x) + ilat=3 ! index of grid relative obs location (y) + ipres=4 ! index of pressure + ifedob=5 ! index of fed observation + id=6 ! index of station id + itime=7 ! index of observation time in data array + ikxx=8 ! index of ob type + iqmax=9 ! index of max error + itemp=10 ! index of dry temperature + iqc=11 ! index of quality mark + ier2=12 ! index of original-original obs error ratio + iuse=13 ! index of use parameter + idomsfc=14 ! index of dominant surface type + iskint=15 ! index of surface skin temperature + iff10=16 ! index of 10 meter wind factor + isfcr=17 ! index of surface roughness + ilone=18 ! index of longitude (degrees) + ilate=19 ! index of latitude (degrees) + istnelv=20 ! index of station elevation (m) + iobshgt=21 ! index of observation height (m) + izz=22 ! index of surface height + iprvd=23 ! index of observation provider + isprvd=24 ! index of observation subprovider + icat =25 ! index of data level category + iptrb=26 ! index of fed perturbation + do i=1,nobs + muse(i)=nint(data(iuse,i)) <= jiter + end do + + numequal=0 + numnotequal=0 + +! +! If requested, save select data for output to diagnostic file + if(fed_diagsave)then + ii=0 + nchar=1_i_kind + ioff0=26_i_kind ! 21 + 5 (22->Zr; 23->Zs; 24->Zg; 25->tsenges;26->RHO;) + nreal=ioff0 + if (lobsdiagsave) nreal=nreal+4*miter+1 + allocate(cdiagbuf(nobs),rdiagbuf(nreal,nobs)) + rdiagbuf=zero + if(netcdf_diag) call init_netcdf_diag_ + end if + mm1=mype+1 + scale=one + rsig=nsig + + + + !============================================================================================ +! +! Check to see if required guess fields are available +! vars. list: ps, z, q +! vars. list: qr, qs, qg + !============================================================================================ + + call check_vars_(proceed) + if(.not.proceed) then + write(6,*) myname,': some or all necessary variables are not available for fed obs operator. Quit!' + return ! not all vars available, simply return + end if + +! If require guess vars available, extract from bundle ... + call init_vars_ +! qscalar=zero + + !============================================================================================ + ! 1) Calculate the graupel-mass and graupel-volume based flash extent density + ! (FED) on model space, added by R. Kong, 07/05/2018 + !============================================================================================ + ges_qg_mask=ges_qg + where(ges_qg>0.0005) !Count the volume where qg > 0.5/kg + ges_qg_mask=1.0 + elsewhere + ges_qg_mask=0.0 + endwhere + + ! Operator start here + ! set ngx and ngy =2, so the integrated domain is 15kmx15km + ngx = 2 + ngy = 2 + dx_m = 3000. + dy_m = 3000. + print*,'FED Operator start here!,ngx=',ngx,'ngy=',ngy + rp=zero + + print*, 'mype = ', mype + print*, 'nfldsig = ', nfldsig + print*, 'nsig = ', nsig + print*, 'lon2 = ', lon2 + print*, 'lat2 = ', lat2 + +! compute graupel mass, in kg per 15 km x 15 km column + do jj=1,nfldsig + do k=1,nsig + do i=1,lon2 + do j=1,lat2 !How to handle MPI???? + do igx=1,2*ngx+1 !horizontal integration of qg around point to calculate FED + do jgy=1,2*ngy+1 + itmp = i-ngx+igx-1 + jtmp = j-ngy+jgy-1 + itmp = min(max(1,itmp),lon2) + jtmp = min(max(1,jtmp),lat2) + rp(j,i,jj)=rp(j,i,jj) + ges_qg(jtmp,itmp,k,jj)* & + dx_m*dy_m*(ges_prsi(jtmp,itmp,k,jj)-ges_prsi(jtmp,itmp,k+1,jj))*& + tpwcon * r10 + end do !igx + end do !jgy + end do !j + end do !i + end do !k + end do !jj + +! compute FED, in flashes/min + do jj=1,nfldsig + do i=1,lon2 + do j=1,lat2 + if (fed_obs_ob_shape .eq. 1) then + rp(j,i,jj) = CM * glmcoeff * rp(j,i,jj) + else if (fed_obs_ob_shape .eq. 2) then + rp(j,i,jj) = a_coeff + b_coeff & + * tanh(c_coeff * (rp(j,i,jj) - d_coeff)) + else + write(6,*) ' unknown fed_obs_ob_shape: ', fed_obs_ob_shape + write(6,*) ' aborting setupfed' + call stop2(999) + end if + if (rp(j,i,jj) .gt. fed_highbnd) rp(j,i,jj) = fed_highbnd + end do !j + end do !i + end do !jj + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(6,*) 'fed_obs_ob_shape=',fed_obs_ob_shape + if (fed_obs_ob_shape .eq. 2) then + write(6,*) 'a_coeff=',a_coeff + write(6,*) 'b_coeff=',b_coeff + write(6,*) 'c_coeff=',c_coeff + write(6,*) 'd_coeff=',d_coeff + end if + write(6,*) 'fed_highbnd=',fed_highbnd + write(6,*) 'maxval(ges_qg)=',maxval(ges_qg),'pe=',mype + + + !============================================================================================ + + nlat_ll=size(ges_qg,1) + nlon_ll=size(ges_qg,2) + nsig_ll=size(ges_qg,3) + nfld_ll=size(ges_qg,4) + + +! - Observation times are checked in read routine - comment out for now + +! call dtime_setup() + +!print*,"maxval(data(ifedob,:)),mmaxval(data(ilat,:))=",minval(data(ifedob,:)),maxval(data(ifedob,:)),maxval(data(ilat,:)) +!write(6,*) "OKOKOKOKOK, nobs=", nobs + do i=1,nobs + dtime=data(itime,i) + dlat=data(ilat,i) + dlon=data(ilon,i) + + dlon8km=data(iprvd,i) !iprvd=23 + dlat8km=data(isprvd,i) !isprvd=24 + + dpres=data(ipres,i) ! from rdararef_mosaic2: this height abv MSL + ikx = nint(data(ikxx,i)) + error=data(ier2,i) + slat=data(ilate,i)*deg2rad ! needed when converting geophgt to + dlon_earth = data(ilone,i) !the lontitude and latitude on the obs pts. + dlat_earth = data(ilate,i) + ! geometric hgh (hges --> zges below) + + if (nobs_bins>1) then + ibin = NINT( dtime/hr_obsbin ) + 1 + else + ibin = 1 + end if + + IF (ibin<1.OR.ibin>nobs_bins) write(6,*)mype,'Error nobs_bins,ibin= ',nobs_bins,ibin + + if (luse_obsdiag) my_diagLL => odiagLL(ibin) + +! Link obs to diagnostics structure + if(luse_obsdiag)then + my_diag => obsdiagLList_nextNode(my_diagLL ,& + create = .not.lobsdiag_allocated ,& + idv = is ,& + iob = ioid(i) ,& + ich = 1 ,& + elat = data(ilate,i) ,& + elon = data(ilone,i) ,& + luse = luse(i) ,& + miter = miter ) + if(.not.associated(my_diag)) call die(myname, & + 'obsdiagLList_nextNode(), create =',.not.lobsdiag_allocated) + end if + +! Interpolate terrain height(model elevation) to obs location. + call tintrp2a11(ges_z,zsges,dlat,dlon,dtime,hrdifsig,& + mype,nfldsig) +! print*,'i,after tintrp2all',i,mype,dlat,zsges +! 1. dpres (MRMS obs height is height above MSL) is adjusted by zsges, so it +! is changed to height relative to model elevation (terrain). +! because in GSI, geop_hgtl is the height relative to terrain (ges_z) +! (subroutine guess_grids) + dpres=dpres-zsges + if (dpres rsig)ratio_errors = zero + +!----------------------------------------------------------------------------! +! ! +! Implementation of forward operator for flash extend densit ----------------! +! ! +!----------------------------------------------------------------------------! + + !============================================================================================ + ! 3) H(x), interpolate the FED from model space on the local domain to obs space (FEDMdiag) + !============================================================================================ + + npt = 0 + FEDMdiag(i) = 0. + call tintrp2a11(rp,FEDMdiag(i),dlat,dlon,dtime,hrdifsig,mype,nfldsig) + dlonobs(i) = dlon_earth + dlatobs(i) = dlat_earth + + ! also Jacobian used for TLM and ADM + !FEDMdiagTL, used for gsi-3dvar,will be implemented in future...... + FEDMdiagTL(i) = 0. + jqg_num = FEDMdiagTL(i) !=dFED/Dqg + jqg = jqg_num + + + !end select + + if(FEDMdiag(i)==data(ifedob,i)) then + numequal=numequal+1 + else + numnotequal=numnotequal+1 + end if + +!!!!!!!!!!!!!!!!!END H(x)!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Compute innovations + !--------------Calculate departure from observation----------------! + + ddiff = data(ifedob,i) - FEDMdiag(i) + +! If requested, setup for single obs test. +! Note: do not use this way to run single obs test for fed in the current version. (g.zhao) + if (oneobtest) then + ddiff=maginnov +! if (trim(adjustl(oneob_type))=='fed') then +! data(ifedob,i) = maginnov +! ddiff = data(ifedob,i) - FEDMdiag(i) +! end if + error=one/(magoberr) + ratio_errors=one + end if + + +! Gross error checks + obserror = one/max(ratio_errors*error,tiny_r_kind) + obserrlm = max(cermin(ikx),min(cermax(ikx),obserror)) + + residual = abs(ddiff) != y-H(xb) + ratio = residual/obserrlm != y-H(xb)/sqrt(R) + + if (l_set_oerr_ratio_fed) then + if (ratio > cgross(ikx) .or. ratio_errors < tiny_r_kind) then + if (luse(i)) awork(4) = awork(4)+one + error = zero + ratio_errors = zero + end if + else + ratio_errors = one + end if + + if (ratio_errors*error <=tiny_r_kind) muse(i)=.false. +! if (nobskeep>0 .and. luse_obsdiag) muse(i)=obsdiags(i_fed_ob_type,ibin)%tail%muse(nobskeep) + if (nobskeep>0.and.luse_obsdiag) call obsdiagNode_get(my_diag, jiter=nobskeep, muse=muse(i)) + + val = error*ddiff !=y-H(xb)/sqrt(R) + +! Compute penalty terms (linear & nonlinear qc). + if(luse(i))then + exp_arg = -half*val**2 + rat_err2 = ratio_errors**2 + val2=val*val !(o-g)**2/R, would be saved in awork + if (cvar_pg(ikx) > tiny_r_kind .and. error > tiny_r_kind) then + arg = exp(exp_arg) + wnotgross= one-cvar_pg(ikx) + cg_w=cvar_b(ikx) + wgross = cg_term*cvar_pg(ikx)/(cg_w*wnotgross) + term = log((arg+wgross)/(one+wgross)) + wgt = one-wgross/(arg+wgross) + rwgt = wgt/wgtlim + else + term = exp_arg + wgt = wgtlim + rwgt = wgt/wgtlim + end if + valqc = -two*rat_err2*term + +! print*,'Compute penalty terms' +! Accumulate statistics for obs belonging to this task + if (muse(i)) then + if(rwgt < one) awork(21) = awork(21)+one + jsig = dpres + jsig=max(1,min(jsig,nsig)) + awork(6*nsig+jsig+100)=awork(6*nsig+jsig+100)+val2*rat_err2 + awork(5*nsig+jsig+100)=awork(5*nsig+jsig+100)+one + awork(3*nsig+jsig+100)=awork(3*nsig+jsig+100)+valqc + end if +! Loop over pressure level groupings and obs to accumulate +! statistics as a function of observation type. + ress = scale*ddiff + ressw = ress*ress + nn=1 + if (.not. muse(i)) then + nn=2 + if(ratio_errors*error >=tiny_r_kind)nn=3 + end if + do k = 1,npres_print +! if(presw >=ptop(k) .and. presw<=pbot(k))then + if(presq >=ptopq(k) .and. presq<=pbotq(k))then + bwork(k,ikx,1,nn) = bwork(k,ikx,1,nn)+one ! count + bwork(k,ikx,2,nn) = bwork(k,ikx,2,nn)+ddiff ! bias + bwork(k,ikx,3,nn) = bwork(k,ikx,3,nn)+ressw ! (o-g)**2 + bwork(k,ikx,4,nn) = bwork(k,ikx,4,nn)+val2*rat_err2 ! penalty + bwork(k,ikx,5,nn) = bwork(k,ikx,5,nn)+valqc ! nonlin qc penalty + + end if + end do + end if + + if(luse_obsdiag)then + call obsdiagNode_set(my_diag, luse=luse(i), wgtjo=(error*ratio_errors)**2, & + jiter=jiter, muse=muse(i), nldepart=ddiff) + end if + +! If obs is "acceptable", load array with obs info for use +! in inner loop minimization (int* and stp* routines) + if ( .not. last .and. muse(i)) then + + allocate(my_head) ! YPW added + call fedNode_appendto(my_head,fedhead(ibin)) + + my_head%idv=is + my_head%iob=i + my_head%elat= data(ilate,i) + my_head%elon= data(ilone,i) + + my_head%dlev= dpres + call get_ijk(mm1,dlat,dlon,dpres,my_head%ij,my_head%wij) + my_head%res = ddiff ! Observation - ges + my_head%err2 = error**2 + my_head%raterr2 = ratio_errors**2 + my_head%time = dtime + my_head%b = cvar_b(ikx) + my_head%pg = cvar_pg(ikx) + my_head%luse = luse(i) + + if(oberror_tune) then + ! my_head%fedpertb=data(iptrb,i)/error/ratio_errors + my_head%kx=ikx + if(presq > ptabl(2))then + my_head%k1=1 + else if( presq <= ptabl(33)) then + my_head%k1=33 + else + k_loop: do k=2,32 + if(presq > ptabl(k+1) .and. presq <= ptabl(k)) then + my_head%k1=k + exit k_loop + end if + end do k_loop + end if + end if +!------------------------------------------------- + + if(luse_obsdiag)then + call obsdiagNode_assert(my_diag,my_head%idv,my_head%iob,1,myname,'my_diag:my_head') + my_head%diags => my_diag + end if + + my_head => null() + end if + +! Save select output for diagnostic file + if(.not.luse(i))write(6,*)' luse, mype',luse(i),mype + if(fed_diagsave .and. luse(i))then + ii=ii+1 + rstation_id = data(id,i) + err_input = data(ier2,i) + err_adjst = data(ier,i) + if (ratio_errors*error>tiny_r_kind) then + err_final = one/(ratio_errors*error) + else + err_final = huge_single + end if + errinv_input = huge_single + errinv_adjst = huge_single + errinv_final = huge_single + if (err_input>tiny_r_kind) errinv_input = one/err_input + if (err_adjst>tiny_r_kind) errinv_adjst = one/err_adjst + if (err_final>tiny_r_kind) errinv_final = one/err_final + + if(binary_diag) call contents_binary_diag_(my_diag) + if(netcdf_diag) call contents_netcdf_diag_(my_diag) + + end if + end do + +! Release memory of local guess arrays + call final_vars_ + +! Write information to diagnostic file + if(fed_diagsave .and. netcdf_diag) call nc_diag_write + if(fed_diagsave .and. binary_diag .and. ii>0)then + + write(string,600) jiter +600 format('fed_',i2.2) + diag_file=trim(dirname) // trim(string) + if(init_pass) then + open(66,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + else + inquire(file=trim(diag_file),exist=diagexist) + if (diagexist) then + open(66,file=trim(diag_file),form='unformatted',status='old',position='append') + else + open(66,file=trim(diag_file),form='unformatted',status='unknown',position='rewind') + end if + end if + if(init_pass .and. mype == 0) then + write(66) ianldate + write(6,*)'SETUPFED: write time record to file ',& + trim(diag_file), ' ',ianldate + end if + +! call dtime_show(myname,'diagsave:fed',i_fed_ob_type) + write(66)'fed',nchar,nreal,ii,mype,ioff0 + write(66)cdiagbuf(1:ii),rdiagbuf(:,1:ii) + ! write(6,*)'fed,nchar,nreal,ii,mype',nchar,nreal,ii,mype + deallocate(cdiagbuf,rdiagbuf) + close(66) + end if + +! End of routine + + +! return + + contains + + subroutine check_vars_ (proceed) + + + logical,intent(inout) :: proceed + integer(i_kind) ivar, istatus +! Check to see if required guess fields are available + call gsi_metguess_get ('var::ps', ivar, istatus ) + proceed=ivar>0 + call gsi_metguess_get ('var::z' , ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::q' , ivar, istatus ) + proceed=proceed.and.ivar>0 +! call gsi_metguess_get ('var::tv' , ivar, istatus ) +! proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qs', ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qg', ivar, istatus ) + proceed=proceed.and.ivar>0 + call gsi_metguess_get ('var::qr', ivar, istatus ) + proceed=proceed.and.ivar>0 + end subroutine check_vars_ + + + subroutine init_vars_ + +! use radaremul_cst, only: mphyopt + + real(r_kind),dimension(:,: ),pointer:: rank2=>NULL() + real(r_kind),dimension(:,:,:),pointer:: rank3=>NULL() + character(len=5) :: varname + integer(i_kind) ifld, istatus + +! If require guess vars available, extract from bundle ... + if(size(gsi_metguess_bundle)==nfldsig) then +! get ps ... + varname='ps' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus) + if (istatus==0) then + if(allocated(ges_ps))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_ps(size(rank2,1),size(rank2,2),nfldsig)) + ges_ps(:,:,1)=rank2 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus) + ges_ps(:,:,ifld)=rank2 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get z ... + varname='z' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus) + if (istatus==0) then + if(allocated(ges_z))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_z(size(rank2,1),size(rank2,2),nfldsig)) + ges_z(:,:,1)=rank2 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus) + ges_z(:,:,ifld)=rank2 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get q ... + varname='q' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) + if (istatus==0) then + if(allocated(ges_q))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_q(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + ges_q(:,:,:,1)=rank3 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) + ges_q(:,:,:,ifld)=rank3 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if +! get tv ... +! varname='tv' +! call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) +! if (istatus==0) then +! if(allocated(ges_tv))then +! write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' +! call stop2(999) +! end if +! allocate(ges_tv(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) +! ges_tv(:,:,:,1)=rank3 +! do ifld=2,nfldsig +! call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) +! ges_tv(:,:,:,ifld)=rank3 +! ges_tv(:,:,:,ifld)=rank3 +! end do +! else +! write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus +! call stop2(999) +! end if +! get qr ... +! get qg ... + varname='qg' + call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus) + if (istatus==0) then + if(allocated(ges_qg))then + write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc ' + call stop2(999) + end if + allocate(ges_qg(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + if(.not. allocated(ges_qg_mask))then + allocate(ges_qg_mask(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig)) + end if + + ges_qg(:,:,:,1)=rank3 + do ifld=2,nfldsig + call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus) + ges_qg(:,:,:,ifld)=rank3 + end do + else + write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus + call stop2(999) + end if + else + write(6,*) trim(myname), ': inconsistent vector sizes (nfldsig,size(metguess_bundle) ',& + nfldsig,size(gsi_metguess_bundle) + call stop2(999) + end if + end subroutine init_vars_ + + subroutine init_netcdf_diag_ + character(len=80) string + character(len=128) diag_conv_file + integer(i_kind) ncd_fileid,ncd_nobs + logical append_diag + logical,parameter::verbose=.false. + write(string,900) jiter +900 format('conv_fed_',i2.2,'.nc4') + diag_conv_file=trim(dirname) // trim(string) + + inquire(file=diag_conv_file, exist=append_diag) + + if (append_diag) then + call nc_diag_read_init(diag_conv_file,ncd_fileid) + ncd_nobs = nc_diag_read_get_dim(ncd_fileid,'nobs') + call nc_diag_read_close(diag_conv_file) + + if (ncd_nobs > 0) then + if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists. Appending. nobs,mype=',ncd_nobs,mype + else + if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists but contains no obs. Not appending. nobs,mype=',ncd_nobs,mype + append_diag = .false. ! if there are no obs in existing file, then do not try to append + end if + end if + + call nc_diag_init(diag_conv_file, append=append_diag) + + if (.not. append_diag) then ! don't write headers on append - the module will break? + call nc_diag_header("date_time",ianldate ) + call nc_diag_header("Number_of_state_vars", nsdim ) + end if + end subroutine init_netcdf_diag_ + subroutine contents_binary_diag_(odiag) + type(obs_diag),pointer,intent(in):: odiag + + cdiagbuf(ii) = station_id ! station id + + rdiagbuf(1,ii) = ictype(ikx) ! observation type + rdiagbuf(2,ii) = icsubtype(ikx) ! observation subtype + + rdiagbuf(3,ii) = data(ilate,i) ! observation latitude (degrees) + rdiagbuf(4,ii) = data(ilone,i) ! observation longitude (degrees) + + rdiagbuf(5,ii) = data(istnelv,i) ! station elevation (meters) + rdiagbuf(6,ii) = presq ! observation pressure (hPa) + rdiagbuf(7,ii) = fed_height ! observation height (meters) + rdiagbuf(8,ii) = (dtime*r60)-time_offset ! obs time (sec relative to analysis time) + rdiagbuf(9,ii) = data(iqc,i) ! input prepbufr qc or event mark + rdiagbuf(10,ii) = rmiss_single ! setup qc or event mark + rdiagbuf(11,ii) = data(iuse,i) ! read_prepbufr data usage flag + if(muse(i)) then + rdiagbuf(12,ii) = one ! analysis usage flag (1=use, -1=not used) + else + rdiagbuf(12,ii) = -one + end if + + rdiagbuf(13,ii) = rwgt ! nonlinear qc relative weight + rdiagbuf(14,ii) = errinv_input ! prepbufr inverse obs error (dBZ)**-1 + rdiagbuf(15,ii) = errinv_adjst ! read_prepbufr inverse obs error (dBZ)**-1 + rdiagbuf(16,ii) = errinv_final ! final inverse observation error (dBZ)**-1 + rdiagbuf(17,ii) = data(ifedob,i) ! radar reflectivity observation (dBZ) + rdiagbuf(18,ii) = ddiff ! obs-ges (dBZ) + rdiagbuf(19,ii) = data(ifedob,i)-FEDMdiag(i) ! obs-ges w/o bias correction (dBZ) (future slot) + rdiagbuf(20,ii) = dlat8km ! j-index on 8km bufr obs grid + rdiagbuf(21,ii) = dlon8km ! i-index on 8km bufr obs grid + +! print*,'data(ilat,i)=',data(ilat,i),'data(ilon,i)=',data(ilon,i) + + rdiagbuf(22,ii) = FEDMdiag(i) ! dBZ from rain water + + rdiagbuf(23,ii) = T1D ! temperature (sensible, K) + rdiagbuf(24,ii) = RHO ! air density (kg/m**3) + + if (lobsdiagsave) then + write(6,*)'wrong here, stop in setupfed.f90 ' + stop + ioff=nreal + do jj=1,miter + ioff=ioff+1 + if (odiag%muse(jj)) then + rdiagbuf(ioff,ii) = one + else + rdiagbuf(ioff,ii) = -one + end if + end do + do jj=1,miter+1 + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%nldepart(jj) + end do + do jj=1,miter + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%tldepart(jj) + end do + do jj=1,miter + ioff=ioff+1 + rdiagbuf(ioff,ii) = odiag%obssen(jj) + end do + end if + + end subroutine contents_binary_diag_ + subroutine contents_netcdf_diag_(odiag) + type(obs_diag),pointer,intent(in):: odiag +! Observation class + character(7),parameter :: obsclass = ' fed' + real(r_kind),dimension(miter) :: obsdiag_iuse + call nc_diag_metadata("Station_ID", station_id ) + call nc_diag_metadata("Observation_Class", obsclass ) + call nc_diag_metadata("Observation_Type", ictype(ikx) ) + call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) + call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) + call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) + call nc_diag_metadata("Pressure", sngl(presq) ) + call nc_diag_metadata("Height", sngl(fed_height) ) + call nc_diag_metadata("Time", sngl(dtime*r60-time_offset)) + call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) + call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) +! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ! ) + call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + if(muse(i)) then + call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + else + call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + end if + + call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) + call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) + call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + + call nc_diag_metadata("Observation", sngl(data(ifedob,i)) ) + call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) + call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(ifedob,i)-FEDMdiag(i)) ) + if (lobsdiagsave) then + do jj=1,miter + if (odiag%muse(jj)) then + obsdiag_iuse(jj) = one + else + obsdiag_iuse(jj) = -one + end if + end do + + call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) + call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) + call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) + call nc_diag_data2d("ObsDiagSave_obssen" , odiag%obssen ) + end if + + end subroutine contents_netcdf_diag_ + + subroutine final_vars_ + if(allocated(ges_z )) deallocate(ges_z ) + if(allocated(ges_q )) deallocate(ges_q ) +! if(allocated(ges_tv)) deallocate(ges_tv) + if(allocated(ges_ps)) deallocate(ges_ps) + if(allocated(ges_qg)) deallocate(ges_qg) + end subroutine final_vars_ + + subroutine init_qcld(t_cld, qxmin_cld, icat_cld, t_dpnd) + use kinds, only: r_kind,r_single,r_double,i_kind + implicit none + real(r_kind), intent(in ) :: t_cld + real(r_kind), intent(inout) :: qxmin_cld + integer, intent(in ) :: icat_cld + logical, intent(in ) :: t_dpnd +! +! local variables + real :: tr_ll, qrmin_ll, tr_hl, qrmin_hl + real :: ts_ll, qsmin_ll, ts_hl, qsmin_hl + real :: tg_ll, qgmin_ll, tg_hl, qgmin_hl + real :: qr_min, qs_min, qg_min +!------------------------------------------------------ + + qr_min = 5.0E-6_r_kind + qs_min = 5.0E-6_r_kind + qg_min = 5.0E-6_r_kind + tr_ll = 275.65; qrmin_ll = 5.0E-6_r_kind; + tr_hl = 270.65; qrmin_hl = 1.0E-8_r_kind; + ts_ll = 275.65; qsmin_ll = 1.0E-8_r_kind; + ts_hl = 270.65; qsmin_hl = 5.0E-6_r_kind; + tg_ll = 275.65; qgmin_ll = 1.0E-6_r_kind; + tg_hl = 270.65; qgmin_hl = 5.0E-6_r_kind; + + select case (icat_cld) + case (1) + if ( t_dpnd ) then + if (t_cld <= tr_hl) then + qxmin_cld = qrmin_hl + else if (t_cld >= tr_ll) then + qxmin_cld = qrmin_ll + else + qxmin_cld = (qrmin_hl + qrmin_ll) * 0.5 + end if + else + qxmin_cld = qr_min + end if + case default + write(6,*) 'wrong cloud hydrometer category ID',icat_cld + end select + + return + + end subroutine init_qcld + +end subroutine setupfed +end module fed_setup diff --git a/src/gsi/setuprhsall.f90 b/src/gsi/setuprhsall.f90 index 3efcb69859..8075956431 100644 --- a/src/gsi/setuprhsall.f90 +++ b/src/gsi/setuprhsall.f90 @@ -168,6 +168,7 @@ subroutine setuprhsall(ndata,mype,init_pass,last_pass) i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp use m_rhs, only: i_dbz + use m_rhs, only: i_fed use m_rhs, only: i_light use m_gpsStats, only: gpsStats_genstats ! was genstats_gps() @@ -625,7 +626,7 @@ subroutine setuprhsall(ndata,mype,init_pass,last_pass) call statsconv(mype,& i_ps,i_uv,i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag, & i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & - i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_dbz, & + i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_fed,i_dbz, & size(awork1,2),bwork1,awork1,ndata) ! Compute and print statistics for "lightning" data diff --git a/src/gsi/statsconv.f90 b/src/gsi/statsconv.f90 index a01675d8d0..0da8606f24 100644 --- a/src/gsi/statsconv.f90 +++ b/src/gsi/statsconv.f90 @@ -2,7 +2,7 @@ subroutine statsconv(mype,& i_ps,i_uv,i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag, & i_gust,i_vis,i_pblh,i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv, & i_tcamt,i_lcbas,i_cldch,i_uwnd10m,i_vwnd10m,& - i_swcp,i_lwcp,i_dbz,i_ref,bwork,awork,ndata) + i_swcp,i_lwcp,i_fed,i_dbz,i_ref,bwork,awork,ndata) !$$$ subprogram documentation block ! . . . . ! subprogram: statconv prints statistics for conventional data @@ -74,6 +74,7 @@ subroutine statsconv(mype,& ! i_vwnd10m- index in awork array holding vwnd10m info ! i_swcp - index in awork array holding swcp info ! i_lwcp - index in awork array holding lwcp info +! i_fed - index in awork array holding fed info ! i_dbz - index in awork array holding dbz info ! i_ref - size of second dimension of awork array ! bwork - array containing information for statistics @@ -96,12 +97,12 @@ subroutine statsconv(mype,& iout_gust,iout_vis,iout_pblh,iout_wspd10m,iout_td2m,& iout_mxtm,iout_mitm,iout_pmsl,iout_howv,iout_tcamt,iout_lcbas,iout_cldch,& iout_uwnd10m,iout_vwnd10m,& - iout_dbz,iout_swcp,iout_lwcp,& + iout_fed,iout_dbz,iout_swcp,iout_lwcp,& mype_dw,mype_rw,mype_sst,mype_gps,mype_uv,mype_ps,& mype_t,mype_pw,mype_q,mype_tcp,ndat,dtype,mype_lag,mype_gust,& mype_vis,mype_pblh,mype_wspd10m,mype_td2m,mype_mxtm,mype_mitm,& mype_pmsl,mype_howv,mype_tcamt,mype_lcbas,mype_cldch,mype_uwnd10m,mype_vwnd10m,& - mype_dbz,mype_swcp,mype_lwcp + mype_fed,mype_dbz,mype_swcp,mype_lwcp use qcmod, only: npres_print,ptop,pbot,ptopq,pbotq use jfunc, only: first,jiter use gridmod, only: nsig @@ -112,7 +113,7 @@ subroutine statsconv(mype,& integer(i_kind) ,intent(in ) :: mype,i_ps,i_uv,& i_t,i_q,i_pw,i_rw,i_dw,i_gps,i_sst,i_tcp,i_lag,i_gust,i_vis,i_pblh,& i_wspd10m,i_td2m,i_mxtm,i_mitm,i_pmsl,i_howv,i_tcamt,i_lcbas,& - i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_dbz,i_ref + i_cldch,i_uwnd10m,i_vwnd10m,i_swcp,i_lwcp,i_fed,i_dbz,i_ref real(r_kind),dimension(7*nsig+100,i_ref) ,intent(in ) :: awork real(r_kind),dimension(npres_print,nconvtype,5,3),intent(in ) :: bwork integer(i_kind),dimension(ndat,3) ,intent(in ) :: ndata @@ -136,6 +137,7 @@ subroutine statsconv(mype,& real(r_kind) dwqcplty,tqcplty,qctt,qctrw,rwqcplty,qctdw,qqcplty,qctgps real(r_kind) gpsqcplty,tpw3,pw3,qctq real(r_kind) tswcp3,tlwcp3,qctdbz,dbzqcplty + real(r_kind) fedmplty,tfed,qctfed,fedqcplty real(r_kind),dimension(1):: pbotall,ptopall logical,dimension(nconvtype):: pflag @@ -1325,6 +1327,68 @@ subroutine statsconv(mype,& end if end if +! Summary report for flash extent density + if(mype==mype_fed) then + nread=0 + nkeep=0 + do i=1,ndat + if(dtype(i)== 'fed')then + nread=nread+ndata(i,2) + nkeep=nkeep+ndata(i,3) + end if + end do + if(nread > 0)then + if(first)then + open(iout_fed) + else + open(iout_fed,position='append') + end if + + fedmplty=zero; fedqcplty=zero ; ntot=0 + tfed=zero ; qctfed=zero + if(nkeep > 0)then + mesage='current vfit of flash extent density, ranges in flashes per minute$' + do j=1,nconvtype + pflag(j)=trim(ioctype(j)) == 'fed' + end do + call dtast(bwork,npres_print,pbot,ptop,mesage,jiter,iout_fed,pflag) + + numgross=nint(awork(4,i_fed)) + numfailqc=nint(awork(21,i_fed)) + do k=1,nsig + num(k)=nint(awork(k+5*nsig+100,i_fed)) + rat=zero + rat3=zero + if(num(k) > 0) then + rat=awork(6*nsig+k+100,i_fed)/float(num(k)) + rat3=awork(3*nsig+k+100,i_fed)/float(num(k)) + end if + ntot=ntot+num(k) + fedmplty=fedmplty+awork(6*nsig+k+100,i_fed) + fedqcplty=fedqcplty+awork(3*nsig+k+100,i_fed) + write(iout_fed,240) 'r',num(k),k,awork(6*nsig+k+100,i_fed), & + awork(3*nsig+k+100,i_fed),rat,rat3 + end do + if(ntot > 0) then + tfed=fedmplty/float(ntot) + qctfed=fedqcplty/float(ntot) + end if + write(iout_fed,925) 'fed',numgross,numfailqc + numlow = nint(awork(2,i_fed)) + numhgh = nint(awork(3,i_fed)) + nhitopo = nint(awork(5,i_fed)) + ntoodif = nint(awork(6,i_fed)) + write(iout_fed,900) 'fed',numhgh,numlow + write(iout_fed,905) 'fed',nhitopo,ntoodif + end if + write(iout_fed,950) 'fed',jiter,nread,nkeep,ntot + write(iout_fed,951) 'fed',fedmplty,fedqcplty,tfed,qctfed + + close(iout_fed) + end if + end if + + if(mype==mype_tcp) then nread=0 nkeep=0 From a6515bd8f429aea987a572a5de8a073801d566c4 Mon Sep 17 00:00:00 2001 From: RussTreadon-NOAA <26926959+RussTreadon-NOAA@users.noreply.github.com> Date: Tue, 12 Sep 2023 08:45:06 -0400 Subject: [PATCH 4/6] add missing jacobian arrays to netcdf ozone diagnostic file (#618) (#619) **Description** PR #591 removed jacobian information from the netcdf ozone diagnostic file. This caused `enkf.x` to crash. This PR adds the removed ozone jacobian arrays back to the netcdf ozone diagnostic file. Fixes #618 **Type of change** - [x] Bug fix (non-breaking change which fixes an issue) **How Has This Been Tested?** The revised code was tested in the 20210814 18 gdas cycle of a C192L127 enkf parallel. The updated `gsi.x` created an oznstat file which was successfully processed by `enkf.x`. **Checklist** - [x] My code follows the style guidelines of this project - [x] I have performed a self-review of my own code - [x] New and existing tests pass with my changes --- src/gsi/setupoz.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90 index 2008f37559..34f94d3a10 100644 --- a/src/gsi/setupoz.f90 +++ b/src/gsi/setupoz.f90 @@ -636,8 +636,9 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& call nc_diag_metadata("Row_Anomaly_Index", sngl(rmiss) ) endif if (save_jacobian) then - call fullarray(dhx_dx, dhx_dx_array) - call nc_diag_data2d("Observation_Operator_Jacobian", dhx_dx_array) + call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) + call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) + call nc_diag_data2d("Observation_Operator_Jacobian_val", real(dhx_dx%val,r_single)) endif !if (wrtgeovals) then ! call nc_diag_data2d("mole_fraction_of_ozone_in_air", sngl(constoz*ozgestmp)) From c46f5900233122c15f47428b6ee714c66b4a08b4 Mon Sep 17 00:00:00 2001 From: Ming Hu Date: Tue, 12 Sep 2023 14:25:40 -0400 Subject: [PATCH 5/6] Update intel compile to Intel2022 (#571) * caveat - the wcoss2 build remains at intel/19 --------- Co-authored-by: David Huber Co-authored-by: Natalie Perlin Co-authored-by: RussTreadon-NOAA --- ci/spack.yaml | 4 +- modulefiles/gsi_cheyenne.gnu.lua | 20 +- modulefiles/gsi_cheyenne.intel.lua | 6 +- modulefiles/gsi_common.lua | 7 +- modulefiles/gsi_gaea | 62 -- modulefiles/gsi_gaea.lua | 34 ++ modulefiles/gsi_hera.gnu.lua | 12 +- modulefiles/gsi_hera.intel.lua | 17 +- modulefiles/gsi_jet.lua | 15 +- modulefiles/gsi_orion.lua | 14 +- modulefiles/gsi_s4.lua | 6 +- regression/regression_driver.sh | 2 + regression/regression_param.sh | 71 ++- regression/regression_var.sh | 25 +- src/enkf/observer_gfs.f90 | 15 +- src/gsi/ensctl2state.f90 | 9 +- src/gsi/ensctl2state_ad.f90 | 9 +- src/gsi/general_read_fv3atm.f90 | 1 + src/gsi/genstats_gps.f90 | 44 +- src/gsi/gsi_rfv3io_mod.f90 | 932 ++++++++++++++++------------- src/gsi/gsimod.F90 | 2 +- src/gsi/guess_grids.F90 | 48 +- src/gsi/mpeu_util.F90 | 16 - src/gsi/obsmod.F90 | 36 +- src/gsi/read_files.f90 | 2 +- src/gsi/read_iasi.f90 | 2 + src/gsi/read_obs.F90 | 4 - src/gsi/read_prepbufr.f90 | 66 +- src/gsi/read_radar.f90 | 2 +- src/gsi/setupaod.f90 | 21 +- src/gsi/setupdbz.f90 | 36 +- src/gsi/setupdw.f90 | 32 +- src/gsi/setuplight.f90 | 32 +- src/gsi/setuplwcp.f90 | 38 +- src/gsi/setupoz.f90 | 73 +-- src/gsi/setupps.f90 | 41 +- src/gsi/setuppw.f90 | 32 +- src/gsi/setupq.f90 | 90 +-- src/gsi/setuprad.f90 | 163 ++--- src/gsi/setuprw.f90 | 44 +- src/gsi/setupspd.f90 | 36 +- src/gsi/setupsst.f90 | 42 +- src/gsi/setupswcp.f90 | 34 +- src/gsi/setupt.f90 | 76 +-- src/gsi/setuptcp.f90 | 28 +- src/gsi/setupw.f90 | 56 +- src/gsi/stpcalc.f90 | 22 +- ush/build.sh | 1 - ush/detect_machine.sh | 3 +- ush/module-setup.sh | 29 +- ush/sub_cheyenne | 169 ++++++ ush/sub_discover | 2 +- ush/sub_gaea | 170 ++++++ ush/sub_hera | 2 +- ush/sub_jet | 52 +- ush/sub_orion | 2 +- ush/sub_wcoss2 | 21 +- 57 files changed, 1658 insertions(+), 1172 deletions(-) delete mode 100644 modulefiles/gsi_gaea create mode 100644 modulefiles/gsi_gaea.lua create mode 100644 ush/sub_cheyenne create mode 100755 ush/sub_gaea diff --git a/ci/spack.yaml b/ci/spack.yaml index a831de16ad..0fc66547e5 100644 --- a/ci/spack.yaml +++ b/ci/spack.yaml @@ -15,11 +15,11 @@ spack: - ip@3.3.3 - sigio@2.3.2 - sfcio@1.4.1 - - nemsio@2.5.2 + - nemsio@2.5.4 - wrf-io@1.2.0 - ncio@1.1.2 - crtm@2.4.0 - - gsi-ncdiag@1.0.0 + - gsi-ncdiag@1.1.1 view: true concretizer: unify: true diff --git a/modulefiles/gsi_cheyenne.gnu.lua b/modulefiles/gsi_cheyenne.gnu.lua index 494ec6fb18..43e6aaf02c 100644 --- a/modulefiles/gsi_cheyenne.gnu.lua +++ b/modulefiles/gsi_cheyenne.gnu.lua @@ -4,26 +4,24 @@ help([[ load("cmake/3.22.0") load("python/3.7.9") load("ncarenv/1.3") -load("gnu/10.1.0") -load("mpt/2.22") +load("gnu/11.2.0") +load("mpt/2.25") load("ncarcompilers/0.5.0") +unload("intel") unload("netcdf") -prepend_path("MODULEPATH", "/glade/work/epicufsrt/GMTB/tools/gnu/10.1.0/hpc-stack-v1.2.0/modulefiles/stack") +prepend_path("MODULEPATH", "/glade/work/epicufsrt/contrib/hpc-stack/gnu11.2.0/modulefiles/stack") load("hpc/1.2.0") -load("hpc-gnu/10.1.0") -load("hpc-mpt/2.22") - --- Preload w3nco to work around nemsio "find_dependency(w3nco)" hpc-stack bug -load("w3nco/2.4.1") +load("hpc-gnu/11.2.0") +load("hpc-mpt/2.25") load("gsi_common") -local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" -load(pathJoin("prod_util", prod_util_ver)) +load(pathJoin("prod_util", os.getenv("prod_util_ver") or "1.2.2")) +load(pathJoin("openblas", os.getenv("openblas_ver") or "0.3.23")) -pushenv("MKLROOT", "/glade/u/apps/opt/intel/2022.1/mkl/latest") +pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_fix/fix") pushenv("CC", "mpicc") pushenv("FC", "mpif90") diff --git a/modulefiles/gsi_cheyenne.intel.lua b/modulefiles/gsi_cheyenne.intel.lua index 72bf458516..4a3525bca1 100644 --- a/modulefiles/gsi_cheyenne.intel.lua +++ b/modulefiles/gsi_cheyenne.intel.lua @@ -8,7 +8,7 @@ load("intel/2022.1") load("mpt/2.25") load("ncarcompilers/0.5.0") -prepend_path("MODULEPATH", "/glade/work/epicufsrt/GMTB/tools/intel/2022.1/hpc-stack-v1.2.0_6eb6/modulefiles/stack") +prepend_path("MODULEPATH", "/glade/work/epicufsrt/contrib/hpc-stack/intel2022.1/modulefiles/stack") load("hpc/1.2.0") load("hpc-intel/2022.1") @@ -17,8 +17,8 @@ load("mkl/2022.1") load("gsi_common") -local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" -load(pathJoin("prod_util", prod_util_ver)) +load(pathJoin("prod_util", os.getenv("prod_util_ver") or "1.2.2")) +pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_data/fix/20230601") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_common.lua b/modulefiles/gsi_common.lua index b2b08f1197..c54f6ddb92 100644 --- a/modulefiles/gsi_common.lua +++ b/modulefiles/gsi_common.lua @@ -6,16 +6,16 @@ local netcdf_ver=os.getenv("netcdf_ver") or "4.7.4" local bufr_ver=os.getenv("bufr_ver") or "11.7.0" local bacio_ver=os.getenv("bacio_ver") or "2.4.1" -local w3emc_ver=os.getenv("w3emc_ver") or "2.9.1" +local w3emc_ver=os.getenv("w3emc_ver") or "2.9.2" local sp_ver=os.getenv("sp_ver") or "2.3.3" local ip_ver=os.getenv("ip_ver") or "3.3.3" local sigio_ver=os.getenv("sigio_ver") or "2.3.2" local sfcio_ver=os.getenv("sfcio_ver") or "1.4.1" -local nemsio_ver=os.getenv("nemsio_ver") or "2.5.2" +local nemsio_ver=os.getenv("nemsio_ver") or "2.5.4" local wrf_io_ver=os.getenv("wrf_io_ver") or "1.2.0" local ncio_ver=os.getenv("ncio_ver") or "1.1.2" local crtm_ver=os.getenv("crtm_ver") or "2.4.0" -local ncdiag_ver=os.getenv("ncdiag_ver") or "1.0.0" +local ncdiag_ver=os.getenv("ncdiag_ver") or "1.1.1" load(pathJoin("netcdf", netcdf_ver)) @@ -31,4 +31,3 @@ load(pathJoin("wrf_io", wrf_io_ver)) load(pathJoin("ncio", ncio_ver)) load(pathJoin("crtm", crtm_ver)) load(pathJoin("ncdiag",ncdiag_ver)) - diff --git a/modulefiles/gsi_gaea b/modulefiles/gsi_gaea deleted file mode 100644 index 641f3d0fcf..0000000000 --- a/modulefiles/gsi_gaea +++ /dev/null @@ -1,62 +0,0 @@ -#%Module1.0 -###################################################################### -## NOAA-EMC/GSI -##_____________________________________________________ -proc ModulesHelp { } { -puts stderr "Set environment variables for NOAA-EMC/GSI" -puts stderr "This module initializes the environment " -puts stderr "for the Intel Compiler Suite $version\n" -} -module-whatis " NOAA-EMC/GSI whatis description" - -set COMPILER intel - -setenv FFLAGS_COM "-fp-model strict" -setenv LDFLAGS_COM " " - -#set WRF_SHARED_VER v1.1.0 -#set WRF_SHARED_ROOT /gpfs/hps/nco/ops/nwprod/wrf_shared -#set WRF_SHARED_ROOT /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib/EXTERNAL/wrf_shared -#setenv WRF_SHARED_PATH ${WRF_SHARED_ROOT}.${WRF_SHARED_VER} - -setenv NCEPLIBS /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib - -# Loading ncep environment -##module load ncep/1.0 -module use /opt/cray/pe/craype/2.5.5/modulefiles - -# Loading Intel Compiler Suite -module load PrgEnv-intel - -# Loading pe environment -module load cray-mpich -module load cray-libsci -module unload craype-broadwell -module load craype-haswell - -module use /sw/gaea/modulefiles -module load cmake - -# Loading nceplibs modules -module use /lustre/f1/pdata/ncep_shared/NCEPLIBS/lib/modulefiles -#module load HDF5-serial-intel-haswell/1.8.9 -#module load NetCDF-intel-haswell/4.2 -module load cray-hdf5 -module load cray-netcdf - -#module use /gpfs/hps/nco/ops/nwprod/lib/modulefiles -module load bufr-intel-sandybridge/11.0.1 -module load nemsio-intel-sandybridge/2.2.2 -module load sfcio-intel-sandybridge/1.0.0 -module load sigio-intel-sandybridge/2.0.1 -module load sp-intel-sandybridge/2.0.2 -module load w3nco-intel-sandybridge/2.0.6 -module load w3emc-intel-sandybridge/2.2.0 -module load bacio-intel-sandybridge/2.0.2 -setenv CRAYOS_VERSION $::env(CRAYPE_VERSION) -#setenv CRAYOS_VERSION ${CRAYPE_VERSION} - -# Compiler flags specific to this platform -setenv CFLAGS "-xCORE-AVX2" -setenv FFLAGS "-xCORE-AVX2" - diff --git a/modulefiles/gsi_gaea.lua b/modulefiles/gsi_gaea.lua new file mode 100644 index 0000000000..f76c8f3ad9 --- /dev/null +++ b/modulefiles/gsi_gaea.lua @@ -0,0 +1,34 @@ +help([[ +]]) + +load("cmake/3.20.1") + +prepend_path("MODULEPATH","/lustre/f2/dev/role.epic/contrib/hpc-stack/intel-classic-2022.0.2/modulefiles/stack") +load(pathJoin("hpc", os.getenv("hpc_ver") or "1.2.0")) + +load(pathJoin("intel-classic", os.getenv("intel_classic_ver") or "2022.0.2")) +load(pathJoin("cray-mpich", os.getenv("cray_mpich_ver") or "7.7.20")) +load(pathJoin("hpc-intel-classic", os.getenv("hpc_intel_classic_ver") or "2022.0.2")) +load(pathJoin("hpc-cray-mpich", os.getenv("hpc_cray_mpich_ver") or "7.7.20")) + +load("gsi_common") + +local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +load(pathJoin("prod_util", prod_util_ver)) + +-- Needed at runtime: +load("alps") + +local MKLROOT="/opt/intel/oneapi/mkl/2022.0.2/" +prepend_path("LD_LIBRARY_PATH",pathJoin(MKLROOT,"lib/intel64")) +pushenv("MKLROOT", MKLROOT) + +pushenv("GSI_BINARY_SOURCE_DIR", "/lustre/f2/dev/role.epic/contrib/GSI_data/fix/20230601") + +setenv("CC","cc") +setenv("FC","ftn") +setenv("CXX","CC") +pushenv("CRAYPE_LINK_TYPE","dynamic") + +whatis("Description: GSI environment on Gaea with Intel Compilers") + diff --git a/modulefiles/gsi_hera.gnu.lua b/modulefiles/gsi_hera.gnu.lua index 4f0253ba4d..c309e67fe0 100644 --- a/modulefiles/gsi_hera.gnu.lua +++ b/modulefiles/gsi_hera.gnu.lua @@ -1,15 +1,18 @@ help([[ ]]) -prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/gnu-9.2/modulefiles/stack") -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_gnu_ver=os.getenv("hpc_gnu_ver") or "9.2.0" +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local gnu_ver=os.getenv("gnu_ver") or "9.2.0" +local hpc_gnu_ver=os.getenv("hpc_gnu_ver") or "9.2" local hpc_mpich_ver=os.getenv("hpc_mpich_ver") or "3.3.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" +local openblas_ver=os.getenv("openblas_ver") or "0.3.23" load(pathJoin("hpc", hpc_ver)) +load(pathJoin("gnu", gnu_ver)) load(pathJoin("hpc-gnu", hpc_gnu_ver)) load(pathJoin("hpc-mpich", hpc_mpich_ver)) load(pathJoin("cmake", cmake_ver)) @@ -17,8 +20,7 @@ load(pathJoin("cmake", cmake_ver)) load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) - -pushenv("MKLROOT", "/apps/oneapi/mkl/2022.0.2") +load(pathJoin("openblas", openblas_ver)) pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230601") diff --git a/modulefiles/gsi_hera.intel.lua b/modulefiles/gsi_hera.intel.lua index 62a915ef72..866af02d50 100644 --- a/modulefiles/gsi_hera.intel.lua +++ b/modulefiles/gsi_hera.intel.lua @@ -1,13 +1,16 @@ help([[ ]]) -prepend_path("MODULEPATH", "/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.0.4" +prepend_path("MODULEPATH", "/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack") + +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" -local anaconda_ver=os.getenv("anaconda_ver") or "2.3.0" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) @@ -15,10 +18,6 @@ load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -prepend_path("MODULEPATH", "/contrib/anaconda/modulefiles") - -load(pathJoin("anaconda", anaconda_ver)) - load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) diff --git a/modulefiles/gsi_jet.lua b/modulefiles/gsi_jet.lua index a769deca6f..e2ea2ef1d0 100644 --- a/modulefiles/gsi_jet.lua +++ b/modulefiles/gsi_jet.lua @@ -1,13 +1,16 @@ help([[ ]]) -prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/hpc-stack/libs/intel-18.0.5.274/modulefiles/stack") +prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) + +prepend_path("MODULEPATH", "/mnt/lfs4/HFIP/hfv3gfs/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack") local hpc_ver=os.getenv("hpc_ver") or "1.2.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.5.274" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.4.274" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.20.1" -local anaconda_ver=os.getenv("anaconda_ver") or "5.3.1" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) @@ -15,10 +18,6 @@ load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -prepend_path("MODULEPATH", "/contrib/anaconda/modulefiles") - -load(pathJoin("anaconda", anaconda_ver)) - load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) diff --git a/modulefiles/gsi_orion.lua b/modulefiles/gsi_orion.lua index fb3df720e4..a7ea874fb2 100644 --- a/modulefiles/gsi_orion.lua +++ b/modulefiles/gsi_orion.lua @@ -1,20 +1,22 @@ help([[ ]]) -prepend_path("MODULEPATH", "/apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack") +prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/contrib/orion/miniconda3/modulefiles") +miniconda3_ver=os.getenv("miniconda3_ver") or "4.12.0" +load(pathJoin("miniconda3", miniconda3_ver)) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2018.4" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2018.4" +prepend_path("MODULEPATH", "/work/noaa/epic/role-epic/contrib/orion/hpc-stack/intel-2022.1.2/modulefiles/stack") + +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1.2" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1.2" local cmake_ver=os.getenv("cmake_ver") or "3.22.1" -local python_ver=os.getenv("python_ver") or "3.7.5" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" load(pathJoin("hpc", hpc_ver)) load(pathJoin("hpc-intel", hpc_intel_ver)) load(pathJoin("hpc-impi", hpc_impi_ver)) load(pathJoin("cmake", cmake_ver)) -load(pathJoin("python", python_ver)) load("gsi_common") diff --git a/modulefiles/gsi_s4.lua b/modulefiles/gsi_s4.lua index 24b1f5962d..efdc6c4bfb 100644 --- a/modulefiles/gsi_s4.lua +++ b/modulefiles/gsi_s4.lua @@ -1,9 +1,9 @@ help([[ ]]) -local hpc_ver=os.getenv("hpc_ver") or "1.1.0" -local hpc_intel_ver=os.getenv("hpc_intel_ver") or "18.0.4" -local hpc_impi_ver=os.getenv("hpc_impi_ver") or "18.0.4" +local hpc_ver=os.getenv("hpc_ver") or "1.2.0" +local hpc_intel_ver=os.getenv("hpc_intel_ver") or "2022.1" +local hpc_impi_ver=os.getenv("hpc_impi_ver") or "2022.1" local miniconda_ver=os.getenv("miniconda_ver") or "3.8-s4" local prod_util_ver=os.getenv("prod_util_ver") or "1.2.2" diff --git a/regression/regression_driver.sh b/regression/regression_driver.sh index e1d3b18dc7..821cc7cedb 100755 --- a/regression/regression_driver.sh +++ b/regression/regression_driver.sh @@ -35,9 +35,11 @@ for jn in `seq ${RSTART} ${REND}`; do if [ $jn -le 2 ]; then export scripts=${scripts_updat:-$scripts} export fixgsi=${fixgsi_updat:-$fixgsi} + export modulefiles=${modulefiles_updat:-$modulefiles} else export scripts=${scripts_contrl:-$scripts} export fixgsi=${fixgsi_contrl:-$fixgsi} + export modulefiles=${modulefiles_contrl:-$modulefiles} fi rm -f ${job[$jn]}.out diff --git a/regression/regression_param.sh b/regression/regression_param.sh index 6024dbdb54..ea27521251 100755 --- a/regression/regression_param.sh +++ b/regression/regression_param.sh @@ -18,6 +18,11 @@ case $machine in sub_cmd="sub_jet" memnode=96 numcore=40 + ;; + Gaea) + sub_cmd="sub_gaea" + memnode=64 + numcore=36 ;; wcoss2) sub_cmd="sub_wcoss2" @@ -28,7 +33,9 @@ case $machine in sub_cmd="sub_discover" ;; Cheyenne) - sub_cmd="sub_ncar -a p48503002 -q economy -d $PWD" + sub_cmd="sub_cheyenne" + memnode=128 + numcore=36 ;; *) # EXIT out for unresolved machine echo "unknown $machine" @@ -56,8 +63,11 @@ case $regtest in topts[1]="0:15:00" ; popts[1]="12/5/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/9/" ; ropts[2]="/2" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="0:30:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:30:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="16/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="16/4/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:15:00" ; popts[1]="18/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="18/4/" ; ropts[2]="/2" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="12/5/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/9/" ; ropts[2]="/2" @@ -86,8 +96,11 @@ case $regtest in topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="0:35:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:25:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:15:00" ; popts[1]="18/2/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="18/4/" ; ropts[2]="/2" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="28/2/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="28/4/" ; ropts[2]="/2" @@ -104,6 +117,8 @@ case $regtest in popts[1]="12/5/" elif [[ "$machine" = "Jet" ]]; then popts[1]="12/5/" + elif [[ "$machine" = "Gaea" ]]; then + popts[1]="18/5/" elif [[ "$machine" = "wcoss2" ]]; then popts[1]="28/4/" topts[1]="3:00:00" @@ -129,8 +144,11 @@ case $regtest in topts[1]="0:30:00" ; popts[1]="48/2" ; ropts[1]="/1" topts[2]="0:30:00" ; popts[2]="60/3" ; ropts[2]="/2" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="1:59:00" ; popts[1]="6/8/" ; ropts[1]="/1" - topts[2]="0:35:00" ; popts[2]="6/10/" ; ropts[2]="/2" + topts[1]="0:10:00" ; popts[1]="12/8/" ; ropts[1]="/1" + topts[2]="0:10:00" ; popts[2]="12/10/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + 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" @@ -155,6 +173,12 @@ case $regtest in elif [[ "$machine" = "Jet" ]]; then topts[1]="0:15:00" ; popts[1]="20/1/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="20/2/" ; ropts[2]="/1" + elif [[ "$machine" = "Cheyenne" ]]; then + topts[1]="0:15:00" ; popts[1]="20/1/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="20/2/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + 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" @@ -179,6 +203,12 @@ case $regtest in elif [[ "$machine" = "Jet" ]]; then 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" = "Cheyenne" ]]; then + topts[1]="0:15:00" ; popts[1]="4/4/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="6/6/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + 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" @@ -204,8 +234,11 @@ case $regtest in topts[1]="0:30:00" ; popts[1]="6/12/" ; ropts[1]="/1" topts[2]="0:30:00" ; popts[2]="8/12/" ; ropts[2]="/1" elif [[ "$machine" = "Cheyenne" ]]; then - topts[1]="0:15:00" ; popts[1]="8/6/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="8/8/" ; ropts[2]="/1" + topts[1]="0:30:00" ; popts[1]="6/12/" ; ropts[1]="/1" + topts[2]="0:30:00" ; popts[2]="8/12/" ; ropts[2]="/1" + elif [[ "$machine" = "Gaea" ]]; then + 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" @@ -233,6 +266,9 @@ case $regtest in elif [[ "$machine" = "Cheyenne" ]]; then topts[1]="0:20:00" ; popts[1]="6/6/" ; ropts[1]="/1" topts[2]="0:20:00" ; popts[2]="8/8/" ; ropts[2]="/1" + elif [[ "$machine" = "Gaea" ]]; then + topts[1]="0:20:00" ; popts[1]="6/6/" ; ropts[1]="/1" + topts[2]="0:20:00" ; popts[2]="8/8/" ; ropts[2]="/1" elif [[ "$machine" = "wcoss2" ]]; then topts[1]="0:15:00" ; popts[1]="10/10/" ; ropts[1]="/1" topts[2]="0:15:00" ; popts[2]="14/14/" ; ropts[2]="/2" @@ -258,8 +294,11 @@ 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" = "Cheyenne" ]]; then - topts[1]="0:15:00" ; popts[1]="16/2/" ; ropts[1]="/1" - topts[2]="0:15:00" ; popts[2]="16/4/" ; ropts[2]="/2" + topts[1]="0:15:00" ; popts[1]="12/3/" ; ropts[1]="/1" + topts[2]="0:15:00" ; popts[2]="12/5/" ; ropts[2]="/2" + elif [[ "$machine" = "Gaea" ]]; then + 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" @@ -316,13 +355,19 @@ elif [[ "$machine" = "Jet" ]]; then export MPI_BUFS_PER_PROC=256 export MPI_BUFS_PER_HOST=256 export MPI_GROUP_MAX=256 - export APRUN="srun" + export APRUN="srun -n \$ntasks --cpus-per-task=\$threads" +elif [[ "$machine" = "Gaea" ]]; then + export OMP_STACKSIZE=1024M + export MPI_BUFS_PER_PROC=256 + export MPI_BUFS_PER_HOST=256 + export MPI_GROUP_MAX=256 + export APRUN="srun --export=ALL --mpi=pmi2 -n \$ntasks" elif [[ "$machine" = "Cheyenne" ]]; then export OMP_STACKSIZE=1024M export MPI_BUFS_PER_PROC=256 export MPI_BUFS_PER_HOST=256 export MPI_GROUP_MAX=256 - export APRUN="mpirun -v -np \$NCPUS" + export APRUN="mpirun -v -np \$ntasks" elif [[ "$machine" = "wcoss2" ]]; then export OMP_PLACES=cores export OMP_STACKSIZE=2G diff --git a/regression/regression_var.sh b/regression/regression_var.sh index 05b5563ef1..3176372a3b 100755 --- a/regression/regression_var.sh +++ b/regression/regression_var.sh @@ -14,6 +14,7 @@ if [ "$#" = 7 ] ; then export enkfexec_contrl=$7 export fixgsi="$gsisrc/fix" export scripts="$gsisrc/regression" + export modulefiles="$gsisrc/modulefiles" export ush="$gsisrc/ush" export cmaketest="true" export clean="false" @@ -49,19 +50,33 @@ fi echo "Running Regression Tests on '$machine'"; case $machine in + Gaea) + export queue="normal" + export noscrub="/lustre/f2/scratch/$LOGNAME/gsi_tmp/noscrub" + export ptmp="/lustre/f2/scratch/$LOGNAME/gsi_tmp/ptmp" + export casesdir="/lustre/f2/dev/role.epic/contrib/GSI_data/CASES/regtest" + + export group="global" + if [[ "$cmaketest" = "false" ]]; then + export basedir="/lustre/f2/dev/$LOGNAME/sandbox/GSI" + fi + + export check_resource="no" + export accnt="nggps_emc" + ;; Cheyenne) - export queue="economy" - export noscrub="/glade/scratch/$LOGNAME" + export queue="regular" + export noscrub="/glade/scratch/$LOGNAME/noscrub" export group="global" if [[ "$cmaketest" = "false" ]]; then - export basedir="/glade/scratch/$LOGNAME/gsi" + export basedir="/glade/scratch/$LOGNAME" fi export ptmp="/glade/scratch/$LOGNAME/$ptmpName" - export casesdir="/glade/p/ral/jntp/tools/CASES" + export casesdir="/glade/work/epicufsrt/contrib/GSI_data/CASES/regtest" export check_resource="no" - export accnt="p48503002" + export accnt="NRAL0032" ;; wcoss2) export local_or_default="${local_or_default:-/lfs/h2/emc/da/noscrub/$LOGNAME}" diff --git a/src/enkf/observer_gfs.f90 b/src/enkf/observer_gfs.f90 index 983b25f959..07e4f58457 100644 --- a/src/enkf/observer_gfs.f90 +++ b/src/enkf/observer_gfs.f90 @@ -66,7 +66,7 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely, & !$$$ use kinds, only: r_kind,i_kind,r_single use params, only: nstatefields, nlons, nlats, nhr_state, fhr_assim - use gridinfo, only: latsgrd, lonsgrd + use gridinfo, only: latsgrd, lonsgrd, npts use constants, only: zero,one,pi use mpisetup implicit none @@ -76,6 +76,7 @@ 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 + integer(i_kind) :: ixnlons ! find interplation indices and deltas @@ -87,17 +88,21 @@ subroutine setup_linhx(rlat, rlon, time, ix, delx, ixp, delxp, iy, dely, & ix = min(ix, nlats-1) ixp = max(ix-1, 0) + ixnlons = ix*nlons + if (ixp /= ix) then - delx = (rlat - latsgrd(ix*nlons+1)) / (latsgrd(ixp*nlons + 1) - latsgrd(ix*nlons+1)) + delx = (rlat - latsgrd(ixnlons+1)) / (latsgrd(ixp*nlons + 1) - latsgrd(ixnlons+1)) else delx = one endif delx = max(zero,min(delx,one)) - iyp = 1 - do while (iyp <= nlons .and. lonsgrd(ix*nlons + iyp) <= rlon) - iyp = iyp + 1 + iyp=1 + do while(iyp <= nlons .and. ixnlons+iyp <= npts) + if (lonsgrd(ixnlons+iyp) > rlon) exit + iyp = iyp + 1 enddo + iy = iyp - 1 if(iy < 1) iy = iy + nlons if(iyp > nlons) iyp = iyp - nlons diff --git a/src/gsi/ensctl2state.f90 b/src/gsi/ensctl2state.f90 index 0d6d3042c5..bd72e12b76 100644 --- a/src/gsi/ensctl2state.f90 +++ b/src/gsi/ensctl2state.f90 @@ -240,7 +240,6 @@ subroutine ensctl2state(xhat,mval,eval) !$omp section ! Get pointers to required state variables - call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus) call gsi_bundlegetpointer (eval(jj),'sst' ,sv_sst, istatus) if(ls_w)then call gsi_bundlegetpointer (eval(jj),'w' ,sv_w, istatus) @@ -249,7 +248,6 @@ subroutine ensctl2state(xhat,mval,eval) end if end if ! Copy variables - call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus ) call gsi_bundlegetvar ( wbundle_c, 'sst', sv_sst, istatus ) if(lc_w)then call gsi_bundlegetvar ( wbundle_c, 'w' , sv_w, istatus ) @@ -258,6 +256,13 @@ subroutine ensctl2state(xhat,mval,eval) end if end if +! Get the ozone vector if it is defined + id=getindex(cvars3d,"oz") + if(id > 0) then + call gsi_bundlegetpointer (eval(jj),'oz' ,sv_oz , istatus) + call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz, istatus ) + endif + !$omp end parallel sections ! Add contribution from static B, if necessary diff --git a/src/gsi/ensctl2state_ad.f90 b/src/gsi/ensctl2state_ad.f90 index 4c038c8c6e..d350743998 100644 --- a/src/gsi/ensctl2state_ad.f90 +++ b/src/gsi/ensctl2state_ad.f90 @@ -206,9 +206,7 @@ subroutine ensctl2state_ad(eval,mval,grad) !$omp section - call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus) call gsi_bundlegetpointer (eval(jj),'sst' ,rv_sst, istatus) - call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus ) call gsi_bundleputvar ( wbundle_c, 'sst', rv_sst, istatus ) if(wdw_exist)then call gsi_bundlegetpointer (eval(jj),'w' ,rv_w, istatus) @@ -219,6 +217,13 @@ subroutine ensctl2state_ad(eval,mval,grad) end if end if +! Get the ozone vector if it is defined + id=getindex(cvars3d,"oz") + if(id > 0) then + call gsi_bundlegetpointer (eval(jj),'oz' ,rv_oz , istatus) + call gsi_bundleputvar ( wbundle_c, 'oz', rv_oz, istatus ) + endif + !$omp section if (do_cw_to_hydro_ad .and. .not.do_cw_to_hydro_ad_hwrf) then diff --git a/src/gsi/general_read_fv3atm.f90 b/src/gsi/general_read_fv3atm.f90 index 3d2646fbbb..847d1c4bd3 100644 --- a/src/gsi/general_read_fv3atm.f90 +++ b/src/gsi/general_read_fv3atm.f90 @@ -255,6 +255,7 @@ subroutine general_read_fv3atm_nems(grd,sp_a,filename,uvflag,vordivflag,zflag, & call stop2(999) endif istatus=0 + istatus1=0 call gsi_bundlegetpointer(gfs_bundle,'ps',g_ps ,ier);istatus = istatus + ier call gsi_bundlegetpointer(gfs_bundle,'q' ,g_q ,ier);istatus = istatus + ier call gsi_bundlegetpointer(gfs_bundle,'oz',g_oz ,ier);istatus = istatus + ier diff --git a/src/gsi/genstats_gps.f90 b/src/gsi/genstats_gps.f90 index ce90d06f50..acf5ca2756 100644 --- a/src/gsi/genstats_gps.f90 +++ b/src/gsi/genstats_gps.f90 @@ -250,7 +250,7 @@ subroutine genstats_gps(bwork,awork,toss_gps_sub,conv_diagsave,mype) use obsmod, only: lobsdiagsave,luse_obsdiag use obsmod, only: binary_diag,netcdf_diag,dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gridmod, only: nsig,regional use constants, only: tiny_r_kind,half,wgtlim,one,two,zero,five,four @@ -766,27 +766,27 @@ subroutine contents_netcdf_diag_ obssubtype = gps_allptr%rdiag(2) call nc_diag_metadata("Observation_Type", obstype ) call nc_diag_metadata("Observation_Subtype", obssubtype ) - call nc_diag_metadata("Latitude", sngl(gps_allptr%rdiag(3)) ) - call nc_diag_metadata("Longitude", sngl(gps_allptr%rdiag(4)) ) - call nc_diag_metadata("Incremental_Bending_Angle", sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("Pressure", sngl(gps_allptr%rdiag(6)) ) - call nc_diag_metadata("Height", sngl(gps_allptr%rdiag(7)) ) - call nc_diag_metadata("Time", sngl(gps_allptr%rdiag(8)) ) - call nc_diag_metadata("Model_Elevation", sngl(gps_allptr%rdiag(9)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(gps_allptr%rdiag(10)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(gps_allptr%rdiag(11)) ) - call nc_diag_metadata("Analysis_Use_Flag", sngl(gps_allptr%rdiag(12)) ) - - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(gps_allptr%rdiag(13)) ) - call nc_diag_metadata("Errinv_Input", sngl(gps_allptr%rdiag(14)) ) - call nc_diag_metadata("Errinv_Adjust", sngl(gps_allptr%rdiag(15)) ) - call nc_diag_metadata("Errinv_Final", sngl(gps_allptr%rdiag(16)) ) - call nc_diag_metadata("Observation", sngl(gps_allptr%rdiag(17)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(gps_allptr%rdiag(17))*sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(gps_allptr%rdiag(17))*sngl(gps_allptr%rdiag(5)) ) - call nc_diag_metadata("GPS_Type", sngl(gps_allptr%rdiag(20)) ) - call nc_diag_metadata("Temperature_at_Obs_Location", sngl(gps_allptr%rdiag(18)) ) - call nc_diag_metadata("Specific_Humidity_at_Obs_Location", sngl(gps_allptr%rdiag(21)) ) + call nc_diag_metadata_to_single("Latitude", gps_allptr%rdiag(3) ) + call nc_diag_metadata_to_single("Longitude", gps_allptr%rdiag(4) ) + call nc_diag_metadata_to_single("Incremental_Bending_Angle", gps_allptr%rdiag(5) ) + call nc_diag_metadata_to_single("Pressure", gps_allptr%rdiag(6) ) + call nc_diag_metadata_to_single("Height", gps_allptr%rdiag(7) ) + call nc_diag_metadata_to_single("Time", gps_allptr%rdiag(8) ) + call nc_diag_metadata_to_single("Model_Elevation", gps_allptr%rdiag(9) ) + call nc_diag_metadata_to_single("Setup_QC_Mark", gps_allptr%rdiag(10) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", gps_allptr%rdiag(11) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", gps_allptr%rdiag(12) ) + + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt", gps_allptr%rdiag(13) ) + call nc_diag_metadata_to_single("Errinv_Input", gps_allptr%rdiag(14) ) + call nc_diag_metadata_to_single("Errinv_Adjust", gps_allptr%rdiag(15) ) + call nc_diag_metadata_to_single("Errinv_Final", gps_allptr%rdiag(16) ) + call nc_diag_metadata_to_single("Observation", gps_allptr%rdiag(17) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted", gps_allptr%rdiag(17),gps_allptr%rdiag(5),"*") + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",gps_allptr%rdiag(17),gps_allptr%rdiag(5),"*") + call nc_diag_metadata_to_single("GPS_Type", gps_allptr%rdiag(20) ) + call nc_diag_metadata_to_single("Temperature_at_Obs_Location", gps_allptr%rdiag(18) ) + call nc_diag_metadata_to_single("Specific_Humidity_at_Obs_Location",gps_allptr%rdiag(21) ) if (save_jacobian) then call readarray(dhx_dx, gps_allptr%rdiag(ioff+1:nreal)) diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90 index 05f679cb60..62b23ee713 100644 --- a/src/gsi/gsi_rfv3io_mod.f90 +++ b/src/gsi/gsi_rfv3io_mod.f90 @@ -2188,7 +2188,7 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) use kinds, only: r_kind,i_kind - use mpimod, only: mpi_comm_world,mpi_rtype,mype + use mpimod, only: mpi_comm_world,mpi_rtype,mype,npe,setcomm,mpi_integer,mpi_max use mpimod, only: MPI_INFO_NULL use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension @@ -2217,6 +2217,11 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) logical :: phy_smaller_domain integer(i_kind) gfile_loc,iret,var_id 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 + logical:: procuse + ! for io_layout > 1 real(r_kind),allocatable,dimension(:,:):: uu2d_layout integer(i_kind) :: nio @@ -2232,108 +2237,132 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) kend=grd_ionouv%kend_loc allocate(uu2d(nxcase,nycase)) - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio - iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret - call flush(6) - call stop2(333) - endif - enddo - else - iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filenamein),gfile_loc,', Status = ',iret - call flush(6) - call stop2(333) - endif + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_ionouv%names(1,ilevtot) - if(trim(vgsiname)=='delzinc') cycle !delzinc is not read from DZ ,it's started from hydrostatic height - if(trim(vgsiname)=='amassi') cycle - if(trim(vgsiname)=='amassj') cycle - if(trim(vgsiname)=='amassk') cycle - if(trim(vgsiname)=='pm2_5') cycle - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - name=trim(varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_ionouv%lnames(1,ilevtot) - nz=grd_ionouv%nsig - nzp1=nz+1 - inative=nzp1-ilev - startloc=(/1,1,inative/) - countloc=(/nxcase,nycase,1/) - ! Variable ref_f3d in phy_data.nc has a smaller domain size than - ! dynvariables and tracers as well as a reversed order in vertical - if ( trim(adjustl(varname)) == 'ref_f3d' )then - iret=nf90_inquire_dimension(gfile_loc,1,name,len) - if(trim(name)=='xaxis_1') nx_phy=len - if( nx_phy == nxcase )then - allocate(uu2d_tmp(nxcase,nycase)) - countloc_tmp=(/nxcase,nycase,1/) - phy_smaller_domain = .false. - else - allocate(uu2d_tmp(nxcase-6,nycase-6)) - countloc_tmp=(/nxcase-6,nycase-6,1/) - phy_smaller_domain = .true. - end if - startloc_tmp=(/1,1,ilev/) - end if + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(uu2d_layout(nxcase,ny_layout_len(nio))) - iret=nf90_inq_varid(gfile_loc_layout(nio),trim(adjustl(varname)),var_id) - iret=nf90_get_var(gfile_loc_layout(nio),var_id,uu2d_layout,start=startloc,count=countloc) - uu2d(:,ny_layout_b(nio):ny_layout_e(nio))=uu2d_layout - deallocate(uu2d_layout) - enddo - else - iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) - if ( trim(adjustl(varname)) == 'ref_f3d' )then - uu2d = 0.0_r_kind - iret=nf90_get_var(gfile_loc,var_id,uu2d_tmp,start=startloc_tmp,count=countloc_tmp) - where(uu2d_tmp < 0.0_r_kind) - uu2d_tmp = 0.0_r_kind - endwhere - - if( phy_smaller_domain )then - uu2d(4:nxcase-3,4:nycase-3) = uu2d_tmp - else - uu2d(1:nxcase,1:nycase) = uu2d_tmp - end if - deallocate(uu2d_tmp) - else - iret=nf90_get_var(gfile_loc,var_id,uu2d,start=startloc,count=countloc) - end if - endif + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - call fv3_h_to_ll(uu2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,grid_reverse_flag) - enddo ! ilevtot + if (procuse) then - if(fv3_io_layout_y > 1) then - do nio=1,fv3_io_layout_y-1 - iret=nf90_close(gfile_loc_layout(nio)) - enddo - deallocate(gfile_loc_layout) - else - iret=nf90_close(gfile_loc) + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) + do nio=0,fv3_io_layout_y-1 + write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio + iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret + call flush(6) + call stop2(333) + endif + enddo + else + iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' gsi_fv3ncdf_read: problem opening ',trim(filenamein),gfile_loc,', Status = ',iret + call flush(6) + call stop2(333) + endif + endif + do ilevtot=kbgn,kend + vgsiname=grd_ionouv%names(1,ilevtot) + if(trim(vgsiname)=='delzinc') cycle !delzinc is not read from DZ ,it's started from hydrostatic height + if(trim(vgsiname)=='amassi') cycle + if(trim(vgsiname)=='amassj') cycle + if(trim(vgsiname)=='amassk') cycle + if(trim(vgsiname)=='pm2_5') cycle + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + name=trim(varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_ionouv%lnames(1,ilevtot) + nz=grd_ionouv%nsig + nzp1=nz+1 + inative=nzp1-ilev + startloc=(/1,1,inative/) + countloc=(/nxcase,nycase,1/) + ! Variable ref_f3d in phy_data.nc has a smaller domain size than + ! dynvariables and tracers as well as a reversed order in vertical + if ( trim(adjustl(varname)) == 'ref_f3d' )then + iret=nf90_inquire_dimension(gfile_loc,1,name,len) + if(trim(name)=='xaxis_1') nx_phy=len + if( nx_phy == nxcase )then + allocate(uu2d_tmp(nxcase,nycase)) + countloc_tmp=(/nxcase,nycase,1/) + phy_smaller_domain = .false. + else + allocate(uu2d_tmp(nxcase-6,nycase-6)) + countloc_tmp=(/nxcase-6,nycase-6,1/) + phy_smaller_domain = .true. + end if + startloc_tmp=(/1,1,ilev/) + end if + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(uu2d_layout(nxcase,ny_layout_len(nio))) + iret=nf90_inq_varid(gfile_loc_layout(nio),trim(adjustl(varname)),var_id) + iret=nf90_get_var(gfile_loc_layout(nio),var_id,uu2d_layout,start=startloc,count=countloc) + uu2d(:,ny_layout_b(nio):ny_layout_e(nio))=uu2d_layout + deallocate(uu2d_layout) + enddo + else + iret=nf90_inq_varid(gfile_loc,trim(adjustl(varname)),var_id) + if ( trim(adjustl(varname)) == 'ref_f3d' )then + uu2d = 0.0_r_kind + iret=nf90_get_var(gfile_loc,var_id,uu2d_tmp,start=startloc_tmp,count=countloc_tmp) + where(uu2d_tmp < 0.0_r_kind) + uu2d_tmp = 0.0_r_kind + endwhere + + if( phy_smaller_domain )then + uu2d(4:nxcase-3,4:nycase-3) = uu2d_tmp + else + uu2d(1:nxcase,1:nycase) = uu2d_tmp + end if + deallocate(uu2d_tmp) + else + iret=nf90_get_var(gfile_loc,var_id,uu2d,start=startloc,count=countloc) + end if + endif + + call fv3_h_to_ll(uu2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,grid_reverse_flag) + enddo ! ilevtot + + if(fv3_io_layout_y > 1) then + do nio=1,fv3_io_layout_y-1 + iret=nf90_close(gfile_loc_layout(nio)) + enddo + deallocate(gfile_loc_layout) + else + iret=nf90_close(gfile_loc) + endif endif - + call mpi_barrier(mpi_comm_world,ierror) + deallocate (uu2d) call general_grid2sub(grd_ionouv,hwork,cstate_nouv%values) return -end subroutine gsi_fv3ncdf_read + end subroutine gsi_fv3ncdf_read subroutine gsi_fv3ncdf_read_v1(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin) @@ -2465,7 +2494,7 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) ! !$$$ end documentation block use kinds, only: r_kind,i_kind - use mpimod, only: mpi_comm_world,mpi_rtype,mype,mpi_info_null + use mpimod, only: mpi_comm_world,mpi_rtype,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use netcdf, only: nf90_open,nf90_close,nf90_get_var,nf90_noerr use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use netcdf, only: nf90_inquire_variable @@ -2495,6 +2524,10 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) integer(i_kind) gfile_loc,iret 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 + logical:: procuse + ! for fv3_io_layout_y > 1 real(r_kind),allocatable,dimension(:,:):: u2d_layout,v2d_layout integer(i_kind) :: nio @@ -2515,102 +2548,130 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin) allocate (worksub(2,grd_uv%lat2,grd_uv%lon2,grd_uv%nsig)) filenamein=fv3filenamegin%dynvars - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio - iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) - if(iret/=nf90_noerr) then - write(6,*)'problem opening6 ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret - call flush(6) - call stop2(333) - endif - enddo - else - iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) !clt - if(iret/=nf90_noerr) then - write(6,*)' problem opening6 ',trim(filenamein),', Status = ',iret - call flush(6) - call stop2(333) - endif + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_uv%names(1,ilevtot) - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_uv%lnames(1,ilevtot) - nz=grd_uv%nsig - nzp1=nz+1 - inative=nzp1-ilev - u_countloc=(/nxcase,nycase+1,1/) - v_countloc=(/nxcase+1,nycase,1/) - u_startloc=(/1,1,inative/) - v_startloc=(/1,1,inative/) - - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - call check( nf90_inq_varid(gfile_loc_layout(nio),'u',u_grd_VarId) ) - iret=nf90_get_var(gfile_loc_layout(nio),u_grd_VarId,u2d_layout,start=u_startloc,count=u_countloc) - u2d(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) - if(nio==fv3_io_layout_y-1) u2d(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) - deallocate(u2d_layout) - - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - call check( nf90_inq_varid(gfile_loc_layout(nio),'v',v_grd_VarId) ) - iret=nf90_get_var(gfile_loc_layout(nio),v_grd_VarId,v2d_layout,start=v_startloc,count=v_countloc) - v2d(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout - deallocate(v2d_layout) - enddo - else - call check( nf90_inq_varid(gfile_loc,'u',u_grd_VarId) ) - iret=nf90_get_var(gfile_loc,u_grd_VarId,u2d,start=u_startloc,count=u_countloc) - call check( nf90_inq_varid(gfile_loc,'v',v_grd_VarId) ) - iret=nf90_get_var(gfile_loc,v_grd_VarId,v2d,start=v_startloc,count=v_countloc) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv (u2d,nxcase,nycase+1,1) - call reverse_grid_r_uv (v2d,nxcase+1,nycase,1) - endif - call fv3uv2earth(u2d(:,:),v2d(:,:),nxcase,nycase,uc2d,vc2d) + write(6,115)mype,kbgn,kend,procuse +115 format('gsi_fv3ncdf_readuv: mype ',i6,' has kbgn,kend= ',2(i6,1x),' set procuse ',l7) -! NOTE on transfor to earth u/v: -! The u and v before transferring need to be in E-W/N-S grid, which is -! defined as reversed grid here because it is revered from map view. -! -! Have set the following flag for grid orientation -! grid_reverse_flag=true: E-W/N-S grid -! grid_reverse_flag=false: W-E/S-N grid -! -! So for preparing the wind transferring, need to reverse the grid from -! W-E/S-N grid to E-W/N-S grid when grid_reverse_flag=false: -! -! if(.not.grid_reverse_flag) call reverse_grid_r_uv -! -! and the last input parameter for fv3_h_to_ll is alway true: -! -! - call fv3_h_to_ll(uc2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) - call fv3_h_to_ll(vc2d,hwork(2,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) - enddo ! i + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - iret=nf90_close(gfile_loc_layout(nio)) - enddo - deallocate(gfile_loc_layout) - else - iret=nf90_close(gfile_loc) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) + + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) + do nio=0,fv3_io_layout_y-1 + write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio + iret=nf90_open(filename_layout,nf90_nowrite,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) + if(iret/=nf90_noerr) then + write(6,*)'problem opening6 ',trim(filename_layout),gfile_loc_layout(nio),', Status = ',iret + call flush(6) + call stop2(333) + endif + enddo + else + iret=nf90_open(filenamein,nf90_nowrite,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) !clt + if(iret/=nf90_noerr) then + write(6,*)' problem opening6 ',trim(filenamein),', Status = ',iret + call flush(6) + call stop2(333) + endif + endif + + do ilevtot=kbgn,kend + vgsiname=grd_uv%names(1,ilevtot) + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_uv%lnames(1,ilevtot) + nz=grd_uv%nsig + nzp1=nz+1 + inative=nzp1-ilev + u_countloc=(/nxcase,nycase+1,1/) + v_countloc=(/nxcase+1,nycase,1/) + u_startloc=(/1,1,inative/) + v_startloc=(/1,1,inative/) + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + call check( nf90_inq_varid(gfile_loc_layout(nio),'u',u_grd_VarId) ) + iret=nf90_get_var(gfile_loc_layout(nio),u_grd_VarId,u2d_layout,start=u_startloc,count=u_countloc) + u2d(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) + if(nio==fv3_io_layout_y-1) u2d(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) + deallocate(u2d_layout) + + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + call check( nf90_inq_varid(gfile_loc_layout(nio),'v',v_grd_VarId) ) + iret=nf90_get_var(gfile_loc_layout(nio),v_grd_VarId,v2d_layout,start=v_startloc,count=v_countloc) + v2d(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout + deallocate(v2d_layout) + enddo + else + call check( nf90_inq_varid(gfile_loc,'u',u_grd_VarId) ) + iret=nf90_get_var(gfile_loc,u_grd_VarId,u2d,start=u_startloc,count=u_countloc) + call check( nf90_inq_varid(gfile_loc,'v',v_grd_VarId) ) + iret=nf90_get_var(gfile_loc,v_grd_VarId,v2d,start=v_startloc,count=v_countloc) + endif + + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv (u2d,nxcase,nycase+1,1) + call reverse_grid_r_uv (v2d,nxcase+1,nycase,1) + endif + call fv3uv2earth(u2d(:,:),v2d(:,:),nxcase,nycase,uc2d,vc2d) + + ! NOTE on transfor to earth u/v: + ! The u and v before transferring need to be in E-W/N-S grid, which is + ! defined as reversed grid here because it is revered from map view. + ! + ! Have set the following flag for grid orientation + ! grid_reverse_flag=true: E-W/N-S grid + ! grid_reverse_flag=false: W-E/S-N grid + ! + ! So for preparing the wind transferring, need to reverse the grid from + ! W-E/S-N grid to E-W/N-S grid when grid_reverse_flag=false: + ! + ! if(.not.grid_reverse_flag) call reverse_grid_r_uv + ! + ! and the last input parameter for fv3_h_to_ll is alway true: + ! + ! + call fv3_h_to_ll(uc2d,hwork(1,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) + call fv3_h_to_ll(vc2d,hwork(2,:,:,ilevtot),nxcase,nycase,nloncase,nlatcase,.true.) + enddo ! i + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + iret=nf90_close(gfile_loc_layout(nio)) + enddo + deallocate(gfile_loc_layout) + else + iret=nf90_close(gfile_loc) + endif endif - deallocate(u2d,v2d,uc2d,vc2d) + call mpi_barrier(mpi_comm_world,ierror) + deallocate(u2d,v2d,uc2d,vc2d) + call general_grid2sub(grd_uv,hwork,worksub) ges_u=worksub(1,:,:,:) ges_v=worksub(2,:,:,:) @@ -3533,7 +3594,7 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) ! !$$$ end documentation block - use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null + use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use netcdf, only: nf90_nowrite,nf90_inquire,nf90_inquire_dimension use gridmod, only: nlon_regional,nlat_regional use mod_fv3_lola, only: fv3_ll_to_h,fv3_h_to_ll, & @@ -3566,6 +3627,10 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) real(r_kind),allocatable,dimension(:,:):: u2d,v2d,workau2,workav2 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 + logical:: procuse + ! for fv3_io_layout_y > 1 real(r_kind),allocatable,dimension(:,:):: u2d_layout,v2d_layout integer(i_kind) :: nio @@ -3597,117 +3662,143 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) call general_sub2grid(grd_uv,worksub,hwork) filenamein=fv3filenamegin%dynvars - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio - call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) ) - enddo - gfile_loc=gfile_loc_layout(0) - else - call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) ) + + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - varname=grd_uv%names(1,ilevtot) - ilev=grd_uv%lnames(1,ilevtot) - nz=grd_uv%nsig - nzp1=nz+1 - inative=nzp1-ilev - u_countloc=(/nxcase,nycase+1,1/) - v_countloc=(/nxcase+1,nycase,1/) - u_startloc=(/1,1,inative/) - v_startloc=(/1,1,inative/) + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - work_au=hwork(1,:,:,ilevtot) - work_av=hwork(2,:,:,ilevtot) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo - call check( nf90_inq_varid(gfile_loc,'u',ugrd_VarId) ) - call check( nf90_inq_varid(gfile_loc,'v',vgrd_VarId) ) + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - if(add_saved)then - allocate( workau2(nlatcase,nloncase),workav2(nlatcase,nloncase)) - allocate( workbu2(nlon_regional,nlat_regional+1)) - allocate( workbv2(nlon_regional+1,nlat_regional)) -!!!!!!!! readin work_b !!!!!!!!!!!!!!!! - if(fv3_io_layout_y > 1) then + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) do nio=0,fv3_io_layout_y-1 - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - call check( nf90_get_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) - work_bu(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) - if(nio==fv3_io_layout_y-1) work_bu(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) - deallocate(u2d_layout) - - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - call check( nf90_get_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) - work_bv(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout - deallocate(v2d_layout) + write(filename_layout,'(a,a,I4.4)') trim(filenamein),".",nio + call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) ) enddo - else - call check( nf90_get_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) - call check( nf90_get_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) - call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) - endif - call fv3uv2earth(work_bu,work_bv,nlon_regional,nlat_regional,u2d,v2d) - call fv3_h_to_ll(u2d,workau2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) - call fv3_h_to_ll(v2d,workav2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) + gfile_loc=gfile_loc_layout(0) + else + call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) ) + endif + + do ilevtot=kbgn,kend + varname=grd_uv%names(1,ilevtot) + ilev=grd_uv%lnames(1,ilevtot) + nz=grd_uv%nsig + nzp1=nz+1 + inative=nzp1-ilev + u_countloc=(/nxcase,nycase+1,1/) + v_countloc=(/nxcase+1,nycase,1/) + u_startloc=(/1,1,inative/) + v_startloc=(/1,1,inative/) + + work_au=hwork(1,:,:,ilevtot) + work_av=hwork(2,:,:,ilevtot) + + call check( nf90_inq_varid(gfile_loc,'u',ugrd_VarId) ) + call check( nf90_inq_varid(gfile_loc,'v',vgrd_VarId) ) + + if(add_saved)then + allocate( workau2(nlatcase,nloncase),workav2(nlatcase,nloncase)) + allocate( workbu2(nlon_regional,nlat_regional+1)) + allocate( workbv2(nlon_regional+1,nlat_regional)) +!!!!!!!! readin work_b !!!!!!!!!!!!!!!! + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + call check( nf90_get_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) + work_bu(:,ny_layout_b(nio):ny_layout_e(nio))=u2d_layout(:,1:ny_layout_len(nio)) + if(nio==fv3_io_layout_y-1) work_bu(:,ny_layout_e(nio)+1)=u2d_layout(:,ny_layout_len(nio)+1) + deallocate(u2d_layout) + + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + call check( nf90_get_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) + work_bv(:,ny_layout_b(nio):ny_layout_e(nio))=v2d_layout + deallocate(v2d_layout) + enddo + else + call check( nf90_get_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) + call check( nf90_get_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) + endif + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) + call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) + endif + call fv3uv2earth(work_bu,work_bv,nlon_regional,nlat_regional,u2d,v2d) + call fv3_h_to_ll(u2d,workau2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) + call fv3_h_to_ll(v2d,workav2,nlon_regional,nlat_regional,nloncase,nlatcase,.true.) !!!!!!!! find analysis_inc: work_a !!!!!!!!!!!!!!!! - work_au(:,:)=work_au(:,:)-workau2(:,:) - work_av(:,:)=work_av(:,:)-workav2(:,:) - call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,workbu2,workbv2) + work_au(:,:)=work_au(:,:)-workau2(:,:) + work_av(:,:)=work_av(:,:)-workav2(:,:) + call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,workbu2,workbv2) !!!!!!!! add analysis_inc to readin work_b !!!!!!!!!!!!!!!! - work_bu(:,:)=work_bu(:,:)+workbu2(:,:) - work_bv(:,:)=work_bv(:,:)+workbv2(:,:) - deallocate(workau2,workbu2,workav2,workbv2) - else - call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) - call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,work_bu(:,:),work_bv(:,:)) - endif - if(.not.grid_reverse_flag) then - call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) - call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) - endif - - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) - u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) - u2d_layout=work_bu(:,ny_layout_b(nio):ny_layout_e(nio)+1) - call check( nf90_put_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) - deallocate(u2d_layout) - - allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) - v_countloc=(/nxcase+1,ny_layout_len(nio),1/) - v2d_layout=work_bv(:,ny_layout_b(nio):ny_layout_e(nio)) - call check( nf90_put_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) - deallocate(v2d_layout) - enddo - else - call check( nf90_put_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) - call check( nf90_put_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) - endif - enddo !ilevltot + work_bu(:,:)=work_bu(:,:)+workbu2(:,:) + work_bv(:,:)=work_bv(:,:)+workbv2(:,:) + deallocate(workau2,workbu2,workav2,workbv2) + else + call fv3_ll_to_h(work_au(:,:),u2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call fv3_ll_to_h(work_av(:,:),v2d,nloncase,nlatcase,nlon_regional,nlat_regional,.true.) + call earthuv2fv3(u2d,v2d,nlon_regional,nlat_regional,work_bu(:,:),work_bv(:,:)) + endif + if(.not.grid_reverse_flag) then + call reverse_grid_r_uv(work_bu,nlon_regional,nlat_regional+1,1) + call reverse_grid_r_uv(work_bv,nlon_regional+1,nlat_regional,1) + endif + + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + allocate(u2d_layout(nxcase,ny_layout_len(nio)+1)) + u_countloc=(/nxcase,ny_layout_len(nio)+1,1/) + u2d_layout=work_bu(:,ny_layout_b(nio):ny_layout_e(nio)+1) + call check( nf90_put_var(gfile_loc_layout(nio),ugrd_VarId,u2d_layout,start=u_startloc,count=u_countloc) ) + deallocate(u2d_layout) + + allocate(v2d_layout(nxcase+1,ny_layout_len(nio))) + v_countloc=(/nxcase+1,ny_layout_len(nio),1/) + v2d_layout=work_bv(:,ny_layout_b(nio):ny_layout_e(nio)) + call check( nf90_put_var(gfile_loc_layout(nio),vgrd_VarId,v2d_layout,start=v_startloc,count=v_countloc) ) + deallocate(v2d_layout) + enddo + else + call check( nf90_put_var(gfile_loc,ugrd_VarId,work_bu,start=u_startloc,count=u_countloc) ) + call check( nf90_put_var(gfile_loc,vgrd_VarId,work_bv,start=v_startloc,count=v_countloc) ) + endif + enddo !ilevltot - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - call check( nf90_close(gfile_loc_layout(nio)) ) - enddo - deallocate(gfile_loc_layout) - else - call check( nf90_close(gfile_loc) ) + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + call check( nf90_close(gfile_loc_layout(nio)) ) + enddo + deallocate(gfile_loc_layout) + else + call check( nf90_close(gfile_loc) ) + endif endif + + call mpi_barrier(mpi_comm_world,ierror) + deallocate(work_bu,work_bv,u2d,v2d) deallocate(work_au,work_av) - end subroutine gsi_fv3ncdf_writeuv subroutine gsi_fv3ncdf_writeuv_v1(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin) !$$$ subprogram documentation block @@ -4080,7 +4171,7 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file ! !$$$ end documentation block - use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null + use mpimod, only: mpi_rtype,mpi_comm_world,mype,mpi_info_null,npe,setcomm,mpi_integer,mpi_max use mod_fv3_lola, only: fv3_ll_to_h use mod_fv3_lola, only: fv3_h_to_ll use netcdf, only: nf90_open,nf90_close @@ -4112,6 +4203,10 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file real(r_kind),allocatable,dimension(:,:):: workb2,worka2 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 + logical:: procuse + ! for io_layout > 1 real(r_kind),allocatable,dimension(:,:):: work_b_layout integer(i_kind) :: nio @@ -4133,143 +4228,168 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file allocate( workb2(nlon_regional,nlat_regional)) allocate( worka2(nlatcase,nloncase)) - if(fv3_io_layout_y > 1) then - allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) - do nio=0,fv3_io_layout_y-1 - write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio - call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_world,info=MPI_INFO_NULL) ) - enddo - gfile_loc=gfile_loc_layout(0) - else - call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_world,info=MPI_INFO_NULL) ) + procuse = .false. + members=-1 + members_read=-1 + if (kbgn<=kend) then + procuse = .true. + members(mm1) = mype endif - do ilevtot=kbgn,kend - vgsiname=grd_ionouv%names(1,ilevtot) - if(trim(vgsiname)=='amassi') cycle - if(trim(vgsiname)=='amassj') cycle - if(trim(vgsiname)=='amassk') cycle - if(trim(vgsiname)=='pm2_5') cycle - call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) - if(trim(filenamein) /= trim(filenamein2)) then - write(6,*)'filenamein and filenamein2 are not the same as expected, stop' - call flush(6) - call stop2(333) - endif - ilev=grd_ionouv%lnames(1,ilevtot) - nz=grd_ionouv%nsig - nzp1=nz+1 - inative=nzp1-ilev - countloc=(/nxcase,nycase,1/) - startloc=(/1,1,inative/) - - work_a=hwork(1,:,:,ilevtot) - - if( trim(varname) == 'ref_f3d' )then - iret=nf90_inquire_dimension(gfile_loc,1,name,len) - if(trim(name)=='xaxis_1') nx_phy=len - if( nx_phy == nxcase )then - allocate(work_b_tmp(nxcase,nycase)) - countloc_tmp=(/nxcase,nycase,1/) - phy_smaller_domain = .false. - else - allocate(work_b_tmp(nxcase-6,nycase-6)) - countloc_tmp=(/nxcase-6,nycase-6,1/) - phy_smaller_domain = .true. - end if - startloc_tmp=(/1,1,ilev/) - end if + call mpi_allreduce(members,members_read,npe,mpi_integer,mpi_max,mpi_comm_world,ierror) - call check( nf90_inq_varid(gfile_loc,trim(varname),VarId) ) + nread=0 + mype_read_rank=-1 + do i=1,npe + if (members_read(i) >= 0) then + nread=nread+1 + mype_read_rank(nread) = members_read(i) + endif + enddo + call setcomm(iworld,iworld_group,nread,mype_read_rank,mpi_comm_read,ierror) - if(index(vgsiname,"delzinc") > 0) then - if(fv3_io_layout_y > 1) then + if (procuse) then + if(fv3_io_layout_y > 1) then + allocate(gfile_loc_layout(0:fv3_io_layout_y-1)) do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(work_b_layout(nxcase,ny_layout_len(nio))) - call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) - work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout - deallocate(work_b_layout) + write(filename_layout,'(a,a,I4.4)') trim(filenamein),'.',nio + call check( nf90_open(filename_layout,nf90_write,gfile_loc_layout(nio),comm=mpi_comm_read,info=MPI_INFO_NULL) ) enddo - else - call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) - endif - call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - work_b(:,:)=work_b(:,:)+workb2(:,:) - else - if(add_saved)then - if(fv3_io_layout_y > 1) then + gfile_loc=gfile_loc_layout(0) + else + call check( nf90_open(filenamein,nf90_write,gfile_loc,comm=mpi_comm_read,info=MPI_INFO_NULL) ) + endif + + do ilevtot=kbgn,kend + vgsiname=grd_ionouv%names(1,ilevtot) + if(trim(vgsiname)=='amassi') cycle + if(trim(vgsiname)=='amassj') cycle + if(trim(vgsiname)=='amassk') cycle + if(trim(vgsiname)=='pm2_5') cycle + call getfv3lamfilevname(vgsiname,fv3filenamegin,filenamein2,varname) + if(trim(filenamein) /= trim(filenamein2)) then + write(6,*)'filenamein and filenamein2 are not the same as expected, stop' + call flush(6) + call stop2(333) + endif + ilev=grd_ionouv%lnames(1,ilevtot) + nz=grd_ionouv%nsig + nzp1=nz+1 + inative=nzp1-ilev + countloc=(/nxcase,nycase,1/) + startloc=(/1,1,inative/) + + work_a=hwork(1,:,:,ilevtot) + + if( trim(varname) == 'ref_f3d' )then + iret=nf90_inquire_dimension(gfile_loc,1,name,len) + if(trim(name)=='xaxis_1') nx_phy=len + if( nx_phy == nxcase )then + allocate(work_b_tmp(nxcase,nycase)) + countloc_tmp=(/nxcase,nycase,1/) + phy_smaller_domain = .false. + else + allocate(work_b_tmp(nxcase-6,nycase-6)) + countloc_tmp=(/nxcase-6,nycase-6,1/) + phy_smaller_domain = .true. + end if + startloc_tmp=(/1,1,ilev/) + end if + + call check( nf90_inq_varid(gfile_loc,trim(varname),VarId) ) + + + if(index(vgsiname,"delzinc") > 0) then + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(work_b_layout(nxcase,ny_layout_len(nio))) + call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) + work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + deallocate(work_b_layout) + enddo + else + call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) + endif + call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + work_b(:,:)=work_b(:,:)+workb2(:,:) + else + if(add_saved)then + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + countloc=(/nxcase,ny_layout_len(nio),1/) + allocate(work_b_layout(nxcase,ny_layout_len(nio))) + call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) + work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + deallocate(work_b_layout) + enddo + else + if( trim(varname) == 'ref_f3d' )then + work_b = 0.0_r_kind + call check( nf90_get_var(gfile_loc,VarId,work_b_tmp,start = startloc_tmp, count = countloc_tmp) ) + where(work_b_tmp < 0.0_r_kind) + work_b_tmp = 0.0_r_kind + end where + if(phy_smaller_domain)then + work_b(4:nxcase-3,4:nycase-3) = work_b_tmp + else + work_b(1:nxcase,1:nycase) = work_b_tmp + end if + else + call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) + end if + endif + call fv3_h_to_ll(work_b(:,:),worka2,nlon_regional,nlat_regional,nloncase,nlatcase,grid_reverse_flag) +!!!!!!!! analysis_inc: work_a !!!!!!!!!!!!!!!! + work_a(:,:)=work_a(:,:)-worka2(:,:) + call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + work_b(:,:)=work_b(:,:)+workb2(:,:) + else + call fv3_ll_to_h(work_a(:,:),work_b(:,:),nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) + endif + endif + if(fv3_io_layout_y > 1) then do nio=0,fv3_io_layout_y-1 countloc=(/nxcase,ny_layout_len(nio),1/) allocate(work_b_layout(nxcase,ny_layout_len(nio))) - call check( nf90_get_var(gfile_loc_layout(nio),VarId,work_b_layout,start = startloc, count = countloc) ) - work_b(:,ny_layout_b(nio):ny_layout_e(nio))=work_b_layout + work_b_layout=work_b(:,ny_layout_b(nio):ny_layout_e(nio)) + call check( nf90_put_var(gfile_loc_layout(nio),VarId,work_b_layout, start = startloc, count = countloc) ) deallocate(work_b_layout) - enddo - else - if( trim(varname) == 'ref_f3d' )then - work_b = 0.0_r_kind - call check( nf90_get_var(gfile_loc,VarId,work_b_tmp,start = startloc_tmp, count = countloc_tmp) ) - where(work_b_tmp < 0.0_r_kind) - work_b_tmp = 0.0_r_kind - end where - if(phy_smaller_domain)then - work_b(4:nxcase-3,4:nycase-3) = work_b_tmp - else - work_b(1:nxcase,1:nycase) = work_b_tmp - end if - else - call check( nf90_get_var(gfile_loc,VarId,work_b,start = startloc, count = countloc) ) - end if - endif - call fv3_h_to_ll(work_b(:,:),worka2,nlon_regional,nlat_regional,nloncase,nlatcase,grid_reverse_flag) -!!!!!!!! analysis_inc: work_a !!!!!!!!!!!!!!!! - work_a(:,:)=work_a(:,:)-worka2(:,:) - call fv3_ll_to_h(work_a(:,:),workb2,nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - work_b(:,:)=work_b(:,:)+workb2(:,:) - else - call fv3_ll_to_h(work_a(:,:),work_b(:,:),nloncase,nlatcase,nlon_regional,nlat_regional,grid_reverse_flag) - endif - endif - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - countloc=(/nxcase,ny_layout_len(nio),1/) - allocate(work_b_layout(nxcase,ny_layout_len(nio))) - work_b_layout=work_b(:,ny_layout_b(nio):ny_layout_e(nio)) - call check( nf90_put_var(gfile_loc_layout(nio),VarId,work_b_layout, start = startloc, count = countloc) ) - deallocate(work_b_layout) - enddo - else - if( trim(varname) == 'ref_f3d' )then - if(phy_smaller_domain)then - work_b_tmp = work_b(4:nxcase-3,4:nycase-3) - else - work_b_tmp = work_b(1:nxcase,1:nycase) - end if - where(work_b_tmp < 0.0_r_kind) - work_b_tmp = 0.0_r_kind - end where - call check( nf90_put_var(gfile_loc,VarId,work_b_tmp, start = startloc_tmp, count = countloc_tmp) ) - deallocate(work_b_tmp) - else - call check( nf90_put_var(gfile_loc,VarId,work_b, start = startloc, count = countloc) ) - end if - endif - - enddo !ilevtotl loop - if(fv3_io_layout_y > 1) then - do nio=0,fv3_io_layout_y-1 - call check(nf90_close(gfile_loc_layout(nio))) - enddo - deallocate(gfile_loc_layout) - else - call check(nf90_close(gfile_loc)) + enddo + else + if( trim(varname) == 'ref_f3d' )then + if(phy_smaller_domain)then + work_b_tmp = work_b(4:nxcase-3,4:nycase-3) + else + work_b_tmp = work_b(1:nxcase,1:nycase) + end if + where(work_b_tmp < 0.0_r_kind) + work_b_tmp = 0.0_r_kind + end where + call check( nf90_put_var(gfile_loc,VarId,work_b_tmp, start = startloc_tmp, count = countloc_tmp) ) + deallocate(work_b_tmp) + else + call check( nf90_put_var(gfile_loc,VarId,work_b, start = startloc, count = countloc) ) + end if + endif + + enddo !ilevtotl loop + if(fv3_io_layout_y > 1) then + do nio=0,fv3_io_layout_y-1 + call check(nf90_close(gfile_loc_layout(nio))) + enddo + deallocate(gfile_loc_layout) + else + call check(nf90_close(gfile_loc)) + endif endif + + call mpi_barrier(mpi_comm_world,ierror) + deallocate(work_b,work_a) deallocate(workb2,worka2) - end subroutine gsi_fv3ncdf_write subroutine check(status) use kinds, only: i_kind diff --git a/src/gsi/gsimod.F90 b/src/gsi/gsimod.F90 index de19c85fab..2656a2dce4 100644 --- a/src/gsi/gsimod.F90 +++ b/src/gsi/gsimod.F90 @@ -2216,7 +2216,7 @@ subroutine gsimain_initialize endif ! Set up directories (or pe specific filenames) - call init_directories(mype) + call init_directories(mype,npe) ! Initialize space for qc call create_qcvars diff --git a/src/gsi/guess_grids.F90 b/src/gsi/guess_grids.F90 index e19ce93638..bf493a0628 100644 --- a/src/gsi/guess_grids.F90 +++ b/src/gsi/guess_grids.F90 @@ -977,18 +977,29 @@ subroutine create_gesfinfo nfldaer_all=nfldaer nfldaer_now=0 extrap_intime=.true. - allocate(hrdifsfc(nfldsfc),ifilesfc(nfldsfc), & - hrdifnst(nfldnst),ifilenst(nfldnst), & - hrdifsig(nfldsig),ifilesig(nfldsig), & - hrdifaer(nfldaer),ifileaer(nfldaer), & - hrdifsfc_all(nfldsfc_all), & - hrdifnst_all(nfldnst_all), & - hrdifsig_all(nfldsig_all), & - hrdifaer_all(nfldaer_all), & - stat=istatus) + if(nfldsig>0) allocate(hrdifsig(nfldsig),ifilesig(nfldsig), & + hrdifsig_all(nfldsig_all), & + stat=istatus) if (istatus/=0) & - write(6,*)'CREATE_GESFINFO(hrdifsfc,..): allocate error, istatus=',& - istatus + call die('CREATE_GESFINFO', '(hrdifsig,..): allocate error, istatus=', istatus) + if(nfldsfc>0) allocate(hrdifsfc(nfldsfc),ifilesfc(nfldsfc), & + hrdifsfc_all(nfldsfc_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifsfc,..): allocate error, istatus=',& + istatus) + if(nfldnst>0) allocate(hrdifnst(nfldnst),ifilenst(nfldnst), & + hrdifnst_all(nfldnst_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifnst,..): allocate error, istatus=',& + istatus) + if(nfldnst>0) allocate(hrdifaer(nfldaer),ifileaer(nfldaer), & + hrdifaer_all(nfldaer_all), & + stat=istatus) + if (istatus/=0) & + call die('CREATE_GESFINFO', '(hrdifaer,..): allocate error, istatus=',& + istatus) #endif /* HAVE_ESMF */ return @@ -1030,11 +1041,18 @@ subroutine destroy_gesfinfo gesfinfo_created_=.false. #ifndef HAVE_ESMF - deallocate(hrdifsfc,ifilesfc,hrdifnst,hrdifaer,ifilenst,hrdifsig,ifilesig,ifileaer,& - hrdifsfc_all,hrdifnst_all,hrdifsig_all,hrdifaer_all,stat=istatus) + if(nfldsig>0) deallocate(hrdifsig,ifilesig,hrdifsig_all,stat=istatus) if (istatus/=0) & - write(6,*)'DESTROY_GESFINFO: deallocate error, istatus=',& - istatus + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldsfc>0) deallocate(hrdifsfc,ifilesfc,hrdifsfc_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldnst>0) deallocate(hrdifnst,ifilenst,hrdifnst_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) + if(nfldnst>0) deallocate(hrdifaer,ifileaer,hrdifaer_all,stat=istatus) + if (istatus/=0) & + call die('DESTROY_GESFINFO', 'deallocate error, istatus=',istatus) nfldsfc_all=0 nfldnst_all=0 diff --git a/src/gsi/mpeu_util.F90 b/src/gsi/mpeu_util.F90 index 960af8b71a..76271a4770 100644 --- a/src/gsi/mpeu_util.F90 +++ b/src/gsi/mpeu_util.F90 @@ -553,22 +553,6 @@ subroutine close_if_(fname,stat) endif end subroutine close_if_ -#ifdef _NEW_CODE_ -!! need to send outputs to variables. -!! need to set return code (stat=). -subroutine ls_(files) ! show information? or just inquire(exists(file)) - call system("ls "//files) -end subroutine ls_ -subroutine rm_(files) ! delete, open();close(status='delete') - call system("rm "//files) -end subroutine rm_ -subroutine mkdir_(dir,mode,parents) - call system("mkdir "//files) -end subroutine mkdir_ -subroutine size_(file) ! faster access? - call system("wc -c "//files) -end subroutine size_ -#endif #endif function myid_(who) diff --git a/src/gsi/obsmod.F90 b/src/gsi/obsmod.F90 index a059586e67..26f8ff1bbf 100644 --- a/src/gsi/obsmod.F90 +++ b/src/gsi/obsmod.F90 @@ -990,7 +990,7 @@ subroutine init_obsmod_dflts return end subroutine init_obsmod_dflts - subroutine init_directories(mype) + subroutine init_directories(in_pe,num_pe) !$$$ subprogram documentation block ! . . . . ! subprogram: create sub-directories @@ -1015,20 +1015,42 @@ subroutine init_directories(mype) ! machine: ibm rs/6000 sp ! !$$$ end documentation block +#ifdef __INTEL_COMPILER + use IFPORT +#endif implicit none - integer(i_kind),intent(in ) :: mype + integer(i_kind),intent(in ) :: in_pe + integer(i_kind),intent(in ) :: num_pe + logical :: l_mkdir_stat character(len=144):: command - character(len=8):: pe_name + character(len=8):: pe_name, loc_pe_name + character(len=128):: loc_dirname + integer(i_kind) :: i if (lrun_subdirs) then - write(pe_name,'(i4.4)') mype + write(pe_name,'(i4.4)') in_pe dirname = 'dir.'//trim(pe_name)//'/' - command = 'mkdir -p -m 755 ' // trim(dirname) - call system(command) +! Only create directories on one PE + if(in_pe == 0) then + do i = 0, num_pe + write(loc_pe_name,'(i4.4)') i + loc_dirname = 'dir.'//trim(loc_pe_name) +#ifdef __INTEL_COMPILER + l_mkdir_stat = MAKEDIRQQ(trim(loc_dirname)) + if(.not. l_mkdir_stat) then + write(6, *) "Failed to create directory ", trim(loc_dirname), " for PE ", loc_pe_name + call stop2(678) + endif +#else + command = 'mkdir -p -m 755 ' // trim(loc_dirname) + call system(command) +#endif + enddo + endif else - write(pe_name,100) mype + write(pe_name,100) in_pe 100 format('pe',i4.4,'.') dirname= trim(pe_name) end if diff --git a/src/gsi/read_files.f90 b/src/gsi/read_files.f90 index 5d29efbace..dadcbff3e5 100644 --- a/src/gsi/read_files.f90 +++ b/src/gsi/read_files.f90 @@ -585,7 +585,7 @@ subroutine read_files(mype) if (nst_gsi > 0 ) call mpi_bcast(time_nst,2*nfldnst,mpi_rtype,npem1,mpi_comm_world,ierror) ! for external aerosol files - if(.not.allocated(time_aer)) allocate(time_aer(nfldaer,2)) + if(lread_ext_aerosol .and. (.not.allocated(time_aer))) allocate(time_aer(nfldaer,2)) if (lread_ext_aerosol) call mpi_bcast(time_aer,2*nfldaer,mpi_rtype,npem1,mpi_comm_world,ierror) call mpi_bcast(iamana,3,mpi_rtype,npem1,mpi_comm_world,ierror) diff --git a/src/gsi/read_iasi.f90 b/src/gsi/read_iasi.f90 index 208b333f49..038188f92a 100644 --- a/src/gsi/read_iasi.f90 +++ b/src/gsi/read_iasi.f90 @@ -826,6 +826,8 @@ subroutine read_iasi(mype,val_iasi,ithin,isfcalc,rmesh,jsatid,gstime,& ! Put satinfo defined channel temperatures into data array do l=1,satinfo_nchan + ! Prevent out of bounds reference from temperature + if ( bufr_index(l) == 0 ) cycle i = bufr_index(l) data_all(l+nreal,itx) = temperature(i) ! brightness temerature end do diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90 index 15476e2d04..8e451c75be 100644 --- a/src/gsi/read_obs.F90 +++ b/src/gsi/read_obs.F90 @@ -1526,10 +1526,6 @@ subroutine read_obs(ndata,mype) call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,& prsl_full,nobs_sub1(1,i)) string='READ_FL_HDOB' - else if (index(infile,'uprair') /=0)then - call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,& - prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i)) - string='READ_UPRAIR' else call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,& prsl_full,nobs_sub1(1,i),read_rec(i)) diff --git a/src/gsi/read_prepbufr.f90 b/src/gsi/read_prepbufr.f90 index 2bf3a7d05d..b72e584155 100644 --- a/src/gsi/read_prepbufr.f90 +++ b/src/gsi/read_prepbufr.f90 @@ -690,7 +690,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999 ! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299 - if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(3))==562) then + if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(3),r_double)==562) then rstation_id=hdr(4) read(c_station_id,*,iostat=ios) iwmo if (ios == 0 .and. iwmo > 0) then @@ -700,7 +700,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if end if - if (id_ship .and. (kx==180) .and. (nint(hdr(3))==522 .or. nint(hdr(3))==523)) then + if (id_ship .and. (kx==180) .and. (nint(hdr(3),r_double)==522 .or. nint(hdr(3),r_double)==523)) then rstation_id=hdr(4) kx = kx + 18 end if @@ -969,7 +969,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! ! identify drifting buoys - TYP=180/280 T29=562 and last three digits of SID between 500 and 999 ! (see https://www.wmo.int/pages/prog/amp/mmop/wmo-number-rules.html) Set kx to 199/299 - if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(8))==562 ) then + if (id_drifter .and. (kx==180 .or. kx==280) .and. nint(hdr(8),r_double)==562) then rstation_id=hdr(1) read(c_station_id,*,iostat=ios) iwmo if (ios == 0 .and. iwmo > 0) then @@ -979,7 +979,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if end if - if (id_ship .and. (kx==180) .and. (nint(hdr(8))==522 .or. nint(hdr(8))==523) ) then + if (id_ship .and. (kx==180) .and. (nint(hdr(8),r_double)==522 .or. nint(hdr(8),r_double)==523) ) then rstation_id=hdr(1) kx = kx + 18 end if @@ -1179,7 +1179,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& enddo do k=1,levs ppb=obsdat(1,k) - cat=nint(min(obsdat(10,k),qcmark_huge)) + cat=idnint(min(obsdat(10,k),qcmark_huge)) if ( cat /=0 ) cycle ppb=max(zero,min(ppb,r2000)) if(ppb>=etabl_ps(itypex,1,1)) k1_ps=1 @@ -1608,11 +1608,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& plevs(k)=one_tenth*obsdat(1,k) ! convert mb to cb if (kx == 290) plevs(k)=101.0_r_kind ! Assume 1010 mb = 101.0 cb if (goesctpobs) plevs(k)=goescld(1,k)/1000.0_r_kind ! cloud top pressure in cb - pqm(k)=nint(qcmark(1,k)) - qqm(k)=nint(qcmark(2,k)) - tqm(k)=nint(qcmark(3,k)) - wqm(k)=nint(qcmark(5,k)) - pmq(k)=nint(qcmark(8,k)) + pqm(k)=idnint(qcmark(1,k)) + qqm(k)=idnint(qcmark(2,k)) + tqm(k)=idnint(qcmark(3,k)) + wqm(k)=idnint(qcmark(5,k)) + pmq(k)=idnint(qcmark(8,k)) end do ! 181, 183, 187, and 188 are the screen-level obs over land @@ -1642,14 +1642,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if (tpc(k,j)==glcd) then !found GLERL ob - use that and jump out of events stack obsdat(3,k)=tobaux(1,k,j) qcmark(3,k)=min(tobaux(2,k,j),qcmark_huge) - tqm(k)=nint(qcmark(3,k)) + tqm(k)=idnint(qcmark(3,k)) exit - endif - endif + end if + end if if (tpc(k,j)==vtcd) then obsdat(3,k)=tobaux(1,k,j+1) qcmark(3,k)=min(tobaux(2,k,j+1),qcmark_huge) - tqm(k)=nint(qcmark(3,k)) + tqm(k)=idnint(qcmark(3,k)) end if if (tpc(k,j)>=bmiss) exit ! end of stack end do @@ -1731,11 +1731,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& if(obsdat(2,k) > r0_01_bmiss)cycle loop_k_levs qm=qqm(k) else if(pwob) then - pwq=nint(qcmark(7,k)) + pwq=idnint(qcmark(7,k)) qm=pwq else if(sstob) then sstq=100 - if (k==1) sstq=nint(min(sstdat(4,k),qcmark_huge)) + if (k==1) sstq=idnint(min(sstdat(4,k),qcmark_huge)) qm=sstq else if(gustob) then gustqm=0 @@ -1791,10 +1791,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& end if if (psob) then - cat=nint(min(obsdat(10,k),qcmark_huge)) + cat=idnint(min(obsdat(10,k),qcmark_huge)) if ( cat /=0 ) cycle loop_k_levs if ( obsdat(1,k)< r500) qm=100 - zqm=nint(qcmark(4,k)) + zqm=idnint(qcmark(4,k)) if (zqm>=lim_zqm .and. zqm/=15 .and. zqm/=9) qm=9 endif @@ -1804,7 +1804,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,& ! extract aircraft profile information if (aircraft_t_bc .and. acft_profl_file) then - if (nint(obsdat(10,k))==7) cycle LOOP_K_LEVS + if (idnint(obsdat(10,k))==7) cycle LOOP_K_LEVS if(abs(hdr3(2,k))>r90 .or. abs(hdr3(1,k))>r360) cycle LOOP_K_LEVS if(hdr3(1,k)== r360)hdr3(1,k)=hdr3(1,k)-r360 if(hdr3(1,k) < zero)hdr3(1,k)=hdr3(1,k)+r360 @@ -3270,7 +3270,7 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) enddo do k=1,levs - cat(k)=nint(obsdat(10,k)) + cat(k)=idnint(obsdat(10,k)) enddo @@ -3287,10 +3287,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) if(kx==120)then - pqm(1)=nint(min(qcmark(1,1),10000.0)) - qqm(1)=nint(min(qcmark(2,1),10000.0)) - tqm(1)=nint(min(qcmark(3,1),10000.0)) - zqm(1)=nint(min(qcmark(4,1),10000.0)) + pqm(1)=idnint(min(qcmark(1,1),10000.0)) + qqm(1)=idnint(min(qcmark(2,1),10000.0)) + tqm(1)=idnint(min(qcmark(3,1),10000.0)) + zqm(1)=idnint(min(qcmark(4,1),10000.0)) call grdcrd(dpres,levs,prsltmp(1),nsig,-1) do k=1,levs tvflg(k)=one ! initialize as sensible @@ -3302,10 +3302,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) do i=2,levs im=i-1 - pqm(i)=nint(min(qcmark(1,i),10000.0)) - qqm(i)=nint(min(qcmark(2,i),10000.0)) - tqm(i)=nint(min(qcmark(3,i),10000.0)) - zqm(i)=nint(min(qcmark(4,i),10000.0)) + pqm(i)=idnint(min(qcmark(1,i),10000.0)) + qqm(i)=idnint(min(qcmark(2,i),10000.0)) + tqm(i)=idnint(min(qcmark(3,i),10000.0)) + zqm(i)=idnint(min(qcmark(4,i),10000.0)) if ( (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) .and. & pqm(i)<4 .and. pqm(im)<4 )then ku=dpres(i)-1 @@ -3361,14 +3361,14 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd) enddo !levs !!!!!!!!! w (not used) !!!!!!!!!!!!!!!!!!!!!!!!!!! elseif(kx==220)then - pqm(1)=nint(min(qcmark(1,1),10000.0)) - wqm(1)=nint(min(qcmark(5,1),10000.0)) + pqm(1)=idnint(min(qcmark(1,1),10000.0)) + wqm(1)=idnint(min(qcmark(5,1),10000.0)) call grdcrd(dpres,levs,prsltmp(1),nsig,-1) do i=2,levs im=i-1 - wqm(i)=nint(min(qcmark(5,i),10000.0)) - zqm(i)=nint(min(qcmark(4,i),10000.0)) - pqm(i)=nint(min(qcmark(1,i),10000.0)) + wqm(i)=idnint(min(qcmark(5,i),10000.0)) + zqm(i)=idnint(min(qcmark(4,i),10000.0)) + pqm(i)=idnint(min(qcmark(1,i),10000.0)) if( wqm(i)<4 .and. wqm(im)<4 .and. pqm(i)<4 .and. pqm(im)<4 .and.& (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) )then ku=dpres(i)-1 diff --git a/src/gsi/read_radar.f90 b/src/gsi/read_radar.f90 index 8e5de5aff9..40c77a7ee2 100644 --- a/src/gsi/read_radar.f90 +++ b/src/gsi/read_radar.f90 @@ -341,7 +341,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu if (.not.lexist1 .and. .not.lexist2 .and. .not.lexist3) return eradkm=rearth*0.001_r_kind - maxobs=2e8 + maxobs=4e6 nreal=maxdat nchanl=0 ilon=2 diff --git a/src/gsi/setupaod.f90 b/src/gsi/setupaod.f90 index a1e4656e76..5fe4233ada 100644 --- a/src/gsi/setupaod.f90 +++ b/src/gsi/setupaod.f90 @@ -61,7 +61,8 @@ subroutine setupaod(obsLL,odiagLL,lunin,mype,nchanl,nreal,nobs,& dplat,lobsdiagsave,lobsdiag_allocated,& dirname,time_offset,luse_obsdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo + nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo, & + nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin use gridmod, only: nsig,get_ij @@ -841,16 +842,16 @@ subroutine contents_netcdf_diag_ if ( iuse_aero(l) < 0 ) cycle call nc_diag_metadata("Channel_Index", i) call nc_diag_metadata("Observation_Class", obsclass) - call nc_diag_metadata("Latitude", sngl(cenlat)) ! observation latitude (degrees) - call nc_diag_metadata("Longitude", sngl(cenlon)) ! observation longitude (degrees) - call nc_diag_metadata("Obs_Time", sngl(dtime))!-time_offset)) ! observation time (hours relative to analysis time) - call nc_diag_metadata("Sol_Zenith_Angle", sngl(pangs)) ! solar zenith angle (degrees) - call nc_diag_metadata("Sol_Azimuth_Angle", sngl(data_s(isazi_ang,n))) ! solar azimuth angle (degrees) + call nc_diag_metadata_to_single("Latitude",(cenlat)) ! observation latitude (degrees) + call nc_diag_metadata_to_single("Longitude",(cenlon)) ! observation longitude (degrees) + call nc_diag_metadata_to_single("Obs_Time",(dtime))!-time_offset)) ! observation time (hours relative to analysis time) + call nc_diag_metadata_to_single("Sol_Zenith_Angle",(pangs)) ! solar zenith angle (degrees) + call nc_diag_metadata_to_single("Sol_Azimuth_Angle",(data_s(isazi_ang,n))) ! solar azimuth angle (degrees) call nc_diag_metadata("Surface_type", nint(data_s(istyp,n))) call nc_diag_metadata("MODIS_deep_blue_flag", nint(dbcf) ) - call nc_diag_metadata("Observation", sngl(diagbufchan(1,i)) ) ! observed aod - call nc_diag_metadata("Obs_Minus_Forecast_adjusted",sngl(diagbufchan(2,i))) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(diagbufchan(2,i)))! obs - sim aod with no bias correction + call nc_diag_metadata("Observation",(diagbufchan(1,i)) ) ! observed aod + call nc_diag_metadata("Obs_Minus_Forecast_adjusted",(diagbufchan(2,i))) + call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",(diagbufchan(2,i)))! obs - sim aod with no bias correction if (diagbufchan(3,i) > tiny_r_kind) then tmp(1)=one/diagbufchan(3,i) @@ -859,7 +860,7 @@ subroutine contents_netcdf_diag_ end if call nc_diag_metadata("Observation_Error",tmp(1)) - call nc_diag_metadata("QC_Flag", sngl(diagbufchan(4,i))) !quality control mark or event indicator + call nc_diag_metadata("QC_Flag",(diagbufchan(4,i))) !quality control mark or event indicator tmp(1)=get_zsfc() call nc_diag_metadata("sfc_height",tmp(1)) ! height in meters diff --git a/src/gsi/setupdbz.f90 b/src/gsi/setupdbz.f90 index 96f0378c52..068842cd6b 100644 --- a/src/gsi/setupdbz.f90 +++ b/src/gsi/setupdbz.f90 @@ -131,7 +131,7 @@ subroutine setupdbz(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,radardbz_d use obsmod, only: luse_obsdiag, netcdf_diag, binary_diag, dirname, ianldate use obsmod, only: doradaroneob,oneobddiff,oneobvalue use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close use oneobmod, only: oneobtest use oneobmod, only: maginnov @@ -1928,29 +1928,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(zero) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure", presw ) + call nc_diag_metadata_to_single("Height", data(ihgt,i) ) + call nc_diag_metadata_to_single("Time", dtime, time_offset, "-") + call nc_diag_metadata_to_single("Prep_QC_Mark", zero ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ! ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",one ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",-one ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) - call nc_diag_metadata("Observation", sngl(data(idbzob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(idbzob,i)-rdBZ) ) + call nc_diag_metadata_to_single("Observation", data(idbzob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", data(idbzob,i), rdBZ, "-") if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupdw.f90 b/src/gsi/setupdw.f90 index 93749b2ad9..63c0df4b19 100644 --- a/src/gsi/setupdw.f90 +++ b/src/gsi/setupdw.f90 @@ -37,7 +37,7 @@ subroutine setupdw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa use obsmod, only: rmiss_single,lobsdiag_forenkf use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsdiagNode, only: obs_diag use m_obsdiagNode, only: obs_diags @@ -904,29 +904,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) call nc_diag_metadata("Station_Elevation", missing ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) + call nc_diag_metadata_to_single("Pressure", presw ) + call nc_diag_metadata_to_single("Height", data(ihgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,"-" ) call nc_diag_metadata("Prep_QC_Mark", missing ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",one ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata_to_single("Analysis_Use_Flag",-one ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(data(ilob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(ilob,i)-dwwind)) + call nc_diag_metadata_to_single("Observation",data(ilob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", data(ilob,i), dwwind, '-') !_RT_NC4_TODO !_RT rdiagbuf(20,ii) = factw ! 10m wind reduction factor diff --git a/src/gsi/setuplight.f90 b/src/gsi/setuplight.f90 index e9ed19d3c3..040ef19bc6 100644 --- a/src/gsi/setuplight.f90 +++ b/src/gsi/setuplight.f90 @@ -90,7 +90,7 @@ subroutine setuplight(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,light_di nobskeep,lobsdiag_allocated use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use obsmod, only: luse_obsdiag use m_obsNode, only: obsNode @@ -1619,25 +1619,25 @@ subroutine contents_netcdf_diag_(odiag) real(r_single),parameter:: missing = -9.99e9_r_single real(r_kind),dimension(miter) :: obsdiag_iuse - call nc_diag_metadata("GLM_Detect_Err", sngl(data(ier,i)) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Lightning_FR_Obs", sngl(dlight ) ) - call nc_diag_metadata("Time", sngl(dtime) ) - call nc_diag_metadata("GLM_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("GLM_Orig_Detect_Err", sngl(data(ier2,i)) ) - call nc_diag_metadata("GLM_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("GLM_Detect_Err", data(ier,i) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Lightning_FR_Obs", dlight ) + call nc_diag_metadata_to_single("Time", dtime ) + call nc_diag_metadata_to_single("GLM_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("GLM_Orig_Detect_Err", data(ier2,i) ) + call nc_diag_metadata_to_single("GLM_Use_Flag", data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", 1._r_single ) else call nc_diag_metadata("Analysis_Use_Flag", -1._r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Obs_Minus_Forecast_VarBC", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_NoVarBC", sngl(dlight-lightges0) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_VarBC",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_NoVarBC",dlight,lightges0,'-') if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1650,7 +1650,7 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif end subroutine contents_netcdf_diag_ diff --git a/src/gsi/setuplwcp.f90 b/src/gsi/setuplwcp.f90 index 7e06144f68..7b1549aab4 100644 --- a/src/gsi/setuplwcp.f90 +++ b/src/gsi/setuplwcp.f90 @@ -68,7 +68,7 @@ subroutine setuplwcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header,nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close use state_vectors, only: svars3d, levels @@ -848,28 +848,28 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(iobsprs,i)) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(rmiss_single) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", data(iobsprs,i) ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata("Setup_QC_Mark", rmiss_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dlwcp) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dlwcp-lwcpges)) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Observation", dlwcp ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",dlwcp,lwcpges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90 index 34f94d3a10..d7a85de0b2 100644 --- a/src/gsi/setupoz.f90 +++ b/src/gsi/setupoz.f90 @@ -115,7 +115,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use state_vectors, only: svars3d, levels, nsdim - use constants, only : zero,half,one,two,tiny_r_kind + use constants, only : zero,half,one,two,tiny_r_kind,r_missing use constants, only : constoz,rozcon,cg_term,wgtlim,h300,r10,r100,r1000 use m_obsdiagNode, only : obs_diag @@ -138,7 +138,7 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin @@ -609,31 +609,35 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& sngl(prsitmp(1)*r1000) ) endif call nc_diag_metadata("MPI_Task_Number", mype ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Time", sngl(data(itime,i)-time_offset) ) - call nc_diag_metadata("Reference_Pressure",sngl(pobs(k)*r100) ) + call nc_diag_metadata_to_single("Latitude",(data(ilate,i)) ) + call nc_diag_metadata_to_single("Longitude",(data(ilone,i)) ) + if(isnan(dtime) .or. isnan(time_offset)) then + call nc_diag_metadata("Time",sngl(real(r_missing))) + else + call nc_diag_metadata("Time",sngl(dtime-time_offset)) + endif + call nc_diag_metadata_to_single("Reference_Pressure",(pobs(k)*r100)) call nc_diag_metadata("Analysis_Use_Flag", iouse(k) ) - call nc_diag_metadata("Observation", sngl(ozobs(k))) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errorinv)) - call nc_diag_metadata("Input_Observation_Error", sngl(error(k))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv(k))) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv(k))) - call nc_diag_metadata("Forecast_unadjusted", sngl(ozges(k))) - call nc_diag_metadata("Forecast_adjusted",sngl(ozges(k))) + call nc_diag_metadata_to_single("Observation",(ozobs(k))) + call nc_diag_metadata_to_single("Inverse_Observation_Error",(errorinv)) + call nc_diag_metadata_to_single("Input_Observation_Error", (error(k))) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",(ozone_inv(k))) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",(ozone_inv(k))) + call nc_diag_metadata_to_single("Forecast_unadjusted", (ozges(k))) + call nc_diag_metadata_to_single("Forecast_adjusted", (ozges(k))) if (obstype == 'gome' .or. obstype == 'omieff' .or. & obstype == 'omi' .or. obstype == 'tomseff' .or. & obstype == 'ompsnmeff' .or. obstype == 'ompsnm') then - call nc_diag_metadata("Solar_Zenith_Angle", sngl(data(isolz,i)) ) - call nc_diag_metadata("Scan_Position", sngl(data(ifovn,i)) ) + call nc_diag_metadata_to_single("Solar_Zenith_Angle",(data(isolz,i)) ) + call nc_diag_metadata_to_single("Scan_Position",(data(ifovn,i)) ) else - call nc_diag_metadata("Solar_Zenith_Angle", sngl(rmiss) ) - call nc_diag_metadata("Scan_Position", sngl(rmiss) ) + call nc_diag_metadata_to_single("Solar_Zenith_Angle",(rmiss) ) + call nc_diag_metadata_to_single("Scan_Position",(rmiss) ) endif if (obstype == 'omieff' .or. obstype == 'omi' ) then - call nc_diag_metadata("Row_Anomaly_Index", sngl(data(itoqf,i)) ) + call nc_diag_metadata_to_single("Row_Anomaly_Index",(data(itoqf,i)) ) else - call nc_diag_metadata("Row_Anomaly_Index", sngl(rmiss) ) + call nc_diag_metadata_to_single("Row_Anomaly_Index",(rmiss) ) endif if (save_jacobian) then call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) @@ -1085,7 +1089,7 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,& use obsmod, only: netcdf_diag, binary_diag, dirname ! use obsmod, only: wrtgeovals use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_o3lNode, only : o3lNode @@ -1717,25 +1721,26 @@ subroutine contents_netcdf_diag_(odiag) ! Observation class character(7),parameter :: obsclass = ' ozlev' real(r_kind),dimension(miter) :: obsdiag_iuse - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) call nc_diag_metadata("MPI_Task_Number", mype ) - call nc_diag_metadata("Time", sngl(data(itime,i)-time_offset)) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errorinv) ) - call nc_diag_metadata("Observation", sngl(ozlv) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ozone_inv) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted",sngl(ozone_inv) ) - call nc_diag_metadata("Reference_Pressure", sngl(preso3l*r100) ) ! Pa + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Inverse_Observation_Error",errorinv ) + call nc_diag_metadata_to_single("Observation", ozlv ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ozone_inv ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ozone_inv ) + call nc_diag_metadata_to_single("Reference_Pressure", preso3l*r100 ) ! Pa if(luse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", one ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", one ) else - call nc_diag_metadata("Analysis_Use_Flag", -one ) + call nc_diag_metadata_to_single("Analysis_Use_Flag", -one ) endif - call nc_diag_metadata("Input_Observation_Error", sngl(obserror) ) + + call nc_diag_metadata_to_single("Input_Observation_Error",obserror ) if(obstype =="ompslp")then - call nc_diag_metadata("Log10 Air Number Density", sngl(airnd)) - call nc_diag_metadata("Log10 Ozone Number Density UV", sngl(uvnd)) - call nc_diag_metadata("Log10 Ozone Number Density VIS",sngl(visnd)) + call nc_diag_metadata_to_single("Log10 Air Number Density",airnd ) + call nc_diag_metadata_to_single("Log10 Ozone Number Density UV",uvnd ) + call nc_diag_metadata_to_single("Log10 Ozone Number Density VIS",visnd ) endif call nc_diag_metadata("Forecast_adjusted", sngl(o3ppmv)) call nc_diag_metadata("Forecast_unadjusted", sngl(o3ppmv)) diff --git a/src/gsi/setupps.f90 b/src/gsi/setupps.f90 index 6a0fdd4fb2..118ccb45d2 100644 --- a/src/gsi/setupps.f90 +++ b/src/gsi/setupps.f90 @@ -125,7 +125,7 @@ subroutine setupps(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gridmod, only: nsig,get_ij,twodvar_regional use constants, only: zero,one_tenth,one,half,pi,g_over_rd, & @@ -890,30 +890,31 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(ipres,i)*r10)) - call nc_diag_metadata("Height", sngl(dhgt) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + !Replace direct calls to nc_diag_metadata with the screening subroutine + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", data(ipres,i),r10,'*' ) + call nc_diag_metadata_to_single("Height", dhgt ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", pob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",pob,pges,'-') + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",pob,pgesorig,'-') - call nc_diag_metadata("Observation", sngl(pob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(pob-pges) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(pob-pgesorig)) - if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setuppw.f90 b/src/gsi/setuppw.f90 index b22d4eb661..08872c0a51 100644 --- a/src/gsi/setuppw.f90 +++ b/src/gsi/setuppw.f90 @@ -96,7 +96,7 @@ subroutine setuppw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa lobsdiagsave,nobskeep,lobsdiag_allocated,time_offset use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_pwNode, only: pwNode @@ -721,27 +721,27 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset) ) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation", data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", prest ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) call nc_diag_metadata("Setup_QC_Mark", missing ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", 1._r_single ) else call nc_diag_metadata("Analysis_Use_Flag", -1._r_single ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dpw) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dpw-pwges) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + call nc_diag_metadata_to_single("Observation", dpw ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", dpw,pwges,'-' ) if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then diff --git a/src/gsi/setupq.f90 b/src/gsi/setupq.f90 index 554fe3e3dd..aa557b72c2 100644 --- a/src/gsi/setupq.f90 +++ b/src/gsi/setupq.f90 @@ -152,7 +152,7 @@ subroutine setupq(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin,min_offset use oneobmod, only: oneobtest,maginnov,magoberr @@ -1362,31 +1362,31 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) ! this is the obs height after being interpolated to the model (=model height) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presq) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", presq ) ! this is the original obs height (= stn elevation, before being interpolated) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - - call nc_diag_metadata("Observation", sngl(data(iqob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(qob-qges) ) - call nc_diag_metadata("Forecast_Saturation_Spec_Hum", sngl(qsges) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", data(iqob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",qob,qges,'-') + call nc_diag_metadata_to_single("Forecast_Saturation_Spec_Hum",qsges ) if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1399,14 +1399,14 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (twodvar_regional .or. l_obsprvdiag) then call nc_diag_metadata("Dominant_Sfc_Type", data(idomsfc,i) ) call nc_diag_metadata("Model_Terrain", data(izz,i) ) r_prvstg = data(iprvd,i) - call nc_diag_metadata("Provider_Name", c_prvstg ) + call nc_diag_metadata("Provider_Name", c_prvstg ) r_sprvstg = data(isprvd,i) call nc_diag_metadata("Subprovider_Name", c_sprvstg ) endif @@ -1428,29 +1428,29 @@ subroutine contents_netcdf_diagp_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", -1 ) ! (-1 for pseudo obs sub-type) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presq) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Latitude", data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude", data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure", presq ) + call nc_diag_metadata_to_single("Height", data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time", dtime,time_offset,'-' ) + call nc_diag_metadata_to_single("Prep_QC_Mark", data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag", data(iuse,i) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - - call nc_diag_metadata("Observation", sngl(data(iqob,i))) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(ddiff) ) - call nc_diag_metadata("Forecast_Saturation_Spec_Hum", sngl(qsges) ) + call nc_diag_metadata_to_single("Errinv_Input", errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust", errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final", errinv_final ) + + call nc_diag_metadata_to_single("Observation", data(iqob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ddiff ) + call nc_diag_metadata_to_single("Forecast_Saturation_Spec_Hum",qsges ) !---- if (lobsdiagsave) then do jj=1,miter @@ -1464,14 +1464,14 @@ subroutine contents_netcdf_diagp_(odiag) call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (twodvar_regional .or. l_obsprvdiag) then call nc_diag_metadata("Dominant_Sfc_Type", data(idomsfc,i) ) call nc_diag_metadata("Model_Terrain", data(izz,i) ) r_prvstg = data(iprvd,i) - call nc_diag_metadata("Provider_Name", "88888888" ) + call nc_diag_metadata("Provider_Name", "88888888" ) r_sprvstg = data(isprvd,i) call nc_diag_metadata("Subprovider_Name", "88888888" ) endif diff --git a/src/gsi/setuprad.f90 b/src/gsi/setuprad.f90 index 822ec8ea22..ebdd8de52a 100644 --- a/src/gsi/setuprad.f90 +++ b/src/gsi/setuprad.f90 @@ -270,7 +270,8 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,& use obsmod, only: luse_obsdiag,dval_use use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, nc_diag_chaninfo + nc_diag_write, nc_diag_data2d, nc_diag_chaninfo_dim_set, & + nc_diag_chaninfo, nc_diag_metadata_to_single use gsi_4dvar, only: nobs_bins,hr_obsbin,l4dvar use gridmod, only: nsig,regional,get_ij use satthin, only: super_val1 @@ -551,10 +552,12 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,& end if ! Load channel numbers into local array based on satellite type + if (iuse_rad(j)==4) then + predx(:,j)=zero + endif ich(jc)=j do i=1,npred - if (iuse_rad(j)==4) predx(i,j)=zero predchan(i,jc)=predx(i,j) end do ! @@ -2567,41 +2570,41 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) do i=1,nchanl_diag call nc_diag_metadata("Channel_Index", i ) call nc_diag_metadata("Observation_Class", obsclass ) - call nc_diag_metadata("Latitude", sngl(cenlat) ) ! observation latitude (degrees) - call nc_diag_metadata("Longitude", sngl(cenlon) ) ! observation longitude (degrees) + call nc_diag_metadata_to_single("Latitude",cenlat ) ! observation latitude (degrees) + call nc_diag_metadata_to_single("Longitude",cenlon ) ! observation longitude (degrees) - call nc_diag_metadata("Elevation", sngl(zsges) ) ! model (guess) elevation at observation location + call nc_diag_metadata_to_single("Elevation",zsges ) ! model (guess) elevation at observation location - call nc_diag_metadata("Obs_Time", sngl(dtime-time_offset) ) ! observation time (hours relative to analysis time) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') - call nc_diag_metadata("Scan_Position", sngl(data_s(iscan_pos,n)) ) ! sensor scan position - call nc_diag_metadata("Sat_Zenith_Angle", sngl(zasat*rad2deg) ) ! satellite zenith angle (degrees) - call nc_diag_metadata("Sat_Azimuth_Angle", sngl(data_s(ilazi_ang,n)) ) ! satellite azimuth angle (degrees) - call nc_diag_metadata("Sol_Zenith_Angle", sngl(pangs) ) ! solar zenith angle (degrees) - call nc_diag_metadata("Sol_Azimuth_Angle", sngl(data_s(isazi_ang,n)) ) ! solar azimuth angle (degrees) - call nc_diag_metadata("Sun_Glint_Angle", sngl(sgagl) ) ! sun glint angle (degrees) (sgagl) - call nc_diag_metadata("Scan_Angle", sngl(data_s(iscan_ang,n)*rad2deg) ) ! scan angle + call nc_diag_metadata_to_single("Scan_Position",data_s(iscan_pos,n) ) ! sensor scan position + call nc_diag_metadata_to_single("Sat_Zenith_Angle", zasat,rad2deg,'*') ! satellite zenith angle (degrees) + call nc_diag_metadata_to_single("Sat_Azimuth_Angle",data_s(ilazi_ang,n) ) ! satellite azimuth angle (degrees) + call nc_diag_metadata_to_single("Sol_Zenith_Angle",pangs ) ! solar zenith angle (degrees) + call nc_diag_metadata_to_single("Sol_Azimuth_Angle",data_s(isazi_ang,n) ) ! solar azimuth angle (degrees) + call nc_diag_metadata_to_single("Sun_Glint_Angle",sgagl ) ! sun glint angle (degrees) (sgagl) + call nc_diag_metadata_to_single("Scan_Angle",data_s(iscan_ang,n),rad2deg,'*' ) ! scan angle - call nc_diag_metadata("Water_Fraction", sngl(surface(1)%water_coverage) ) ! fractional coverage by water - call nc_diag_metadata("Land_Fraction", sngl(surface(1)%land_coverage) ) ! fractional coverage by land - call nc_diag_metadata("Ice_Fraction", sngl(surface(1)%ice_coverage) ) ! fractional coverage by ice - call nc_diag_metadata("Snow_Fraction", sngl(surface(1)%snow_coverage) ) ! fractional coverage by snow + call nc_diag_metadata_to_single("Water_Fraction",surface(1)%water_coverage ) ! fractional coverage by water + call nc_diag_metadata_to_single("Land_Fraction",surface(1)%land_coverage ) ! fractional coverage by land + call nc_diag_metadata_to_single("Ice_Fraction",surface(1)%ice_coverage ) ! fractional coverage by ice + call nc_diag_metadata_to_single("Snow_Fraction",surface(1)%snow_coverage ) ! fractional coverage by snow if(.not. retrieval)then - call nc_diag_metadata("Water_Temperature", sngl(surface(1)%water_temperature) ) ! surface temperature over water (K) - call nc_diag_metadata("Land_Temperature", sngl(surface(1)%land_temperature) ) ! surface temperature over land (K) - call nc_diag_metadata("Ice_Temperature", sngl(surface(1)%ice_temperature) ) ! surface temperature over ice (K) - call nc_diag_metadata("Snow_Temperature", sngl(surface(1)%snow_temperature) ) ! surface temperature over snow (K) - call nc_diag_metadata("Soil_Temperature", sngl(surface(1)%soil_temperature) ) ! soil temperature (K) - call nc_diag_metadata("Soil_Moisture", sngl(surface(1)%soil_moisture_content) ) ! soil moisture + call nc_diag_metadata_to_single("Water_Temperature",surface(1)%water_temperature ) ! surface temperature over water (K) + call nc_diag_metadata_to_single("Land_Temperature",surface(1)%land_temperature ) ! surface temperature over land (K) + call nc_diag_metadata_to_single("Ice_Temperature",surface(1)%ice_temperature ) ! surface temperature over ice (K) + call nc_diag_metadata_to_single("Snow_Temperature",surface(1)%snow_temperature ) ! surface temperature over snow (K) + call nc_diag_metadata_to_single("Soil_Temperature",surface(1)%soil_temperature ) ! soil temperature (K) + call nc_diag_metadata_to_single("Soil_Moisture",surface(1)%soil_moisture_content ) ! soil moisture call nc_diag_metadata("Land_Type_Index", surface(1)%land_type ) ! surface land type call nc_diag_metadata("tsavg5", missing ) ! SST first guess used for SST retrieval - call nc_diag_metadata("sstcu", missing ) ! NCEP SST analysis at t - call nc_diag_metadata("sstph", missing ) ! Physical SST retrieval - call nc_diag_metadata("sstnv", missing ) ! Navy SST retrieval + call nc_diag_metadata("sstcu", missing ) ! NCEP SST analysis at t + call nc_diag_metadata("sstph", missing ) ! Physical SST retrieval + call nc_diag_metadata("sstnv", missing ) ! Navy SST retrieval call nc_diag_metadata("dta", missing ) ! d(ta) corresponding to sstph call nc_diag_metadata("dqa", missing ) ! d(qa) corresponding to sstph - call nc_diag_metadata("dtp_avh", missing ) ! data type + call nc_diag_metadata("dtp_avh", missing ) ! data type else call nc_diag_metadata("Water_Temperature", missing ) ! surface temperature over water (K) call nc_diag_metadata("Land_Temperature", missing ) ! surface temperature over land (K) @@ -2610,27 +2613,27 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) call nc_diag_metadata("Soil_Temperature", missing ) ! soil temperature (K) call nc_diag_metadata("Soil_Moisture", missing ) ! soil moisture call nc_diag_metadata("Land_Type_Index", imissing ) ! surface land type - call nc_diag_metadata("tsavg5", sngl(tsavg5) ) ! SST first guess used for SST retrieval - call nc_diag_metadata("sstcu", sngl(sstcu) ) ! NCEP SST analysis at t - call nc_diag_metadata("sstph", sngl(sstph) ) ! Physical SST retrieval - call nc_diag_metadata("sstnv", sngl(sstnv) ) ! Navy SST retrieval - call nc_diag_metadata("dta", sngl(dta) ) ! d(ta) corresponding to sstph - call nc_diag_metadata("dqa", sngl(dqa) ) ! d(qa) corresponding to sstph - call nc_diag_metadata("dtp_avh", sngl(dtp_avh) ) ! data type + call nc_diag_metadata_to_single("tsavg5",tsavg5 ) ! SST first guess used for SST retrieval + call nc_diag_metadata_to_single("sstcu",sstcu ) ! NCEP SST analysis at t + call nc_diag_metadata_to_single("sstph",sstph ) ! Physical SST retrieval + call nc_diag_metadata_to_single("sstnv",sstnv ) ! Navy SST retrieval + call nc_diag_metadata_to_single("dta",dta ) ! d(ta) corresponding to sstph + call nc_diag_metadata_to_single("dqa",dqa ) ! d(qa) corresponding to sstph + call nc_diag_metadata_to_single("dtp_avh",dtp_avh ) ! data type endif - call nc_diag_metadata("Vegetation_Fraction", sngl(surface(1)%vegetation_fraction) ) - call nc_diag_metadata("Snow_Depth", sngl(surface(1)%snow_depth) ) - call nc_diag_metadata("tpwc", sngl(tpwc_obs) ) - call nc_diag_metadata("clw_guess_retrieval", sngl(clw_guess_retrieval) ) + call nc_diag_metadata_to_single("Vegetation_Fraction",surface(1)%vegetation_fraction ) + call nc_diag_metadata_to_single("Snow_Depth",surface(1)%snow_depth ) + call nc_diag_metadata_to_single("tpwc",tpwc_obs ) + call nc_diag_metadata_to_single("clw_guess_retrieval",clw_guess_retrieval ) - call nc_diag_metadata("Sfc_Wind_Speed", sngl(surface(1)%wind_speed) ) - call nc_diag_metadata("Cloud_Frac", sngl(cld) ) - call nc_diag_metadata("CTP", sngl(cldp) ) - call nc_diag_metadata("CLW", sngl(clw_obs) ) - call nc_diag_metadata("TPWC", sngl(tpwc_obs) ) - call nc_diag_metadata("clw_obs", sngl(clw_obs) ) - call nc_diag_metadata("clw_guess", sngl(clw_guess) ) + call nc_diag_metadata_to_single("Sfc_Wind_Speed",surface(1)%wind_speed ) + call nc_diag_metadata_to_single("Cloud_Frac",cld ) + call nc_diag_metadata_to_single("CTP",cldp ) + call nc_diag_metadata_to_single("CLW",clw_obs ) + call nc_diag_metadata_to_single("TPWC",tpwc_obs ) + call nc_diag_metadata_to_single("clw_obs",clw_obs ) + call nc_diag_metadata_to_single("clw_guess",clw_guess ) if (nstinfo==0) then data_s(itref,n) = missing @@ -2639,21 +2642,21 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) data_s(itz_tr,n) = missing endif - call nc_diag_metadata("Foundation_Temperature", sngl(data_s(itref,n)) ) ! reference temperature (Tr) in NSST - call nc_diag_metadata("SST_Warm_layer_dt", sngl(data_s(idtw,n)) ) ! dt_warm at zob - call nc_diag_metadata("SST_Cool_layer_tdrop", sngl(data_s(idtc,n)) ) ! dt_cool at zob - call nc_diag_metadata("SST_dTz_dTfound", sngl(data_s(itz_tr,n)) ) ! d(Tz)/d(Tr) + call nc_diag_metadata_to_single("Foundation_Temperature",data_s(itref,n) ) ! reference temperature (Tr) in NSST + call nc_diag_metadata_to_single("SST_Warm_layer_dt",data_s(idtw,n) ) ! dt_warm at zob + call nc_diag_metadata_to_single("SST_Cool_layer_tdrop",data_s(idtc,n) ) ! dt_cool at zob + call nc_diag_metadata_to_single("SST_dTz_dTfound",data_s(itz_tr,n) ) ! d(Tz)/d(Tr) - call nc_diag_metadata("Observation", sngl(tb_obs0(ich_diag(i))) ) ! observed brightness temperature (K) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(tbcnob(ich_diag(i))) ) ! observed - simulated Tb with no bias correction (K) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(tbc0(ich_diag(i) )) ) ! observed - simulated Tb with bias corrrection (K) + call nc_diag_metadata_to_single("Observation",tb_obs0(ich_diag(i)) ) ! observed brightness temperature (K) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",tbcnob(ich_diag(i)) ) ! observed - simulated Tb with no bias correction (K) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",tbc0(ich_diag(i) ) ) ! observed - simulated Tb with bias corrrection (K) errinv = sqrt(varinv0(ich_diag(i))) - call nc_diag_metadata("Inverse_Observation_Error", sngl(errinv) ) + call nc_diag_metadata_to_single("Inverse_Observation_Error",errinv ) if (save_jacobian .and. allocated(idnames)) then - call nc_diag_metadata("Observation_scaled", sngl(tb_obs(ich_diag(i))) ) ! observed brightness temperature (K) scaled by R^{-1/2} - call nc_diag_metadata("Obs_Minus_Forecast_adjusted_scaled", sngl(tbc(ich_diag(i) )) ) ! observed - simulated Tb with bias corrrection (K) scaled by R^{-1/2} + call nc_diag_metadata_to_single("Observation_scaled",tb_obs(ich_diag(i)) ) ! observed brightness temperature (K) scaled by R^{-1/2} + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted_scaled",tbc(ich_diag(i) ) ) ! observed - simulated Tb with bias corrrection (K) scaled by R^{-1/2} errinv = sqrt(varinv(ich_diag(i))) - call nc_diag_metadata("Inverse_Observation_Error_scaled", sngl(errinv) ) + call nc_diag_metadata_to_single("Inverse_Observation_Error_scaled",errinv ) endif if (save_jacobian) then j = 1 @@ -2692,34 +2695,34 @@ subroutine contents_netcdf_diag_(odiags,idv,iob) useflag=one if (iuse_rad(ich(ich_diag(i))) < 1) useflag=-one - call nc_diag_metadata("QC_Flag", sngl(id_qc(ich_diag(i))*useflag) ) ! quality control mark or event indicator - - call nc_diag_metadata("Emissivity", sngl(emissivity(ich_diag(i))) ) ! surface emissivity - call nc_diag_metadata("Weighted_Lapse_Rate", sngl(tlapchn(ich_diag(i))) ) ! stability index - call nc_diag_metadata("dTb_dTs", sngl(ts(ich_diag(i))) ) ! d(Tb)/d(Ts) - - call nc_diag_metadata("BC_Constant", sngl(predbias(1,ich_diag(i))) ) ! constant bias correction term - call nc_diag_metadata("BC_Scan_Angle", sngl(predbias(2,ich_diag(i))) ) ! scan angle bias correction term - call nc_diag_metadata("BC_Cloud_Liquid_Water", sngl(predbias(3,ich_diag(i))) ) ! CLW bias correction term - call nc_diag_metadata("BC_Lapse_Rate_Squared", sngl(predbias(4,ich_diag(i))) ) ! square lapse rate bias correction term - call nc_diag_metadata("BC_Lapse_Rate", sngl(predbias(5,ich_diag(i))) ) ! lapse rate bias correction term - call nc_diag_metadata("BC_Cosine_Latitude_times_Node", sngl(predbias(6,ich_diag(i))) ) ! node*cos(lat) bias correction term - call nc_diag_metadata("BC_Sine_Latitude", sngl(predbias(7,ich_diag(i))) ) ! sin(lat) bias correction term - call nc_diag_metadata("BC_Emissivity", sngl(predbias(8,ich_diag(i))) ) ! emissivity sensitivity bias correction term - call nc_diag_metadata("BC_Fixed_Scan_Position", sngl(predbias(npred+1,ich_diag(i))) ) ! external scan angle + call nc_diag_metadata("QC_Flag",sngl(id_qc(ich_diag(i))*useflag))! quality control mark or event indicator + + call nc_diag_metadata_to_single("Emissivity",emissivity(ich_diag(i)) ) ! surface emissivity + call nc_diag_metadata_to_single("Weighted_Lapse_Rate",tlapchn(ich_diag(i)) ) ! stability index + call nc_diag_metadata_to_single("dTb_dTs",ts(ich_diag(i)) ) ! d(Tb)/d(Ts) + + call nc_diag_metadata_to_single("BC_Constant",predbias(1,ich_diag(i)) ) ! constant bias correction term + call nc_diag_metadata_to_single("BC_Scan_Angle",predbias(2,ich_diag(i)) ) ! scan angle bias correction term + call nc_diag_metadata_to_single("BC_Cloud_Liquid_Water",predbias(3,ich_diag(i)) ) ! CLW bias correction term + call nc_diag_metadata_to_single("BC_Lapse_Rate_Squared",predbias(4,ich_diag(i)) ) ! square lapse rate bias correction term + call nc_diag_metadata_to_single("BC_Lapse_Rate",predbias(5,ich_diag(i)) ) ! lapse rate bias correction term + call nc_diag_metadata_to_single("BC_Cosine_Latitude_times_Node",predbias(6,ich_diag(i)) ) ! node*cos(lat) bias correction term + call nc_diag_metadata_to_single("BC_Sine_Latitude",predbias(7,ich_diag(i)) ) ! sin(lat) bias correction term + call nc_diag_metadata_to_single("BC_Emissivity",predbias(8,ich_diag(i)) ) ! emissivity sensitivity bias correction term + call nc_diag_metadata_to_single("BC_Fixed_Scan_Position",predbias(npred+1,ich_diag(i)) ) ! external scan angle if (lwrite_predterms) then - call nc_diag_metadata("BCPred_Constant", sngl(pred(1,ich_diag(i))) ) ! constant bias correction term - call nc_diag_metadata("BCPred_Scan_Angle", sngl(pred(2,ich_diag(i))) ) ! scan angle bias correction term - call nc_diag_metadata("BCPred_Cloud_Liquid_Water", sngl(pred(3,ich_diag(i))) ) ! CLW bias correction term - call nc_diag_metadata("BCPred_Lapse_Rate_Squared", sngl(pred(4,ich_diag(i))) ) ! square lapse rate bias correction term - call nc_diag_metadata("BCPred_Lapse_Rate", sngl(pred(5,ich_diag(i))) ) ! lapse rate bias correction term - call nc_diag_metadata("BCPred_Cosine_Latitude_times_Node", sngl(pred(6,ich_diag(i))) ) ! node*cos(lat) bias correction term - call nc_diag_metadata("BCPred_Sine_Latitude", sngl(pred(7,ich_diag(i))) ) ! sin(lat) bias correction term - call nc_diag_metadata("BCPred_Emissivity", sngl(pred(8,ich_diag(i))) ) ! emissivity sensitivity bias correction term + call nc_diag_metadata_to_single("BCPred_Constant",pred(1,ich_diag(i)) ) ! constant bias correction term + call nc_diag_metadata_to_single("BCPred_Scan_Angle",pred(2,ich_diag(i)) ) ! scan angle bias correction term + call nc_diag_metadata_to_single("BCPred_Cloud_Liquid_Water",pred(3,ich_diag(i)) ) ! CLW bias correction term + call nc_diag_metadata_to_single("BCPred_Lapse_Rate_Squared",pred(4,ich_diag(i)) ) ! square lapse rate bias correction term + call nc_diag_metadata_to_single("BCPred_Lapse_Rate",pred(5,ich_diag(i)) ) ! lapse rate bias correction term + call nc_diag_metadata_to_single("BCPred_Cosine_Latitude_times_Node",pred(6,ich_diag(i)) ) ! node*cos(lat) bias correction term + call nc_diag_metadata_to_single("BCPred_Sine_Latitude",pred(7,ich_diag(i)) ) ! sin(lat) bias correction term + call nc_diag_metadata_to_single("BCPred_Emissivity",pred(8,ich_diag(i)) ) ! emissivity sensitivity bias correction term endif if (lwrite_peakwt) then - call nc_diag_metadata("Press_Max_Weight_Function", sngl(weightmax(ich_diag(i))) ) + call nc_diag_metadata_to_single("Press_Max_Weight_Function",weightmax(ich_diag(i)) ) endif if (adp_anglebc) then do j=1, angord diff --git a/src/gsi/setuprw.f90 b/src/gsi/setuprw.f90 index 2211ee6caa..1e3900aafa 100644 --- a/src/gsi/setuprw.f90 +++ b/src/gsi/setuprw.f90 @@ -117,7 +117,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa doradaroneob,oneobddiff,oneobvalue, if_vrobs_raw, if_use_w_vr use obsmod, only: netcdf_diag, binary_diag, dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_rwNode, only: rwNode @@ -1319,30 +1319,30 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(zero) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata("Prep_QC_Mark", 0.0_r_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + + call nc_diag_metadata_to_single("Observation",data(irwob,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",data(irwob,i),rwwind,'-') - call nc_diag_metadata("Observation", sngl(data(irwob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(irwob,i)-rwwind) ) - if (lobsdiagsave) then do jj=1,miter if (odiag%muse(jj)) then @@ -1351,18 +1351,18 @@ subroutine contents_netcdf_diag_(odiag) obsdiag_iuse(jj) = -one endif enddo - + call nc_diag_data2d("ObsDiagSave_iuse", obsdiag_iuse ) call nc_diag_data2d("ObsDiagSave_nldepart", odiag%nldepart ) call nc_diag_data2d("ObsDiagSave_tldepart", odiag%tldepart ) - call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) + call nc_diag_data2d("ObsDiagSave_obssen", odiag%obssen ) endif if (save_jacobian) then call nc_diag_data2d("Observation_Operator_Jacobian_stind", dhx_dx%st_ind) call nc_diag_data2d("Observation_Operator_Jacobian_endind", dhx_dx%end_ind) call nc_diag_data2d("Observation_Operator_Jacobian_val", real(dhx_dx%val,r_single)) endif - + end subroutine contents_netcdf_diag_ subroutine final_vars_ diff --git a/src/gsi/setupspd.f90 b/src/gsi/setupspd.f90 index 91b2467bf3..64366394cb 100644 --- a/src/gsi/setupspd.f90 +++ b/src/gsi/setupspd.f90 @@ -114,7 +114,7 @@ subroutine setupspd(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags use obsmod, only: netcdf_diag, binary_diag, dirname, ianldate use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_spdNode, only: spdNode @@ -949,29 +949,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(spdob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(spdob0-spdges) ) + call nc_diag_metadata_to_single("Observation",spdob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", spdob0,spdges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupsst.f90 b/src/gsi/setupsst.f90 index 6562d0392f..27d08daa86 100644 --- a/src/gsi/setupsst.f90 +++ b/src/gsi/setupsst.f90 @@ -99,7 +99,7 @@ subroutine setupsst(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags use obsmod, only: luse_obsdiag use obsmod, only: netcdf_diag, binary_diag, dirname,ianldate use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin use oneobmod, only: magoberr,maginnov,oneobtest @@ -585,35 +585,35 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) call nc_diag_metadata("Pressure", missing ) - call nc_diag_metadata("Height", sngl(data(izob,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(ipct,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Height",data(izob,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(ipct,i) ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) ! call nc_diag_metadata("Nonlinear_QC_Var_Jb", var_jb ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) if(muse(i)) then - call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) + call nc_diag_metadata("Analysis_Use_Flag", 1.0_r_single ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", -1.0_r_single ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(data(isst,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(data(isst,i)-sstges) ) + call nc_diag_metadata_to_single("Observation",data(isst,i) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",data(isst,i),sstges,'-') if (nst_gsi>0) then - call nc_diag_metadata("FoundationTempBG", sngl(data(itref,i)) ) - call nc_diag_metadata("DiurnalWarming_at_zob", sngl(data(idtw,i)) ) - call nc_diag_metadata("SkinLayerCooling_at_zob", sngl(data(idtw,i)) ) - call nc_diag_metadata("Sensitivity_Tzob_Tr", sngl(data(itz_tr,i)) ) + call nc_diag_metadata_to_single("FoundationTempBG",data(itref,i) ) + call nc_diag_metadata_to_single("DiurnalWarming_at_zob",data(idtw,i) ) + call nc_diag_metadata_to_single("SkinLayerCooling_at_zob",data(idtw,i) ) + call nc_diag_metadata_to_single("Sensitivity_Tzob_Tr",data(itz_tr,i) ) endif if (lobsdiagsave) then diff --git a/src/gsi/setupswcp.f90 b/src/gsi/setupswcp.f90 index c65ad1495c..6797357103 100644 --- a/src/gsi/setupswcp.f90 +++ b/src/gsi/setupswcp.f90 @@ -67,7 +67,7 @@ subroutine setupswcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header,nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init,nc_diag_read_get_dim,nc_diag_read_close use state_vectors, only: svars3d, levels @@ -893,28 +893,28 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(data(iobsprs,i)) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(rmiss_single) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i) ) + call nc_diag_metadata_to_single("Pressure",data(iobsprs,i) ) + call nc_diag_metadata_to_single("Height",data(iobshgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) + call nc_diag_metadata("Setup_QC_Mark",rmiss_single ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(dswcp) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(dswcp-swcpges)) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Observation",dswcp ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted", dswcp,swcpges,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupt.f90 b/src/gsi/setupt.f90 index a0710e8abb..5467a6dec9 100644 --- a/src/gsi/setupt.f90 +++ b/src/gsi/setupt.f90 @@ -42,7 +42,7 @@ subroutine setupt(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: netcdf_diag, binary_diag, dirname use obsmod, only: l_obsprvdiag use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use qcmod, only: npres_print,dfact,dfact1,ptop,pbot,buddycheck_t @@ -1767,42 +1767,42 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i)) + call nc_diag_metadata_to_single("Longitude",data(ilone,i)) ! this is the obs height after being interpolated to the model (=model height) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i)) + call nc_diag_metadata_to_single("Pressure",prest) ! this is the original obs height (= stn elevation, before being interpolated) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(data(iqt,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Height",data(iobshgt,i)) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i)) + call nc_diag_metadata_to_single("Setup_QC_Mark",data(iqt,i)) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i)) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) if (hofx_2m_sfcfile ) then - call nc_diag_metadata("Observation", sngl(tob) ) + call nc_diag_metadata_to_single("Observation", tob ) else - call nc_diag_metadata("Observation", sngl(data(itob,i)) ) + call nc_diag_metadata_to_single("Observation", data(itob,i) ) endif - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(tob-tges) ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",tob,tges,'-') if (aircraft_t_bc_pof .or. aircraft_t_bc .or. aircraft_t_bc_ext) then - call nc_diag_metadata("Data_Pof", sngl(data(ipof,i)) ) - call nc_diag_metadata("Data_Vertical_Velocity", sngl(data(ivvlc,i)) ) + call nc_diag_metadata_to_single("Data_Pof",data(ipof,i)) + call nc_diag_metadata_to_single("Data_Vertical_Velocity",data(ivvlc,i)) if (npredt .gt. one) then call nc_diag_data2d("Bias_Correction_Terms", sngl(predbias) ) else if (npredt .eq. one) then - call nc_diag_metadata("Bias_Correction_Terms", sngl(predbias(1)) ) + call nc_diag_metadata_to_single("Bias_Correction_Terms",predbias(1)) endif else call nc_diag_metadata("Data_Pof", missing ) @@ -1856,33 +1856,35 @@ subroutine contents_netcdf_diagp_(odiag) real(r_single),parameter:: missing = -9.99e9_r_single real(r_kind),dimension(miter) :: obsdiag_iuse + real(r_kind) :: var_jb_m call nc_diag_metadata("Station_ID", station_id ) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", -1 ) ! (-1 for pseudo obs sub-type) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(istnelv,i)) ) - call nc_diag_metadata("Pressure", sngl(prest) ) - call nc_diag_metadata("Height", sngl(data(iobshgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) - call nc_diag_metadata("Setup_QC_Mark", sngl(data(iqt,i)) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i)) + call nc_diag_metadata_to_single("Longitude",data(ilone,i)) + call nc_diag_metadata_to_single("Station_Elevation",data(istnelv,i)) + call nc_diag_metadata_to_single("Pressure",prest) + call nc_diag_metadata_to_single("Height",data(iobshgt,i)) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i)) + call nc_diag_metadata_to_single("Setup_QC_Mark",data(iqt,i)) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i)) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(var_jb*1.0e+6+rwgt)) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Observation", sngl(data(itob,i)) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(ddiff) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(ddiff) ) + var_jb_m = var_jb * 1.0e+6 + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",var_jb_m,rwgt,'-') + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Observation",data(itob,i)) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",ddiff ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",ddiff ) !---- if (lobsdiagsave) then diff --git a/src/gsi/setuptcp.f90 b/src/gsi/setuptcp.f90 index cfef05d06c..3d13c5fe8e 100644 --- a/src/gsi/setuptcp.f90 +++ b/src/gsi/setuptcp.f90 @@ -57,7 +57,7 @@ subroutine setuptcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags time_offset,rmiss_single,lobsdiagsave,lobsdiag_forenkf,ianldate use obsmod, only: netcdf_diag, binary_diag, dirname use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use m_obsNode, only: obsNode use m_tcpNode, only: tcpNode @@ -692,29 +692,29 @@ subroutine contents_netcdf_diag_(odiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) call nc_diag_metadata("Station_Elevation", sngl(zero) ) - call nc_diag_metadata("Pressure", sngl(data(ipres,i)*r10)) - call nc_diag_metadata("Height", sngl(zero) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) + call nc_diag_metadata_to_single("Pressure", data(ipres,i),r10,'*') + call nc_diag_metadata_to_single("Height",zero ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') call nc_diag_metadata("Prep_QC_Mark", sngl(one) ) call nc_diag_metadata("Prep_Use_Flag", sngl(one) ) - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",(rwgt) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else - call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) + call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) - call nc_diag_metadata("Observation", sngl(pob) ) - call nc_diag_metadata("Obs_Minus_Forecast_adjusted", sngl(pob-pges) ) - call nc_diag_metadata("Obs_Minus_Forecast_unadjusted", sngl(pob-pgesorig)) + call nc_diag_metadata_to_single("Observation",pob ) + call nc_diag_metadata_to_single("Obs_Minus_Forecast_adjusted",pob,pges,'-') + call nc_diag_metadata_to_single("Obs_Minus_Forecast_unadjusted",pob,pgesorig,'-') if (lobsdiagsave) then do jj=1,miter diff --git a/src/gsi/setupw.f90 b/src/gsi/setupw.f90 index 97ed1f8883..087c3c34ab 100644 --- a/src/gsi/setupw.f90 +++ b/src/gsi/setupw.f90 @@ -44,7 +44,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav use obsmod, only: l_obsprvdiag use obsmod, only: neutral_stability_windfact_2dvar,use_similarity_2dvar use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, & - nc_diag_write, nc_diag_data2d + nc_diag_write, nc_diag_data2d, nc_diag_metadata_to_single use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close use gsi_4dvar, only: nobs_bins,hr_obsbin,min_offset use qcmod, only: npres_print,ptop,pbot,dfact,dfact1,qc_satwnds,njqc,vqc @@ -1782,37 +1782,37 @@ subroutine contents_netcdf_diag_(udiag,vdiag) call nc_diag_metadata("Observation_Class", obsclass ) call nc_diag_metadata("Observation_Type", ictype(ikx) ) call nc_diag_metadata("Observation_Subtype", icsubtype(ikx) ) - call nc_diag_metadata("Latitude", sngl(data(ilate,i)) ) - call nc_diag_metadata("Longitude", sngl(data(ilone,i)) ) - call nc_diag_metadata("Station_Elevation", sngl(data(ielev,i)) ) - call nc_diag_metadata("Pressure", sngl(presw) ) - call nc_diag_metadata("Height", sngl(data(ihgt,i)) ) - call nc_diag_metadata("Time", sngl(dtime-time_offset)) - call nc_diag_metadata("Prep_QC_Mark", sngl(data(iqc,i)) ) + call nc_diag_metadata_to_single("Latitude",data(ilate,i) ) + call nc_diag_metadata_to_single("Longitude",data(ilone,i) ) + call nc_diag_metadata_to_single("Station_Elevation",data(ielev,i) ) + call nc_diag_metadata_to_single("Pressure",presw ) + call nc_diag_metadata_to_single("Height",data(ihgt,i) ) + call nc_diag_metadata_to_single("Time",dtime,time_offset,'-') + call nc_diag_metadata_to_single("Prep_QC_Mark",data(iqc,i) ) ! call nc_diag_metadata("Setup_QC_Mark", rmiss_single ) - call nc_diag_metadata("Setup_QC_Mark", sngl(bmiss) ) - call nc_diag_metadata("Nonlinear_QC_Var_Jb", sngl(var_jb) ) - call nc_diag_metadata("Prep_Use_Flag", sngl(data(iuse,i)) ) + call nc_diag_metadata_to_single("Setup_QC_Mark",bmiss ) + call nc_diag_metadata_to_single("Nonlinear_QC_Var_Jb",var_jb ) + call nc_diag_metadata_to_single("Prep_Use_Flag",data(iuse,i) ) if(muse(i)) then call nc_diag_metadata("Analysis_Use_Flag", sngl(one) ) else call nc_diag_metadata("Analysis_Use_Flag", sngl(-one) ) endif - call nc_diag_metadata("Nonlinear_QC_Rel_Wgt", sngl(rwgt) ) - call nc_diag_metadata("Errinv_Input", sngl(errinv_input) ) - call nc_diag_metadata("Errinv_Adjust", sngl(errinv_adjst) ) - call nc_diag_metadata("Errinv_Final", sngl(errinv_final) ) - call nc_diag_metadata("Wind_Reduction_Factor_at_10m", sngl(factw) ) + call nc_diag_metadata_to_single("Nonlinear_QC_Rel_Wgt",rwgt ) + call nc_diag_metadata_to_single("Errinv_Input",errinv_input ) + call nc_diag_metadata_to_single("Errinv_Adjust",errinv_adjst ) + call nc_diag_metadata_to_single("Errinv_Final",errinv_final ) + call nc_diag_metadata_to_single("Wind_Reduction_Factor_at_10m",factw ) if (.not. regional .or. fv3_regional) then - call nc_diag_metadata("u_Observation", sngl(data(iuob,i)) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted", sngl(dudiff) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted", sngl(uob-ugesin) ) + call nc_diag_metadata_to_single("u_Observation",data(iuob,i) ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_adjusted",dudiff ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_unadjusted",uob,ugesin,'-') - call nc_diag_metadata("v_Observation", sngl(data(ivob,i)) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted", sngl(dvdiff) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted", sngl(vob-vgesin) ) + call nc_diag_metadata_to_single("v_Observation",data(ivob,i) ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_adjusted",dvdiff ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_unadjusted",vob,vgesin,'-') else ! (if regional) ! replace positions 17-22 with earth relative wind component information @@ -1823,13 +1823,13 @@ subroutine contents_netcdf_diag_(udiag,vdiag) call rotate_wind_xy2ll(ugesin,vgesin,uges_e,vges_e,dlon_e,dlon,dlat) call rotate_wind_xy2ll(dudiff,dvdiff,dudiff_e,dvdiff_e,dlon_e,dlon,dlat) - call nc_diag_metadata("u_Observation", sngl(uob_e) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted", sngl(dudiff_e) ) - call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted", sngl(uob_e-uges_e) ) + call nc_diag_metadata_to_single("u_Observation",uob_e ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_adjusted",dudiff_e ) + call nc_diag_metadata_to_single("u_Obs_Minus_Forecast_unadjusted",uob_e,uges_e,'-') - call nc_diag_metadata("v_Observation", sngl(vob_e) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted", sngl(dvdiff_e) ) - call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted", sngl(vob_e-vges_e) ) + call nc_diag_metadata_to_single("v_Observation",vob_e ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_adjusted",dvdiff_e ) + call nc_diag_metadata_to_single("v_Obs_Minus_Forecast_unadjusted",vob_e,vges_e,'-') endif if (lobsdiagsave) then diff --git a/src/gsi/stpcalc.f90 b/src/gsi/stpcalc.f90 index 30387341e3..dd60703ce2 100644 --- a/src/gsi/stpcalc.f90 +++ b/src/gsi/stpcalc.f90 @@ -263,7 +263,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & real(r_quad),parameter:: one_tenth_quad = 0.1_r_quad ! Declare local variables - integer(i_kind) i,j,mm1,ii,iis,ibin,ipenloc,it + integer(i_kind) i,j,mm1,ii,iis,final_ii,ibin,ipenloc,it integer(i_kind) istp_use,nstep,nsteptot,kprt real(r_quad),dimension(4,ipen):: pbc real(r_quad),dimension(4,nobs_type):: pbcjo @@ -299,6 +299,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & kprt=3 pjcalc=.false. pj=zero_quad + final_ii=1 ! Begin calculating contributions to penalty and stepsize for various terms ! @@ -779,6 +780,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & write(iout_iter,*) ' early termination due to cx or stp <=0 ',cx,stp(ii) write(iout_iter,*) ' better stepsize found',cx,stp(ii) end if + final_ii=ii exit stepsize else if(ii == istp_iter)then if(mype == minmype)then @@ -786,6 +788,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end if stp(istp_use)=zero end_iter = .true. + final_ii=ii exit stepsize else ! Try different (better?) stepsize @@ -810,12 +813,16 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end_iter = .true. ! Finalize timer call timer_fnl('stpcalc') + final_ii=ii exit stepsize end if ! Check for convergence in stepsize estimation stprat(ii)=zero if(stp(ii) > zero_quad)stprat(ii)=abs((stp(ii)-stp(ii-1))/stp(ii)) - if(stprat(ii) < 1.e-4_r_kind) exit stepsize + if(stprat(ii) < 1.e-4_r_kind) then + final_ii=ii + exit stepsize + end if dels = one_tenth_quad*dels end if @@ -842,7 +849,10 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & istp_use=i end if end do - if(istp_use /= istp_iter)exit stepsize + if(istp_use /= istp_iter) then + final_ii=ii + exit stepsize + end if ! If no best stepsize set to zero and end minimization if(mype == minmype)then write(iout_iter,141)(outpen(i),i=1,nsteptot) @@ -850,8 +860,10 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & end_iter = .true. stp(ii)=zero_quad istp_use=ii + final_ii=ii exit stepsize end if + final_ii=ii end do stepsize if(kprt >= 2 .and. iter == 0)then call mpl_allreduce(ipen,nobs_bins,pj) @@ -882,7 +894,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & if(print_verbose)then write(iout_iter,200) (stp(i),i=0,istp_use) - write(iout_iter,199) (stprat(ii),ii=1,istp_use) + write(iout_iter,199) (stprat(i),i=1,istp_use) write(iout_iter,201) (outstp(i),i=1,nsteptot) write(iout_iter,202) (outpen(i)-outpen(4),i=1,nsteptot) end if @@ -890,7 +902,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, & ! Check for final stepsize negative (probable error) if(stpinout <= zero)then if(mype == minmype)then - write(iout_iter,130) ii,bx,cx,stp(ii) + write(iout_iter,130) final_ii,bx,cx,stp(final_ii) write(iout_iter,105) (bsum(i),i=1,ipen) write(iout_iter,110) (csum(i),i=1,ipen) write(iout_iter,101) (pbc(1,i)-pen_est(i),i=1,ipen) diff --git a/ush/build.sh b/ush/build.sh index 71674c4f4c..9a280c4e55 100755 --- a/ush/build.sh +++ b/ush/build.sh @@ -30,7 +30,6 @@ set -x # Set CONTROLPATH variable to user develop installation CONTROLPATH="$DIR_ROOT/../develop/install/bin" - # Collect BUILD Options CMAKE_OPTS+=" -DCMAKE_BUILD_TYPE=$BUILD_TYPE" diff --git a/ush/detect_machine.sh b/ush/detect_machine.sh index ecd1ad536e..6f0673ce29 100755 --- a/ush/detect_machine.sh +++ b/ush/detect_machine.sh @@ -3,7 +3,7 @@ case $(hostname -f) in adecflow0[12].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn - alogin0[12].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn + alogin0[1-3].acorn.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### acorn clogin0[1-9].cactus.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### cactus01-9 clogin10.cactus.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### cactus10 dlogin0[1-9].dogwood.wcoss2.ncep.noaa.gov) MACHINE_ID=wcoss2 ;; ### dogwood01-9 @@ -28,6 +28,7 @@ case $(hostname -f) in cheyenne[1-6].cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 cheyenne[1-6].ib0.cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 chadmin[1-6].ib0.cheyenne.ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 + chadmin[1-6].ucar.edu) MACHINE_ID=cheyenne ;; ### cheyenne1-6 login[1-4].stampede2.tacc.utexas.edu) MACHINE_ID=stampede ;; ### stampede1-4 diff --git a/ush/module-setup.sh b/ush/module-setup.sh index 469fd4a3c5..ab92477a56 100755 --- a/ush/module-setup.sh +++ b/ush/module-setup.sh @@ -18,7 +18,7 @@ elif [[ $MACHINE_ID = hera* ]] ; then elif [[ $MACHINE_ID = orion* ]] ; then # We are on Orion if ( ! eval module help > /dev/null 2>&1 ) ; then - source /apps/lmod/init/bash + source /apps/lmod/lmod/init/bash fi module purge @@ -57,33 +57,10 @@ elif [[ $MACHINE_ID = gaea* ]] ; then # /etc/profile here. source /etc/profile __ms_source_etc_profile=yes - else - __ms_source_etc_profile=no - fi - module purge - # clean up after purge - unset _LMFILES_ - unset _LMFILES_000 - unset _LMFILES_001 - unset LOADEDMODULES - module load modules - if [[ -d /opt/cray/ari/modulefiles ]] ; then - module use -a /opt/cray/ari/modulefiles - fi - if [[ -d /opt/cray/pe/ari/modulefiles ]] ; then - module use -a /opt/cray/pe/ari/modulefiles - fi - if [[ -d /opt/cray/pe/craype/default/modulefiles ]] ; then - module use -a /opt/cray/pe/craype/default/modulefiles - fi - if [[ -s /etc/opt/cray/pe/admin-pe/site-config ]] ; then - source /etc/opt/cray/pe/admin-pe/site-config - fi - if [[ "$__ms_source_etc_profile" == yes ]] ; then - source /etc/profile - unset __ms_source_etc_profile fi + source /lustre/f2/dev/role.epic/contrib/Lmod_init.sh + elif [[ $MACHINE_ID = expanse* ]]; then # We are on SDSC Expanse if ( ! eval module help > /dev/null 2>&1 ) ; then diff --git a/ush/sub_cheyenne b/ush/sub_cheyenne new file mode 100644 index 0000000000..7389bfeb24 --- /dev/null +++ b/ush/sub_cheyenne @@ -0,0 +1,169 @@ +#!/bin/sh --login +set -x +echo "starting sub_cheyenne" +usage="\ +Usage: $0 [options] executable [args] + where the options are: + -a account account (default: none) + -b binding run smt binding or not (default:NO) + -d dirin initial directory (default: cwd) + -e envars copy comma-separated environment variables + -g group group name + -i append standard input to command file + -j jobname specify jobname (default: executable basename) + -m machine machine on which to run (default: current) + -n write command file to stdout rather than submitting it + -o output specify output file (default: jobname.out) + -p procs[/nodes[/ppreq] + number of MPI tasks and optional nodes or Bblocking and + ppreq option (N or S) (defaults: serial, Bunlimited, S) + -q queue[/qpreq] queue name and optional requirement, e.g. dev/P + (defaults: 1 if serial or dev if parallel and none) + (queue 3 or 4 is dev or prod with twice tasks over ip) + (options: P=parallel, B=bigmem, b=batch) + -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) + -t timew wall time limit in [[hh:]mm:]ss format (default: 900) + -u userid userid to run under (default: self) + -v verbose mode + -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or + Thh[mm] (full, incremental, today or tomorrow) format + (default: now) +Function: This command submits a job to the batch queue." +subcmd="$*" +stdin=NO +nosub=NO +account="" +binding="NO" +dirin="" +envars="" +group="" +jobname="" +machine="" +output="" +procs=0 +nodes="" +ppreq="" +queue="" +qpreq="" +rmem="1024" +rcpu="1" +timew="900" +userid="" +verbose=NO +when="" +while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do + case $opt in + a) account="$OPTARG";; + b) binding="$OPTARG";; + d) dirin="$OPTARG";; + e) envars="$OPTARG";; + g) group="$OPTARG";; + i) stdin=YES;; + j) jobname=$OPTARG;; + m) machine="$OPTARG";; + n) nosub=YES;; + o) output=$OPTARG;; + p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; + q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; + r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; + t) timew=$OPTARG;; + u) userid=$OPTARG;; + v) verbose=YES;; + w) when=$OPTARG;; + \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; + esac +done +shift $(($OPTIND-1)) +if [[ $# -eq 0 ]];then + echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 +fi +exec=$1 +if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then + exec=$(which $exec) +fi +shift +args="$*" +bn=$(basename $exec) +export jobname=${jobname:-$bn} +output=${output:-$jobname.out} +myuser=$LOGNAME +myhost=$(hostname) + +DATA=/glade/scratch/$LOGNAME/tmp +mkdir -p $DATA + +timew=${timew:-01:20:00} +task_node=${task_node:-$procs} +size=$((nodes*task_node)) +envars=$envars +threads=${rcpu:-1} + +export TZ=GMT +cfile=$DATA/sub$$ +> $cfile +echo "#!/bin/sh --login" >> $cfile +echo "" >> $cfile +echo "#PBS -o $output" >> $cfile +echo "#PBS -N $jobname" >> $cfile +echo "#PBS -q $queue" >> $cfile +echo "#PBS -l walltime=$timew" >> $cfile +echo "#PBS -l select=$nodes:ncpus=$procs:mpiprocs=$procs" >> $cfile +echo "#PBS -j oe" >> $cfile +echo "#PBS -A $accnt" >> $cfile +echo "#PBS -V" >> $cfile + +echo "" >>$cfile +echo "export ntasks=$(( $nodes * $procs ))" >> $cfile +echo "export ppn=$procs" >> $cfile +echo "export threads=$threads" >> $cfile +echo "export OMP_NUM_THREADS=$threads" >> $cfile +echo "ulimit -s unlimited" >> $cfile +echo "" >>$cfile +echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile +echo "" >>$cfile + +echo "cfile = $cfile" +echo "source /glade/u/apps/ch/modulefiles/default/localinit/localinit.sh >> $cfile" +echo "module purge" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_cheyenne.intel" >> $cfile +echo "module list" >> $cfile + +cat $exec >> $cfile + +if [[ $nosub = YES ]];then + cat $cfile + exit +elif [[ $verbose = YES ]];then + set -x + cat $cfile +fi + + +if [[ $stdin = YES ]];then + cat +fi >>$cfile +if [[ $nosub = YES ]];then + cat $cfile + exit +elif [[ $verbose = YES ]];then + set -x + cat $cfile +fi +qsub=${qsub:-qsub} + +ofile=$DATA/subout$$ +>$ofile +chmod 777 $ofile +$qsub $cfile >$ofile +rc=$? +cat $ofile +if [[ -w $SUBLOG ]];then + jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) + date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG +fi +rm $cfile $ofile +[[ $MKDATA = YES ]] && rmdir $DATA +echo "ending sub_cheyenne" +exit $rc + diff --git a/ush/sub_discover b/ush/sub_discover index 835cd37ace..583ffbef86 100755 --- a/ush/sub_discover +++ b/ush/sub_discover @@ -129,7 +129,7 @@ echo "export OMP_NUM_THREADS=$threads" >> $cfile echo "" >>$cfile echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile echo "" >>$cfile -echo "module use -a $gsisrc/modulefiles" >> $cfile +echo "module use -a $modulefiles" >> $cfile echo "module load gsi_discover" >> $cfile echo "" >>$cfile echo "jobname=$jobname" >>$cfile diff --git a/ush/sub_gaea b/ush/sub_gaea new file mode 100755 index 0000000000..6fed1b3c10 --- /dev/null +++ b/ush/sub_gaea @@ -0,0 +1,170 @@ +#!/bin/sh --login +set -x +usage="\ +Usage: $0 [options] executable [args] + where the options are: + -a account account (default: none) + -b binding run smt binding or not (default:NO) + -d dirin initial directory (default: cwd) + -e envars copy comma-separated environment variables + -g group group name + -i append standard input to command file + -j jobname specify jobname (default: executable basename) + -m machine machine on which to run (default: current) + -n write command file to stdout rather than submitting it + -o output specify output file (default: jobname.out) + -p procs[/nodes[/ppreq] + number of MPI tasks and optional nodes or Bblocking and + ppreq option (N or S) (defaults: serial, Bunlimited, S) + -q queue[/qpreq] queue name and optional requirement, e.g. dev/P + (defaults: 1 if serial or dev if parallel and none) + (queue 3 or 4 is dev or prod with twice tasks over ip) + (options: P=parallel, B=bigmem, b=batch) + -r rmem[/rcpu] resources memory and cpus/task (default: '1024 mb', 1) + -t timew wall time limit in [[hh:]mm:]ss format (default: 900) + -u userid userid to run under (default: self) + -v verbose mode + -w when when to run, in yyyymmddhh[mm], +hh[mm], thh[mm], or + Thh[mm] (full, incremental, today or tomorrow) format + (default: now) +Function: This command submits a job to the batch queue." +subcmd="$*" +stdin=NO +nosub=NO +account="" +binding="NO" +dirin="" +envars="" +group="" +jobname="" +machine="" +output="" +procs=0 +nodes="" +ppreq="" +queue="" +qpreq="" +rmem="1024" +rcpu="1" +timew="900" +userid="" +verbose=NO +when="" +while getopts a:b:d:e:g:ij:m:no:p:q:r:t:u:vw: opt;do + case $opt in + a) account="$OPTARG";; + b) binding="$OPTARG";; + d) dirin="$OPTARG";; + e) envars="$OPTARG";; + g) group="$OPTARG";; + i) stdin=YES;; + j) jobname=$OPTARG;; + m) machine="$OPTARG";; + n) nosub=YES;; + o) output=$OPTARG;; + p) procs=$(echo $OPTARG/|cut -d/ -f1);nodes=$(echo $OPTARG/|cut -d/ -f2);ppreq=$(echo $OPTARG/|cut -d/ -f3);; + q) queue=$(echo $OPTARG/|cut -d/ -f1);qpreq=$(echo $OPTARG/|cut -d/ -f2);; + r) rmem=$(echo $OPTARG/|cut -d/ -f1);rcpu=$(echo $OPTARG/|cut -d/ -f2);; + t) timew=$OPTARG;; + u) userid=$OPTARG;; + v) verbose=YES;; + w) when=$OPTARG;; + \?) echo $0: invalid option >&2;echo "$usage" >&2;exit 1;; + esac +done +shift $(($OPTIND-1)) +if [[ $# -eq 0 ]];then + echo $0: missing executable name >&2;echo "$usage" >&2;exit 1 +fi +exec=$1 +if [[ ! -s $exec ]]&&which $exec >/dev/null 2>&1;then + exec=$(which $exec) +fi +shift +args="$*" +bn=$(basename $exec) +export jobname=${jobname:-$bn} +output=${output:-$jobname.out} +myuser=$LOGNAME +myhost=$(hostname) + +if [ -d /lustre/f2/scratch/$LOGNAME ]; then + DATA=/lustre/f2/scratch/$LOGNAME/tmp +fi +DATA=${DATA:-$ptmp/tmp} + +mkdir -p $DATA + +queue=${queue:-batch} +timew=${timew:-01:20:00} +task_node=${task_node:-$procs} +size=$((nodes*task_node)) +envars=$envars +threads=${rcpu:-1} + +export TZ=GMT +cfile=$DATA/sub$$ +> $cfile +echo "#!/bin/bash -l" >> $cfile +echo "" >> $cfile +echo "#SBATCH --output=$output" >> $cfile +echo "#SBATCH --job-name=$jobname" >> $cfile +echo "#SBATCH --qos=$queue" >> $cfile +echo "#SBATCH --clusters=c4" >> $cfile +echo "#SBATCH --time=$timew" >> $cfile +echo "#SBATCH --nodes=$nodes --ntasks-per-node=$procs --cpus-per-task=$threads" >> $cfile +echo "#SBATCH --account=$accnt" >> $cfile +echo "#SBATCH --mem=0" >> $cfile + +echo "" >>$cfile +echo "export ntasks=$(( $nodes * $procs ))" >> $cfile +echo "export ppn=$procs" >> $cfile +echo "export threads=$threads" >> $cfile +echo "export OMP_NUM_THREADS=$threads" >> $cfile +echo "ulimit -s unlimited" >> $cfile + +echo "" >>$cfile +echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile +echo "" >>$cfile + +echo "source /lustre/f2/dev/role.epic/contrib/Lmod_init.sh" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_gaea" >> $cfile +echo "module list" >> $cfile +echo "" >>$cfile + +cat $exec >> $cfile + +if [[ $nosub = YES ]];then + cat $cfile + exit +elif [[ $verbose = YES ]];then + set -x + cat $cfile +fi + +if [[ $stdin = YES ]];then + cat +fi >>$cfile +if [[ $nosub = YES ]];then + cat $cfile + exit +elif [[ $verbose = YES ]];then + set -x + cat $cfile +fi +sbatch=${sbatch:-sbatch} + +ofile=$DATA/subout$$ +>$ofile +chmod 777 $ofile +$sbatch --export=ALL $cfile >$ofile +rc=$? +cat $ofile +if [[ -w $SUBLOG ]];then + jobn=$(grep -i submitted $ofile|head -n1|cut -d\" -f2) + date -u +"%Y%m%d%H%M%S : $subcmd : $jobn" >>$SUBLOG +fi +rm $cfile $ofile +[[ $MKDATA = YES ]] && rmdir $DATA +exit $rc diff --git a/ush/sub_hera b/ush/sub_hera index d904417190..610756af00 100755 --- a/ush/sub_hera +++ b/ush/sub_hera @@ -137,7 +137,7 @@ echo "" >>$cfile echo ". /apps/lmod/lmod/init/sh" >> $cfile echo "module purge" >> $cfile -echo "module use $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_hera.intel" >> $cfile echo "module list" >> $cfile echo "" >>$cfile diff --git a/ush/sub_jet b/ush/sub_jet index e11be1280c..d30c566ce3 100755 --- a/ush/sub_jet +++ b/ush/sub_jet @@ -98,16 +98,10 @@ task_node=${task_node:-$procs} size=$((nodes*task_node)) envars=$envars threads=${rcpu:-1} -#envars=$envars,mpi_tasks=$procs -#Options -###PBS -l partition=c1ms,size=0528,walltime=01:20:00 -##PBS -l partition=$queue,size=$size,walltime=$timew -##PBS -S /bin/sh export TZ=GMT cfile=$DATA/sub$$ > $cfile -#echo "#PBS -S /bin/sh" >> $cfile echo "#!/bin/sh --login" >> $cfile echo "" >> $cfile echo "#SBATCH --output=$output" >> $cfile @@ -115,24 +109,24 @@ echo "#SBATCH --job-name=$jobname" echo "#SBATCH --qos=$queue" >> $cfile echo "#SBATCH --time=$timew" >> $cfile echo "#SBATCH --nodes=$nodes --ntasks-per-node=$procs --cpus-per-task=$threads" >> $cfile -#echo "#SBATCH -j oe" >> $cfile echo "#SBATCH --account=$accnt" >> $cfile echo "#SBATCH --mem=0" >> $cfile echo "#SBATCH --partition=kjet" >> $cfile -#echo "#SBATCH -V" >> $cfile -#echo "#PBS -d" >> $cfile -#. $exec >> $cfile -#echo "/bin/sh -x $exec" >> $cfile echo "" >>$cfile +echo "export ntasks=$(( $nodes * $procs ))" >> $cfile +echo "export ppn=$procs" >> $cfile +echo "export threads=$threads" >> $cfile echo "export OMP_NUM_THREADS=$threads" >> $cfile +echo "ulimit -s unlimited" >> $cfile + echo "" >>$cfile echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile echo "" >>$cfile echo ". /apps/lmod/lmod/init/sh" >> $cfile echo "module purge" >> $cfile -echo "module use $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_jet" >> $cfile echo "module list" >> $cfile echo "" >>$cfile @@ -146,40 +140,6 @@ elif [[ $verbose = YES ]];then set -x cat $cfile fi -#msub -I partition=$partition,size=$procs,walltime=$walltime $cfile - -#if [[ -n $when ]];then -# whena=$when -# if [[ $when = +* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H%M") -# ((mn+=$(echo $now|cut -c11-12))) -# [[ $mn -ge 60 ]] && ((hr+=1)) && ((mn-=60)) -# [[ $mn -lt 10 ]] && mn=0$mn -# whena=$(/nwprod/util/exec/ndate +$hr $(echo $now|cut -c1-10))$mn -# elif [[ $when = t* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d") -# whena=$now$hr$mn -# elif [[ $when = T* ]];then -# hr=$(echo $when|cut -c2-3) -# mn=$(echo $when|cut -c4-5) -# [[ -n $mn ]] || mn=00 -# now=$(date -u +"%Y%m%d%H") -# whena=$(/nwprod/util/exec/ndate +24 $now|cut -c1-8)$hr$mn -# fi -# yr=$(echo $whena|cut -c1-4) -# mo=$(echo $whena|cut -c5-6) -# dy=$(echo $whena|cut -c7-8) -# hr=$(echo $whena|cut -c9-10) -# mn=$(echo $whena|cut -c11-12) -# [[ -n $mn ]] || mn=00 -# echo "#@ startdate = $mo/$dy/$yr $hr:$mn" -#fi >>$cfile if [[ $stdin = YES ]];then diff --git a/ush/sub_orion b/ush/sub_orion index 065e7c8ab0..1bcce5cc4f 100755 --- a/ush/sub_orion +++ b/ush/sub_orion @@ -126,7 +126,7 @@ echo "" >>$cfile echo ". /apps/lmod/lmod/init/sh" >> $cfile echo "module purge" >> $cfile -echo "module use $gsisrc/modulefiles" >> $cfile +echo "module use $modulefiles" >> $cfile echo "module load gsi_orion" >> $cfile echo "module list" >> $cfile echo "" >> $cfile diff --git a/ush/sub_wcoss2 b/ush/sub_wcoss2 index 57115ef7c6..f2df099f23 100755 --- a/ush/sub_wcoss2 +++ b/ush/sub_wcoss2 @@ -123,19 +123,14 @@ echo "" >> $cfile echo ". "$(awk '{ print $1, $2, $3, $4, $5, $6, $7, $8, $9 }' $regdir/regression_var.out) >>$cfile echo "" >> $cfile -echo "module purge" >> $cfile -echo "module load envvar/1.0" >> $cfile -echo "module load PrgEnv-intel/8.2.0" >> $cfile -echo "module load intel/19.1.3.304" >> $cfile -echo "module load craype/2.7.13" >> $cfile -echo "module load cray-mpich/8.1.12" >> $cfile -echo "module load cray-pals/1.1.3" >> $cfile -echo "module load prod_util/2.0.14" >> $cfile -echo "module load prod_envir/2.0.6" >> $cfile -echo "module load crtm/2.4.0" >> $cfile -echo "module load cfp/2.0.4" >> $cfile -echo "module load netcdf/4.7.4" >> $cfile -echo "module list" >> $cfile +echo "module reset" >> $cfile +echo "module use $modulefiles" >> $cfile +echo "module load gsi_wcoss2" >> $cfile +echo "module load envvar/1.0" >> $cfile +echo "module load cray-pals/1.2.2" >> $cfile +echo "module -t list 2>&1 | while read line;do module show $line 2>&1 | sed -n -e '2p';done | sort" >> $cfile +echo "module avail" >> $cfile + echo "" >> $cfile cat $exec >> $cfile From 008c63cc04d6d80c25b0c3220b2d2c3f98618d52 Mon Sep 17 00:00:00 2001 From: RussTreadon-NOAA <26926959+RussTreadon-NOAA@users.noreply.github.com> Date: Thu, 14 Sep 2023 11:30:58 -0400 Subject: [PATCH 6/6] update fix submodule hash to include gfs.v16.3.9 updates (#621) **Description** This PR updates the `fix` submodule to bring in GFS v16.3.9 updates to `global_convinfo.txt` and `global_ozinfo.txt`. Issue #620 provides additional information on the GFS v16.3.9 updates. Please **note** the following - The change to `global_ozinfo.txt` alters analysis results if ompsnp observation from NOAA-20, NOAA-21, or NPP are processed by gsi.x or `enkf.x`. - The change to `global_convinfo.txt` alters analysis results if PlanetIQ GPSRO (type 267) is processed by `gsi.x` or `enkf.x`. Fixes #620 **Type of change** - [x] Breaking change (fix or feature that would cause existing functionality to not work as expected) See the **Note** above for potential impact on analysis results. **How Has This Been Tested?** ctests have been run on Hera, Orion, and WCOSS2 (Cactus) with results posted in issue #620. **Checklist** - [x] My code follows the style guidelines of this project - [x] I have performed a self-review of my own code --- fix | 2 +- modulefiles/gsi_cheyenne.intel.lua | 2 +- modulefiles/gsi_gaea.lua | 2 +- modulefiles/gsi_hera.gnu.lua | 2 +- modulefiles/gsi_hera.intel.lua | 2 +- modulefiles/gsi_jet.lua | 2 +- modulefiles/gsi_orion.lua | 2 +- modulefiles/gsi_s4.lua | 2 +- modulefiles/gsi_wcoss2.lua | 2 +- 9 files changed, 9 insertions(+), 9 deletions(-) diff --git a/fix b/fix index 6a42a29dbb..5722cd4d25 160000 --- a/fix +++ b/fix @@ -1 +1 @@ -Subproject commit 6a42a29dbbc9fca3453cc9e829601185555890b9 +Subproject commit 5722cd4d2519222137c5b356bdbc01bb34c5f1f4 diff --git a/modulefiles/gsi_cheyenne.intel.lua b/modulefiles/gsi_cheyenne.intel.lua index 4a3525bca1..26ed666695 100644 --- a/modulefiles/gsi_cheyenne.intel.lua +++ b/modulefiles/gsi_cheyenne.intel.lua @@ -18,7 +18,7 @@ load("mkl/2022.1") load("gsi_common") load(pathJoin("prod_util", os.getenv("prod_util_ver") or "1.2.2")) -pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_data/fix/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/glade/work/epicufsrt/contrib/GSI_data/fix/20230911") pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") diff --git a/modulefiles/gsi_gaea.lua b/modulefiles/gsi_gaea.lua index f76c8f3ad9..a7a2454eff 100644 --- a/modulefiles/gsi_gaea.lua +++ b/modulefiles/gsi_gaea.lua @@ -23,7 +23,7 @@ local MKLROOT="/opt/intel/oneapi/mkl/2022.0.2/" prepend_path("LD_LIBRARY_PATH",pathJoin(MKLROOT,"lib/intel64")) pushenv("MKLROOT", MKLROOT) -pushenv("GSI_BINARY_SOURCE_DIR", "/lustre/f2/dev/role.epic/contrib/GSI_data/fix/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/lustre/f2/dev/role.epic/contrib/GSI_data/fix/20230911") setenv("CC","cc") setenv("FC","ftn") diff --git a/modulefiles/gsi_hera.gnu.lua b/modulefiles/gsi_hera.gnu.lua index c309e67fe0..37504485e3 100644 --- a/modulefiles/gsi_hera.gnu.lua +++ b/modulefiles/gsi_hera.gnu.lua @@ -22,6 +22,6 @@ load("gsi_common") load(pathJoin("prod_util", prod_util_ver)) load(pathJoin("openblas", openblas_ver)) -pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Hera with GNU Compilers") diff --git a/modulefiles/gsi_hera.intel.lua b/modulefiles/gsi_hera.intel.lua index 866af02d50..619d0e76c9 100644 --- a/modulefiles/gsi_hera.intel.lua +++ b/modulefiles/gsi_hera.intel.lua @@ -25,6 +25,6 @@ load(pathJoin("prod_util", prod_util_ver)) pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") -pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/scratch1/NCEPDEV/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Hera with Intel Compilers") diff --git a/modulefiles/gsi_jet.lua b/modulefiles/gsi_jet.lua index e2ea2ef1d0..c9e5e90680 100644 --- a/modulefiles/gsi_jet.lua +++ b/modulefiles/gsi_jet.lua @@ -26,6 +26,6 @@ pushenv("CFLAGS", "-axSSE4.2,AVX,CORE-AVX2") pushenv("FFLAGS", "-axSSE4.2,AVX,CORE-AVX2") -pushenv("GSI_BINARY_SOURCE_DIR", "/mnt/lfs4/HFIP/hfv3gfs/glopara/git/fv3gfs/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/mnt/lfs4/HFIP/hfv3gfs/glopara/git/fv3gfs/fix/gsi/20230911") whatis("Description: GSI environment on Jet with Intel Compilers") diff --git a/modulefiles/gsi_orion.lua b/modulefiles/gsi_orion.lua index a7ea874fb2..e75a01ef5e 100644 --- a/modulefiles/gsi_orion.lua +++ b/modulefiles/gsi_orion.lua @@ -25,6 +25,6 @@ load(pathJoin("prod_util", prod_util_ver)) pushenv("CFLAGS", "-xHOST") pushenv("FFLAGS", "-xHOST") -pushenv("GSI_BINARY_SOURCE_DIR", "/work/noaa/global/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/work/noaa/global/glopara/fix/gsi/20230911") whatis("Description: GSI environment on Orion with Intel Compilers") diff --git a/modulefiles/gsi_s4.lua b/modulefiles/gsi_s4.lua index efdc6c4bfb..03c21e708d 100644 --- a/modulefiles/gsi_s4.lua +++ b/modulefiles/gsi_s4.lua @@ -23,6 +23,6 @@ load(pathJoin("prod_util", prod_util_ver)) pushenv("CFLAGS", "-march=ivybridge") pushenv("FFLAGS", "-march=ivybridge") -pushenv("GSI_BINARY_SOURCE_DIR", "/data/prod/glopara/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/data/prod/glopara/fix/gsi/20230911") whatis("Description: GSI environment on S4 with Intel Compilers") diff --git a/modulefiles/gsi_wcoss2.lua b/modulefiles/gsi_wcoss2.lua index 1872f89d17..e5f4c7b812 100644 --- a/modulefiles/gsi_wcoss2.lua +++ b/modulefiles/gsi_wcoss2.lua @@ -20,6 +20,6 @@ load(pathJoin("prod_util", prod_util_ver)) load("gsi_common") -pushenv("GSI_BINARY_SOURCE_DIR", "/lfs/h2/emc/global/noscrub/emc.global/FIX/fix/gsi/20230601") +pushenv("GSI_BINARY_SOURCE_DIR", "/lfs/h2/emc/global/noscrub/emc.global/FIX/fix/gsi/20230911") whatis("Description: GSI environment on WCOSS2")