module m_obsHeadBundle
!$$$ subprogram documentation block
! . . . .
! subprogram: module m_obsHeadBundle
! prgmmr: j guo <jguo@nasa.gov>
! org: NASA/GSFC, Global Modeling and Assimilation Office, 610.3
! date: 2015-08-27
!
! abstract: obsHeadBundle replaces type::obs_handle and variable obsmod::yobs.
!
! program history log:
! 2015-08-27 j guo - added this document block
! 2015-09-03 j guo - moved "yobs", and its construction and destruction
! here, to use them when and where yobs is needed.
! . In particular, setupyobs.f90 is included here as a
! module procedure create_(). And a destroy_() has been
! added, to clean up after any use of create_().
! 2015-09-03 j guo - changed create_() from a function to a subroutine.
! . removed internal dependency to nobs_bins.
! 2016-05-04 j guo - added 9 new obs-types, to a total of 33 obs-types
! 2016-07-26 j guo - merged in the earlier proram history log (setupyobs).
!
! 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
! Earlier program history log:
!
! subprogram: setupyobs
! prgmmr: tremolet
!
! abstract: Setup observation vectors (ie the "y" the in "H(x)-y" )
! In 3D-Var, it contains all observations, in 4D-Var, each
! y contains all the observations in a given time slot.
!
! program history log:
! 2007-04-17 tremolet - initial code
! 2009-01-08 todling - remove reference to ozohead
! 2009-03-05 meunier - add pointer to lagrangean data
! 2009-08-11 lueken - updated documentation
! 2010-04-22 tangborn - updated reference to co
! 2010-07-10 todling - add aerosols pointer
! 2010-10-15 pagowski - add pm2_5 pointer
! 2011-02-19 zhu - add gust,vis,pblh pointers
! 2014-03-19 pondeca - add wspd10m
! 2014-04-10 pondeca - add td2m,mxtm,mitm,pmsl
! 2014-05-07 pondeca - add howv
! 2014-06-20 carley/zhu - add tcamt and lcbas pointers
! 2015-07-10 pondeca - add cldch
! 2016-03-17 pondeca - add uwnd10m and vwnd10m (see setupuwnd10m)
! 2018-01-23 Apodaca - add lightning (light) pointers
! module interface:
use m_obsNode , only: obsNode
use m_psNode , only: psNode ! 1
use m_tNode , only: tNode ! 2
use m_wNode , only: wNode ! 3
use m_qNode , only: qNode ! 4
use m_spdNode , only: spdNode ! 5
use m_rwNode , only: rwNode ! 6
use m_dwNode , only: dwNode ! 7
use m_sstNode , only: sstNode ! 8
use m_pwNode , only: pwNode ! 9
use m_pcpNode , only: pcpNode ! 10
use m_ozNode , only: ozNode ! 11
use m_o3lNode , only: o3lNode ! 12
use m_gpsNode , only: gpsNode ! 13
use m_radNode , only: radNode ! 14
use m_tcpNode , only: tcpNode ! 15
use m_lagNode , only: lagNode ! 16
use m_colvkNode, only: colvkNode ! 17
use m_aeroNode , only: aeroNode ! 18
use m_aerolNode, only: aerolNode ! 19
use m_pm2_5Node, only: pm2_5Node ! 20
use m_gustNode , only: gustNode ! 21
use m_visNode , only: visNode ! 22
use m_pblhNode , only: pblhNode ! 23
use m_wspd10mNode, only: wspd10mNode ! 24
use m_td2mNode , only: td2mNode ! 25
use m_mxtmNode , only: mxtmNode ! 26
use m_mitmNode , only: mitmNode ! 27
use m_pmslNode , only: pmslNode ! 28
use m_howvNode , only: howvNode ! 29
use m_tcamtNode, only: tcamtNode ! 30
use m_lcbasNode, only: lcbasNode ! 31
use m_pm10Node , only: pm10Node ! 32
use m_cldchNode, only: cldchNode ! 33
use m_uwnd10mNode, only: uwnd10mNode ! 35
use m_vwnd10mNode, only: vwnd10mNode ! 36
use m_swcpNode , only: swcpNode ! 37
use m_lwcpNode , only: lwcpNode ! 38
use m_lightNode, only: lightNode ! 39
use m_dbzNode, only: dbzNode ! 40
use m_obsLList , only: obsLList_headNode
implicit none
private ! except
public :: obsHeadBundle ! data structure
! Create()/Destroy() pair, for rank-1 pointers with alloc()/dealloc().
public :: obsHeadBundle_create
public :: obsHeadBundle_destroy
interface obsHeadBundle_create ; module procedure create_; end interface
interface obsHeadBundle_destroy; module procedure destroy_; end interface
! init()/clean() pair, for allocated scalar objects.
public :: obsHeadBundle_init
public :: obsHeadBundle_clean
interface obsHeadBundle_init ; module procedure init_; end interface
interface obsHeadBundle_clean; module procedure clean_; end interface
type obsHeadBundle
! obsHeadBundle is a replacement of obs_handle. It is implemented as a
! snap-shot projection of the actual objects managed by m_obsdiags, and
! to be used on demands, closed to where and when a such bundle is
! needed.
!private
class(obsNode),pointer:: ps => null() ! 1
class(obsNode),pointer:: t => null() ! 2
class(obsNode),pointer:: w => null() ! 3
class(obsNode),pointer:: q => null() ! 4
class(obsNode),pointer:: spd => null() ! 5
class(obsNode),pointer:: rw => null() ! 6
class(obsNode),pointer:: dw => null() ! 7
class(obsNode),pointer:: sst => null() ! 8
class(obsNode),pointer:: pw => null() ! 9
class(obsNode),pointer:: pcp => null() ! 10
class(obsNode),pointer:: oz => null() ! 11
class(obsNode),pointer:: o3l => null() ! 12
class(obsNode),pointer:: gps => null() ! 13
class(obsNode),pointer:: rad => null() ! 14
class(obsNode),pointer:: tcp => null() ! 15
class(obsNode),pointer:: lag => null() ! 16
class(obsNode),pointer:: colvk => null() ! 17
class(obsNode),pointer:: aero => null() ! 18
class(obsNode),pointer:: aerol => null() ! 19
class(obsNode),pointer:: pm2_5 => null() ! 20
class(obsNode),pointer:: gust => null() ! 21
class(obsNode),pointer:: vis => null() ! 22
class(obsNode),pointer:: pblh => null() ! 23
class(obsNode),pointer:: wspd10m => null() ! 24
class(obsNode),pointer:: td2m => null() ! 25
class(obsNode),pointer:: mxtm => null() ! 26
class(obsNode),pointer:: mitm => null() ! 27
class(obsNode),pointer:: pmsl => null() ! 28
class(obsNode),pointer:: howv => null() ! 29
class(obsNode),pointer:: tcamt => null() ! 30
class(obsNode),pointer:: lcbas => null() ! 31
class(obsNode),pointer:: pm10 => null() ! 32
class(obsNode),pointer:: cldch => null() ! 33
class(obsNode),pointer:: uwnd10m => null() ! 35
class(obsNode),pointer:: vwnd10m => null() ! 36
class(obsNode),pointer:: swcp => null() ! 37
class(obsNode),pointer:: lwcp => null() ! 38
class(obsNode),pointer:: light => null() ! 39
class(obsNode),pointer:: dbz => null() ! 40
end type obsHeadBundle
! Usecases:
!
! (1) yobs(1:nobs_bins) - an array of obsHeadBundle, as yobs(:) has been used
! so far.
!
! use gsi_4dvar, only: nobs_bins
! ...
! type(obsHeadBundle),pointer,dimension(:):: yobs ! declaration
! ...
! call obsHeadBundle_create(yobs,nobs_bins)
! ...
! call obsHeadBundle_destroy(yobs) ! clean() then deallocation
!
! (2) yobs of a given bin - initialized where it is needed.
!
! use gsi_4dvar, only: nobs_bins
! ...
! type(obsHeadBundle):: yobs_ibin ! declaration/instanciation
! ...
! do ibin=1,nobs_bins
! call obsHeadBundle_init(yobs_ibin,ibin) ! initialization
! ...
! call obsHeadBundle_clean(yobs_ibin) ! cleaning
! enddo
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
character(len=*),parameter :: myname='m_obsHeadBundle'
#include "myassert.H"
contains
!---------------------------------------------
subroutine create_(yobs,nbins)
use kinds, only: i_kind
implicit none
type(obsHeadBundle),pointer,dimension(:):: yobs
integer(kind=i_kind),intent(in):: nbins
integer(i_kind):: ibin
allocate(yobs(nbins))
do ibin=1,size(yobs)
call init_(yobs(ibin),ibin)
enddo
return
end subroutine create_
!---------------------------------------------
subroutine destroy_(yobs)
use kinds, only: i_kind
implicit none
type(obsHeadBundle),pointer,dimension(:),intent(inout):: yobs
integer(i_kind):: ibin
do ibin=1,size(yobs)
call clean_(yobs(ibin))
enddo
deallocate(yobs)
return
end subroutine destroy_
!---------------------------------------------
subroutine init_(yobs,ibin)
!use m_obsdiags, only: ps_headNode
!use m_obsdiags, only: obsllist_
!use m_obsLList, only: obsLList_head
!use m_psNode , only: psNode_typecast ! = 1
use m_obsdiags, only: pshead ! = 1
use m_obsdiags, only: thead ! = 2
use m_obsdiags, only: whead ! = 3
use m_obsdiags, only: qhead ! = 4
use m_obsdiags, only: spdhead ! = 5
use m_obsdiags, only: rwhead ! = 6
use m_obsdiags, only: dwhead ! = 7
use m_obsdiags, only: ssthead ! = 8
use m_obsdiags, only: pwhead ! = 9
use m_obsdiags, only: pcphead ! =10
use m_obsdiags, only: ozhead ! =11
use m_obsdiags, only: o3lhead ! =12
use m_obsdiags, only: gpshead ! =13
use m_obsdiags, only: radhead ! =14
use m_obsdiags, only: tcphead ! =15
use m_obsdiags, only: laghead ! =16
use m_obsdiags, only: colvkhead ! =17
use m_obsdiags, only: aerohead ! =18
use m_obsdiags, only: aerolhead ! =19
use m_obsdiags, only: pm2_5head ! =20
use m_obsdiags, only: gusthead ! =21
use m_obsdiags, only: vishead ! =22
use m_obsdiags, only: pblhhead ! =23
use m_obsdiags, only: wspd10mhead ! =24
use m_obsdiags, only: td2mhead ! =25
use m_obsdiags, only: mxtmhead ! =26
use m_obsdiags, only: mitmhead ! =27
use m_obsdiags, only: pmslhead ! =28
use m_obsdiags, only: howvhead ! =29
use m_obsdiags, only: tcamthead ! =30
use m_obsdiags, only: lcbashead ! =31
use m_obsdiags, only: pm10head ! =32
use m_obsdiags, only: cldchhead ! =33
use m_obsdiags, only: uwnd10mhead ! =35
use m_obsdiags, only: vwnd10mhead ! =36
use m_obsdiags, only: swcphead ! =37
use m_obsdiags, only: lwcphead ! =38
use m_obsdiags, only: lighthead ! =39
use m_obsdiags, only: dbzhead ! =40
use kinds, only: i_kind
use mpeu_util, only: assert_
implicit none
type(obsHeadBundle),intent(out):: yobs
integer(i_kind),intent(in ):: ibin
ASSERT(1<=ibin)
ASSERT(ibin<=size( pshead)) ! = 1
ASSERT(ibin<=size( thead)) ! = 2
ASSERT(ibin<=size( whead)) ! = 3
ASSERT(ibin<=size( qhead)) ! = 4
ASSERT(ibin<=size( spdhead)) ! = 5
ASSERT(ibin<=size( rwhead)) ! = 6
ASSERT(ibin<=size( dwhead)) ! = 7
ASSERT(ibin<=size( ssthead)) ! = 8
ASSERT(ibin<=size( pwhead)) ! = 9
ASSERT(ibin<=size( pcphead)) ! =10
ASSERT(ibin<=size( ozhead)) ! =11
ASSERT(ibin<=size( o3lhead)) ! =12
ASSERT(ibin<=size( gpshead)) ! =13
ASSERT(ibin<=size( radhead)) ! =14
ASSERT(ibin<=size( tcphead)) ! =15
ASSERT(ibin<=size( laghead)) ! =16
ASSERT(ibin<=size(colvkhead)) ! =17
ASSERT(ibin<=size( aerohead)) ! =18
ASSERT(ibin<=size(aerolhead)) ! =19
ASSERT(ibin<=size(pm2_5head)) ! =20
ASSERT(ibin<=size( gusthead)) ! =21
ASSERT(ibin<=size( vishead)) ! =22
ASSERT(ibin<=size( pblhhead)) ! =23
ASSERT(ibin<=size(wspd10mhead))! =24
ASSERT(ibin<=size( td2mhead)) ! =25
ASSERT(ibin<=size( mxtmhead)) ! =26
ASSERT(ibin<=size( mitmhead)) ! =27
ASSERT(ibin<=size( pmslhead)) ! =28
ASSERT(ibin<=size( howvhead)) ! =29
ASSERT(ibin<=size(tcamthead)) ! =30
ASSERT(ibin<=size(lcbashead)) ! =31
ASSERT(ibin<=size( pm10head)) ! =32
ASSERT(ibin<=size(cldchhead)) ! =33
ASSERT(ibin<=size(uwnd10mhead))! =35
ASSERT(ibin<=size(vwnd10mhead))! =36
ASSERT(ibin<=size( swcphead)) ! =37
ASSERT(ibin<=size( lwcphead)) ! =38
ASSERT(ibin<=size(lighthead)) ! =39
ASSERT(ibin<=size(dbzhead)) ! =40
yobs%ps => obsLList_headNode( pshead(ibin)) ! = 1
yobs%t => obsLList_headNode( thead(ibin)) ! = 2
yobs%w => obsLList_headNode( whead(ibin)) ! = 3
yobs%q => obsLList_headNode( qhead(ibin)) ! = 4
yobs%spd => obsLList_headNode( spdhead(ibin)) ! = 5
yobs%rw => obsLList_headNode( rwhead(ibin)) ! = 6
yobs%dw => obsLList_headNode( dwhead(ibin)) ! = 7
yobs%sst => obsLList_headNode( ssthead(ibin)) ! = 8
yobs%pw => obsLList_headNode( pwhead(ibin)) ! = 9
yobs%pcp => obsLList_headNode( pcphead(ibin)) ! =10
yobs%oz => obsLList_headNode( ozhead(ibin)) ! =11
yobs%o3l => obsLList_headNode( o3lhead(ibin)) ! =12
yobs%gps => obsLList_headNode( gpshead(ibin)) ! =13
yobs%rad => obsLList_headNode( radhead(ibin)) ! =14
yobs%tcp => obsLList_headNode( tcphead(ibin)) ! =15
yobs%lag => obsLList_headNode( laghead(ibin)) ! =16
yobs%colvk => obsLList_headNode(colvkhead(ibin)) ! =17
yobs%aero => obsLList_headNode( aerohead(ibin)) ! =18
yobs%aerol => obsLList_headNode(aerolhead(ibin)) ! =19
yobs%pm2_5 => obsLList_headNode(pm2_5head(ibin)) ! =20
yobs%gust => obsLList_headNode( gusthead(ibin)) ! =21
yobs%vis => obsLList_headNode( vishead(ibin)) ! =22
yobs%pblh => obsLList_headNode( pblhhead(ibin)) ! =23
yobs%wspd10m => obsLList_headNode(wspd10mhead(ibin))! =24
yobs%td2m => obsLList_headNode( td2mhead(ibin)) ! =25
yobs%mxtm => obsLList_headNode( mxtmhead(ibin)) ! =26
yobs%mitm => obsLList_headNode( mitmhead(ibin)) ! =27
yobs%pmsl => obsLList_headNode( pmslhead(ibin)) ! =28
yobs%howv => obsLList_headNode( howvhead(ibin)) ! =29
yobs%tcamt => obsLList_headNode(tcamthead(ibin)) ! =30
yobs%lcbas => obsLList_headNode(lcbashead(ibin)) ! =31
yobs%pm10 => obsLList_headNode( pm10head(ibin)) ! =32
yobs%cldch => obsLList_headNode(cldchhead(ibin)) ! =33
yobs%uwnd10m => obsLList_headNode(uwnd10mhead(ibin))! =35
yobs%vwnd10m => obsLList_headNode(vwnd10mhead(ibin))! =36
yobs%swcp => obsLList_headNode( swcphead(ibin)) ! =37
yobs%lwcp => obsLList_headNode( lwcphead(ibin)) ! =38
yobs%light => obsLList_headNode(lighthead(ibin)) ! =39
yobs%dbz => obsLList_headNode(dbzhead(ibin)) ! =40
return
end subroutine init_
!---------------------------------------------
subroutine clean_(yobs)
implicit none
type(obsHeadBundle),intent(out):: yobs
type(obsHeadBundle) tmpobs
! yobs=obsHeadBundle()
yobs = tmpobs
end subroutine clean_
end module m_obsHeadBundle