Gnssrwnd1.0

src/gsi/convinfo.f90

@@ -155,6 +155,8 @@ subroutine convinfo_read
 !   2009-01-22  todling - protect against non-initialized destroy call
 !   2010-05-29  todling - interface consistent w/ similar routines
 !   2014-07-10  carley  - add check to bypass blank lines in convinfo file
+!   2023-05-09  s.vetra-carvalho - extended iotype to be 8 characters long to
+!   allow for more descriptive observations names
 !
 !   input argument list:
 !     mype - mpi task id
@@ -171,7 +173,7 @@ subroutine convinfo_read
     implicit none
 
     character(len=1)cflg
-    character(len=7) iotype
+    character(len=8) iotype
     character(len=140) crecord
     integer(i_kind) lunin,i,nc,ier,istat
     integer(i_kind) nlines
@@ -188,13 +190,13 @@ subroutine convinfo_read
     nlines=0
     read1: do
        cflg=' '
-       iotype='       '
+       iotype='        '
        read(lunin,1030,iostat=istat,end=1130)cflg,iotype,crecord
-1030   format(a1,a7,2x,a140)
+1030   format(a1,a8,1x,a140)
        if (istat /= 0) exit
        nlines=nlines+1
        if(cflg == '!')cycle
-       if (cflg==' '.and.iotype=='       ') then
+       if (cflg==' '.and.iotype=='        ') then
          if(print_verbose)write(6,*) 'Encountered a blank line in convinfo file at line number: ',nlines,' skipping!'
          cycle
        end if
@@ -242,9 +244,9 @@ subroutine convinfo_read
 
     do i=1,nlines
        cflg=' '
-       iotype='       '
+       iotype='        '
        read(lunin,1030)cflg,iotype,crecord
-       if (cflg==' '.and.iotype=='       ') then
+       if (cflg==' '.and.iotype=='        ') then
          if(print_verbose)write(6,*) 'Encountered a blank line in convinfo file at line number: ',i,' skipping!'
          cycle
        end if
@@ -282,7 +284,7 @@ subroutine convinfo_read
        if(print_verbose .and. mype == 0)write(6,1031)ioctype(nc),ictype(nc),icsubtype(nc),icuse(nc),ctwind(nc),ncnumgrp(nc), &
           ncgroup(nc),ncmiter(nc),cgross(nc),cermax(nc),cermin(nc),cvar_b(nc),cvar_pg(nc), &
           ithin_conv(nc),rmesh_conv(nc),pmesh_conv(nc),idum,pmot_conv(nc),ptime_conv(nc),index_sub(nc),ibeta(nc),ikapa(nc)
-1031   format('READ_CONVINFO: ',a7,1x,i3,1x,i4,1x,i2,1x,g13.6,1x,3(I3,1x),5g13.6,i5,2g13.6,i5,2g13.6,3i5)
+1031   format('READ_CONVINFO: ',a8,1x,i3,1x,i4,1x,i2,1x,g13.6,1x,3(I3,1x),5g13.6,i5,2g13.6,i5,2g13.6,3i5)
     enddo
 
     close(lunin)

src/gsi/gsi_files.cmake

@@ -218,6 +218,7 @@ gsi_dbzOper.F90
 gsi_dwOper.F90
 gsi_enscouplermod.f90
 gsi_fedOper.F90
+gsi_gnssrspdOper.F90
 gsi_gpsbendOper.F90
 gsi_gpsrefOper.F90
 gsi_gustOper.F90
@@ -276,6 +277,7 @@ intco.f90
 intdbz.f90
 intfed.f90
 intdw.f90
+intgnssrspd.f90
 intgps.f90
 intgust.f90
 inthowv.f90
@@ -342,6 +344,7 @@ m_dwNode.F90
 m_extOzone.F90
 m_fedNode.F90
 m_find.f90
+m_gnssrspdNode.F90
 m_gpsNode.F90
 m_gpsrhs.F90
 m_gsiBiases.f90
@@ -486,6 +489,7 @@ read_files.f90
 read_fl_hdob.f90
 read_gfs_ozone_for_regional.f90
 read_gmi.f90
+read_gnssrspd.f90
 read_goesglm.f90
 read_goesimg.f90
 read_goesimgr_skycover.f90
@@ -537,6 +541,7 @@ setupdbz.f90
 setupdbz_lib.f90
 setupdw.f90
 setupfed.f90
+setupgnssrspd.f90
 setupgust.f90
 setuphowv.f90
 setuplag.f90
