!--------------------------------------- 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 --------------------------------------
#include "maincompileswitch.inc"
#include "compileswitches.inc"
SUBROUTINE SELECTB(obsdat) 1,24
!
!---------------------------------------------------------------------------------
! PURPOSE: READ CMC BURP FILES FILL UP OBSSPACE DATA FILE
!
! ARGUMENTS:
! obsdat - obsdat-file object
!
! AUTHOR: P. KOCLAS(CMC CMDA)
!
! Revisions:
! 1 Oct 2013: S. Macpherson ARMA
! Bug fix: Put CALL SET_ERR_GBGPS *after* OBS_OER initialized to 0
!
! NOTE:
! BURP FILES ARE ASSUMED TO BE PRESENT IN CURRENT WORKING DIRECTORY
!---------------------------------------------------------------------------------
!
use ObsSpaceData_mod
use burp_read
use burpFiles_mod
IMPLICIT NONE
type (struct_obs), intent(inout) :: obsdat
INTEGER :: IBEG, IEND, NSTN1, NSTN2
logical :: obs_full
!
INTEGER :: J,JO
REAL(OBS_REAL) :: MISG
!
!
WRITE(*,*)' '
WRITE(*,*)'================================================='
WRITE(*,*)' SELECT READBURP BEGIN '
WRITE(*,*)'================================================='
WRITE(*,*)' '
MISG=PPMIS
IBEG=obs_numbody
(obsdat)
DO J =1,burp_nfiles
!
! call obs_status(obsdat, obs_full, Nstn1, IBEG, nulout)
IBEG=obs_numbody
(obsdat) +1
Nstn1=obs_numheader
(obsdat)
call READBURP
(obsdat,burp_cfamtyp(J),burp_cfilnam(J),J)
! call obs_status(obsdat, obs_full, Nstn2, IEND, nulout)
Nstn2=obs_numheader
(obsdat)
IEND=obs_numbody
(obsdat)
IF ( trim(burp_cfamtyp(J)) .ne. 'TO') THEN
call FDTOUV_OBSDAT
( obsdat,Nstn1+1,Nstn2,PPMIS)
call ADJUST_HUM_GZ
( obsdat,Nstn1+1,Nstn2)
call ADJUST_SFVCOORD
(obsdat,Nstn1+1,Nstn2)
ENDIF
DO JO=nstn1+1,nstn2
call obs_headSet_i
(obsdat,OBS_OTP,JO,J)
! call obs_headSet_i(obsdat,OBS_IDF,JO,J)
call obs_setFamily
(obsdat,trim(burp_cfamtyp(J)),JO)
END DO
! initializations
DO JO=IBEG,IEND
call obs_bodySet_r
(obsdat,OBS_OMA ,JO,MISG)
call obs_bodySet_r
(obsdat,OBS_OMP ,JO,MISG)
call obs_bodySet_r
(obsdat,OBS_OER ,JO,MISG)
call obs_bodySet_r
(obsdat,OBS_HPHT,JO,MISG)
call obs_bodySet_r
(obsdat,OBS_WORK,JO,MISG)
END DO
!
! For GP family, initialize OBS_OER to element 15032 (ZTD formal error)
! for all ZTD data (element 15031)
IF ( trim(burp_cfamtyp(J)) .eq. 'GP') THEN
print * ,' Initializing OBS_OER for GB-GPS ZTD to formal error (ele 15032)'
CALL SET_ERR_GBGPS
(obsdat,Nstn1+1,Nstn2)
ENDIF
!
END DO
WRITE(*,*) ' readburp obs_numheader
(obsdat)', obs_numheader
(obsdat)
WRITE(*,*) ' readburp obs_numbody
(obsdat) ', obs_numbody
(obsdat)
!
WRITE(*,*)' '
WRITE(*,*)'================================================='
WRITE(*,*)' SELECT READBURP END '
WRITE(*,*)'================================================='
WRITE(*,*)' '
RETURN
END SUBROUTINE SELECTB