!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine suinnov(columng,columnhr,obsSpaceData) 4,46
!
!**s/r suinnov - Initialise Observation Innovations.
!
!
!Author : Luc Fillion - 28 Mar 2008.
!Revision:
! L. Fillion - ARMA/EC - 22 May 2008 - Upgrade to v_10_1_1.
! S. Macpherson -ARMA/MRD Aug 2008
! - Add ground-based GPS family "GP"
! S. Macpherson -ARMA/MRD Sep 2009
! - Add ground-based GPS family "GP"
! Bin He -ARMA/MRD Feb. 2010
! - Implemented MPI to 3DVAR
! S. Macpherson -ARMA/MRD Dec 2012 - Jan 2013
! - moved "WRITE"s for GB-GPS options to sugpsgb.ftn
! - DOBGPSGB is now ready for GEM-4 staggered grid
! - added CALL SETERRGPSGB(obsSpaceData,lgpdata) to set ZTD errors
! - NEW: >>if (lgpdata)<< CALL DOBSGPSGB
!
use mpi_mod
use topLevelControl_mod
use minimization_mod
use obsSpaceData_mod
use columnData_mod
use filterObs_mod
use timeCoord_mod
use obsOperators_mod
implicit none
type(struct_columnData) :: columnhr,columng
type(struct_obs) :: obsSpaceData
real*8 zjo,zjoraob,zjosatwind,zjosurfc
real*8 zjosfcsf,zjosfcua,zjotov,zjoairep,zjosfcsc,zjoprof
real*8 zjogpsro,zjogpsgb,zjosfcgp
integer :: ierr
logical lgpdata
write(*,*) '--Starting subrouting suinnov--'
write(*,*) 'PRDATABIN: Before filtering done in SUINNOV'
call prdatabin
(obsSpaceData,tim_nstepobs)
!
! Reject observed elements too far below the surface. Pressure values
! for elements slightly below the surface are replaced by the surface
! pressure values of the trial field.
!
! GB-GPS (met and ZTD) observations are processed in s/r filt_topoSFC (in filterobs_mod.ftn90)
!
call filt_topo
(columnhr,obsSpaceData)
!
! Remove surface station wind observations
!
IF( top_AnalysisMode
() ) CALL SFCWNDZAP
(obsSpaceData)
!
! Find interpolation layer in model profiles
!
call vobslyrs
(columnhr,obsSpaceData)
!
!
!------ Calculate the innovations Y - H(Xb) and place
! the result in obsSpaceData in OBS_OMP column
!
! RAOBS
!------------------------------
!
call tmg_start(48,'NL_OBS_OPER')
CALL oonl_ppp
(columnhr,obsSpaceData,ZJORAOB,'UA')
!
! AIREPS
!--------------------------------
CALL oonl_ppp
(columnhr,obsSpaceData,ZJOAIREP,'AI')
!
! SATWINDS
!--------------------------------
CALL oonl_ppp
(columnhr,obsSpaceData,ZJOSATWIND,'SW')
!
! SURFACE (SF, UA, SC AND GP FAMILIES)
!-------------------------------
call oonl_sfc
(columnhr,obsSpaceData,ZJOSFCSF,'SF')
call oonl_sfc
(columnhr,obsSpaceData,ZJOSFCUA,'UA')
call oonl_sfc
(columnhr,obsSpaceData,ZJOSFCSC,'SC')
call oonl_sfc
(columnhr,obsSpaceData,ZJOSFCGP,'GP')
ZJOSURFC = ZJOSFCUA + ZJOSFCSF + ZJOSFCSC + ZJOSFCGP
!
! TOVS - RADIANCE
!-------------------------------
call oonl_tovs
(columnhr,obsSpaceData,tim_getDatestamp
(),filt_rlimlvhu,top_BgckIrMode
(),ZJOTOV)
!
! PROFILER
!------------------------------
call oonl_zzz
(columnhr,obsSpaceData,ZJOPROF,'PR')
!
! GPS - RADIO OCCULTATION
!-------------------------------
CALL FILTERGPSRO
(columnhr,obsSpaceData)
CALL SETERRGPSRO
(columnhr,obsSpaceData)
call oonl_gpsro
(columnhr,obsSpaceData,ZJOGPSRO)
!
! GPS - GROUND-BASED ZENITH DELAY
!-------------------------------
!
ZJOGPSGB=0.0D0
CALL SETERRGPSGB
(obsSpaceData,lgpdata)
if (lgpdata) call oonl_gpsgb
(columnhr,obsSpaceData,ZJOGPSGB,top_AnalysisMode
())
call tmg_stop(48)
!
!=======================================================================
ZJO = ZJORAOB + ZJOAIREP + ZJOSATWIND +
$ ZJOSURFC + ZJOTOV + ZJOPROF + ZJOGPSRO + ZJOGPSGB
!=======================================================================
write(*,*) 'Cost function values for this MPI task:'
write(*,'(a15,f23.16)') 'JORAOB = ',ZJORAOB
write(*,'(a15,f23.16)') 'JOAIREP = ',ZJOAIREP
write(*,'(a15,f23.16)') 'JOSURFC = ',ZJOSURFC
write(*,'(a15,f23.16)') 'JOSFCSF = ',ZJOSFCSF
write(*,'(a15,f23.16)') 'JOSFCUA = ',ZJOSFCUA
write(*,'(a15,f23.16)') 'JOSFCSC = ',ZJOSFCSC
write(*,'(a15,f23.16)') 'JOSFCGP = ',ZJOSFCGP
write(*,'(a15,f23.16)') 'JOTOV = ',ZJOTOV
write(*,'(a15,f23.16)') 'JOSATWIND= ',ZJOSATWIND
write(*,'(a15,f23.16)') 'JOPROF = ',ZJOPROF
write(*,'(a15,f23.16)') 'JOGPSRO = ',ZJOGPSRO
write(*,'(a15,f23.16)') 'JOGPSGB = ',ZJOGPSGB
write(*,'(a15,f23.16)') 'Total Jo = ',ZJO
call mpi_allreduce_sumreal8scalar
(ZJORAOB,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOAIREP,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSURFC,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSFCSF,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSFCUA,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSFCSC,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSFCGP,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOTOV,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOSATWIND,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOPROF,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOGPSRO,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJOGPSGB,"GRID")
call mpi_allreduce_sumreal8scalar
(ZJO,"GRID")
write(*,*) 'Cost function values summed for all MPI tasks:'
write(*,'(a15,f23.16)') 'JORAOB = ',ZJORAOB
write(*,'(a15,f23.16)') 'JOAIREP = ',ZJOAIREP
write(*,'(a15,f23.16)') 'JOSURFC = ',ZJOSURFC
write(*,'(a15,f23.16)') 'JOSFCSF = ',ZJOSFCSF
write(*,'(a15,f23.16)') 'JOSFCUA = ',ZJOSFCUA
write(*,'(a15,f23.16)') 'JOSFCSC = ',ZJOSFCSC
write(*,'(a15,f23.16)') 'JOSFCGP = ',ZJOSFCGP
write(*,'(a15,f23.16)') 'JOTOV = ',ZJOTOV
write(*,'(a15,f23.16)') 'JOSATWIND= ',ZJOSATWIND
write(*,'(a15,f23.16)') 'JOPROF = ',ZJOPROF
write(*,'(a15,f23.16)') 'JOGPSRO = ',ZJOGPSRO
write(*,'(a15,f23.16)') 'JOGPSGB = ',ZJOGPSGB
write(*,'(a15,f23.16)') 'Total Jo = ',ZJO
!
! Find interpolation layer in model profiles
!
CALL VOBSLYRS
(columng,obsSpaceData)
IF (min_lvarqc) THEN
CALL SUASYM2
(obsSpaceData)
endif
write(*,*) 'PRDATABIN: After filtering done in SUINNOV'
call prdatabin
(obsSpaceData,tim_nstepobs)
RETURN
END