@@ -597,6 +602,7 @@ stpco.f90
 stpdbz.f90
 stpfed.f90
 stpdw.f90
+stpgnssrspd.f90
 stpgps.f90
 stpgust.f90
 stphowv.f90

src/gsi/gsi_gnssrspdOper.F90

@@ -0,0 +1,161 @@
+module gsi_gnssrspdOper
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:	 module gsi_gnssrspdOper
+!                (based on gsi_*Oper.F90 routines by j guo <[email protected]>)
+!   prgmmr:	 K. Apodaca <[email protected]>
+!      org:      Spire Global, Inc. 
+!     date:      2023-04-28
+!
+! abstract: an obOper extension for gnssrspdNode type
+!
+! program history log:
+!   2023-04-21  k apodaca - initial version
+!   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_gnssrspdNode , only: gnssrspdNode
+  implicit none
+  public:: gnssrspdOper      ! data stracture
+
+  type,extends(obOper):: gnssrspdOper
+  contains
+    procedure,nopass:: mytype
+    procedure,nopass:: nodeMold
+    procedure:: setup_
+    procedure:: intjo1_
+    procedure:: stpjo1_
+  end type gnssrspdOper
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  character(len=*),parameter :: myname='gsi_gnssrspdOper'
+  type(gnssrspdNode),save,target:: myNodeMold_
+
+contains
+  function mytype(nodetype)
+    implicit none
+    character(len=:),allocatable:: mytype
+    logical,optional, intent(in):: nodetype
+    mytype="[gnssrspdOper]"
+    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 gnssrspd_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_gnssrspd
+
+    use obsmod  , only: write_diag
+    use convinfo, only: diag_conv
+    use jfunc   , only: jiter
+
+    use mpeu_util, only: die
+    implicit none
+    class(gnssrspdOper ), 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
+
+    if(nobs == 0) return
+
+    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_conv
+
+    call setup(self%obsLL(:), self%odiagLL(:), &
+        lunin,mype,bwork,awork(:,iwork),nele,nobs,is,diagsave)
+
+  end subroutine setup_
+
+  subroutine intjo1_(self, ibin, rval,sval, qpred,sbias)
+    use intgnssrspdmod, only: intjo => intgnssrspd
+    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(gnssrspdOper  ),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
+
+    headNode => obsLList_headNode(self%obsLL(ibin))
+    call intjo(headNode, rval,sval)
+    headNode => null()
+
+  end subroutine intjo1_
+
+  subroutine stpjo1_(self, ibin, dval,xval,pbcjo,sges,nstep,dbias,xbias)
+    use stpgnssrspdmod, only: stpjo => stpgnssrspd
+    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(gnssrspdOper  ),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
+
+    headNode => obsLList_headNode(self%obsLL(ibin))
+    call stpjo(headNode,dval,xval,pbcjo(:),sges,nstep)
+    headNode => null()
+  end subroutine stpjo1_
+
+end module gsi_gnssrspdOper

src/gsi/gsi_obOperTypeManager.F90

@@ -12,7 +12,8 @@ module gsi_obOperTypeManager
 !   2018-07-12  j guo   - a type-manager for all obOper extensions.
 !                       - an enum mapping of obsinput::dtype(:) to obOper type
 !                         extensions.
-!
+!   2022-03-15  k apodaca - add GNSS-R L2 ocean wind speed type-manager
+!   2023-03-20  k apodaca - add GNSS-R DDM type-manager !
 !   input argument list: see Fortran 90 style document below
 !
 !   output argument list: see Fortran 90 style document below
@@ -52,6 +53,7 @@ module gsi_obOperTypeManager
   use gsi_radOper     , only: radOper
   use gsi_rwOper      , only: rwOper
   use gsi_spdOper     , only: spdOper
+  use gsi_gnssrspdOper  , only: gnssrspdOper
   use gsi_sstOper     , only: sstOper
   use gsi_swcpOper    , only: swcpOper
   use gsi_tcamtOper   , only: tcamtOper
@@ -102,6 +104,7 @@ module gsi_obOperTypeManager
   public:: iobOper_w
   public:: iobOper_q
   public:: iobOper_spd
+  public:: iobOper_gnssrspd
   public:: iobOper_rw
   public:: iobOper_dw
   public:: iobOper_sst
@@ -148,6 +151,7 @@ module gsi_obOperTypeManager
     enumerator:: iobOper_w
     enumerator:: iobOper_q
     enumerator:: iobOper_spd
