Skip to content

Commit

Permalink
Merge branch 'format_changes' of https://github.com/wx20jjung/GSI int…
Browse files Browse the repository at this point in the history
…o format_changes
  • Loading branch information
wx20jjung committed Jul 10, 2024
2 parents 212e012 + 1bcda33 commit 0db28da
Show file tree
Hide file tree
Showing 18 changed files with 2,364 additions and 28 deletions.
16 changes: 9 additions & 7 deletions src/gsi/convinfo.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/correlated_obsmod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -422,7 +422,7 @@ subroutine set_(instrument,fname,mask,method,kreq,kmut,ErrorCov)
ErrorCov%nch_active = coun
if (.not.GMAO_ObsErrorCov) ErrorCov%nctot = nctot
call create_(coun,ErrorCov)
allocate(indxRf(nch_active),indxR(nch_active),Rcov(nctot,nctot))
allocate(indxRf(coun),indxR(nch_active),Rcov(nctot,nctot))

! Read GSI-like channel numbers used in estimating R for this instrument
read(lu,IOSTAT=ioflag) indxR
Expand Down
6 changes: 6 additions & 0 deletions src/gsi/gsi_files.cmake
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -276,6 +277,7 @@ intco.f90
intdbz.f90
intfed.f90
intdw.f90
intgnssrspd.f90
intgps.f90
intgust.f90
inthowv.f90
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -537,6 +541,7 @@ setupdbz.f90
setupdbz_lib.f90
setupdw.f90
setupfed.f90
setupgnssrspd.f90
setupgust.f90
setuphowv.f90
setuplag.f90
Expand Down Expand Up @@ -597,6 +602,7 @@ stpco.f90
stpdbz.f90
stpfed.f90
stpdw.f90
stpgnssrspd.f90
stpgps.f90
stpgust.f90
stphowv.f90
Expand Down
161 changes: 161 additions & 0 deletions src/gsi/gsi_gnssrspdOper.F90
Original file line number Diff line number Diff line change
@@ -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
12 changes: 10 additions & 2 deletions src/gsi/gsi_obOperTypeManager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 3 additions & 1 deletion src/gsi/gsimain.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down Expand Up @@ -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,
Expand Down
Loading

0 comments on commit 0db28da

Please sign in to comment.