+    enumerator:: iobOper_gnssrspd
     enumerator:: iobOper_rw
     enumerator:: iobOper_dw
     enumerator:: iobOper_sst
@@ -210,6 +214,7 @@ module gsi_obOperTypeManager
   type(      wOper), target, save::        wOper_mold
   type(      qOper), target, save::        qOper_mold
   type(    spdOper), target, save::      spdOper_mold
+  type( gnssrspdOper), target, save::   gnssrspdOper_mold
   type(     rwOper), target, save::       rwOper_mold
   type(     dwOper), target, save::       dwOper_mold
   type(    sstOper), target, save::      sstOper_mold
@@ -264,6 +269,7 @@ function dtype2index_(dtype) result(index_)
 
   case("q"      ,"[qoper]"      ); index_= iobOper_q
   case("spd"    ,"[spdoper]"    ); index_= iobOper_spd
+  case("gnssrspd" ,"[gnssrspdoper]" ); index_= iobOper_gnssrspd
   case("rw"     ,"[rwoper]"     ); index_= iobOper_rw
   case("dw"     ,"[dwoper]"     ); index_= iobOper_dw
   case("sst"    ,"[sstoper]"    ); index_= iobOper_sst
@@ -293,7 +299,7 @@ function dtype2index_(dtype) result(index_)
     case("ompslp"   ); index_= iobOper_o3l
     case("ompslpuv" ); index_= iobOper_o3l
     case("ompslpvis"); index_= iobOper_o3l
-    case("ompslpnc" ); index_= iobOper_o3l
+    case("ompslpnc" ); index_= iobOper_o3l     
 
   case("gpsbend","[gpsbendoper]"); index_= iobOper_gpsbend
     case("gps_bnd"); index_= iobOper_gpsbend
@@ -457,6 +463,7 @@ function index2vmold_(iobOper) result(vmold_)
   case(iobOper_w        ); vmold_ =>       wOper_mold
   case(iobOper_q        ); vmold_ =>       qOper_mold
   case(iobOper_spd      ); vmold_ =>     spdOper_mold
+  case(iobOper_gnssrspd   ); vmold_ =>  gnssrspdOper_mold
   case(iobOper_rw       ); vmold_ =>      rwOper_mold
   case(iobOper_dw       ); vmold_ =>      dwOper_mold
   case(iobOper_sst      ); vmold_ =>     sstOper_mold
@@ -573,6 +580,7 @@ subroutine cobstype_config_()
     cobstype(iobOper_w          )  ="wind                " ! w_ob_type
     cobstype(iobOper_q          )  ="moisture            " ! q_ob_type
     cobstype(iobOper_spd        )  ="wind speed          " ! spd_ob_type
+    cobstype(iobOper_gnssrspd   )  ="gnss-r wind speed   " ! gnssrspd_ob_type
     cobstype(iobOper_rw         )  ="radial wind         " ! rw_ob_type
     cobstype(iobOper_dw         )  ="doppler wind        " ! dw_ob_type
     cobstype(iobOper_sst        )  ="sst                 " ! sst_ob_type

src/gsi/gsimain.f90

@@ -131,6 +131,8 @@ program gsi
 !                         related to the GOES/GLM lightnig assimilation
 !   2019-07-09  todling - add initialization of abstract layer defining use of GFS ensemble
 !   2019-08-04  guo     - moved ensemble object configuration into module gsi_fixture.
+!   2022-03-15  K Apodaca - add CYGNSS and Spire Ocean wind speed observations
+!   2023-03-15  K Apodaca - add GNSS-R Doppler Delay Map observations
 !
 ! usage:
 !   input files:
@@ -194,7 +196,7 @@ program gsi
 !         read_goesglm, read_goesndr, read_gps_ref, read_guess, read_ieeetovs, 
 !         read_lidar, read_obs, read_ozone, read_pcp, read_prepbufr, read_radar, 
 !         read_superwinds, read_wrf_mass_files, read_wrf_mass_guess, 
-!         read_wrf_nmm_files, read_wrf_nmm_guess, rfdpar, rsearch, satthin,
+!         read_wrf_nmm_files, read_wrf_nmm_guess, read_gnssrspd, rfdpar, rsearch, satthin,
 !         setupdw, setupoz, setuppcp, setupps, setuppw, setupq, setuprad,
 !         setupref, setupbend, setuplight, setuprhsall, setuprw, setupspd, setupsst,
 !         setupt, setupw, simpin1, simpin1_init, smooth121, smoothrf,