SUBROUTINE BT_KSEC ( mszrpt, report, ngrps, istgrp, ierr1 )
C************************************************************************
C* BT_KSEC *
C* *
C* This subroutine calls the routines which decode the groups in *
C* sections 1-3 of the TRACKOB report. These groups include the *
C* observation time of the report, the latitude/longitude location of *
C* the ship, the averaging period for salinity, for sea temperature, *
C* and for surface current, the sea surface temperature, the salinity, *
C* and the surface current direction and speed. *
C* *
C* BT_KSEC ( MSZRPT, REPORT, NGRPS, ISTGRP, IERR1 ) *
C* *
C* Input parameters: *
C* *
C* MSZRPT INTEGER Report size in bytes *
C* REPORT CHAR* Report array *
C* NGRPS INTEGER Total number of groups following*
C* the first group in report *
C* ISTGRP INTEGER Array containing the location *
C* of the space before the start *
C* of each group in the report *
C* *
C* Output parameters: *
C* *
C* RIVALS(IRSELV) REAL Station elevation (always set *
C* to 0 for trackobs). *
C* RIVALS(IRAVGP) REAL Averaging periods for parameters*
C* RIVALS(IRNTRK) REAL Number of trackobs fields *
C* (always set to 3). *
C* RIVALS(IRNDTS) REAL Number of levels of data *
C* (always set to 1 for trackobs). *
C* RIVALS(IRDBSS) REAL Depth in meters. *
C* RIVALS(IRSTMP) REAL Temperature, hundredths of deg C*
C* RIVALS(IRSALN) REAL Salinity, in hundredths of a *
C* part per thousand (%). *
C* RIVALS(IRNDDC) REAL Number of levels of current data*
C* (always set to 1 for trackobs). *
C* RIVALS(IRDBSC) REAL Depth in meters (for currents). *
C* RIVALS(IRDROC) REAL Direction of surface current in *
C* degrees. *
C* RIVALS(IRSPOC) REAL Speed of surface current in m/s.*
C* IERR1 INTEGER Return code *
C* 0 = Normal return *
C* 1 = Problems *
C** *
C* Log: *
C* R. Hollern/NCEP 3/99 *
C* R. Hollern/NCEP 4/00 Removed code to save report correction *
C* indicator *
C* C. Caruso Magee/NCEP 6/01 Corrected one comment and added a few *
C* others for clarification. *
C* C. Caruso Magee/NCEP 2/02 Rename DOCW to DROC. *
C* C. Caruso Magee/NCEP 2/02 Add rivals ( irucsp ) *
C* C. Caruso Magee/NCEP 3/02 Add code to save current depth and *
C* counter into new Interface array *
C* elements (irdbsc and irnddc). *
C* R. Hollern/NCEP 1/04 Increased istgrp array size from 300 *
C* to 1100. *
C* J. Ator/NCEP 11/12 Increase istgrp size from 1100 to 3000 *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'btcmn.cmn'
C*
INTEGER istgrp(3000)
CHARACTER*(*) report
C*
INTEGER savper(3)
C*
LOGICAL more
C*
CHARACTER fld1*1, fld2*2, fld3*3, fld4*4
C
save jucsp, savper
C
INCLUDE 'ERMISS.FNC'
C------------------------------------------------------------------------
C
ierr1 = 0
C
C* Get the ship call sign.
C
CALL BT_TRID ( mszrpt, report, ngrps, istgrp, lenrpt, ierr2 )
C
IF ( ierr2 .gt. 0 ) THEN
ierr1 = 1
RETURN
END IF
C
ip = 1
iparam = 0
C
C* Set elevation to 0.0 meters.
C
rivals ( irselv ) = 0.0
C
C* Get the GMT observation time of data.
C
CALL BT_OBST ( report, ip, ierr1 )
IF ( ierr1 .eq. 1 ) THEN
RETURN
END IF
C
C* Get the latitude and longitude location.
C
CALL BT_LTLG ( report, ip, ierr1 )
IF ( ierr1 .eq. 1 ) THEN
RETURN
END IF
C
C* Check if next group contains the averaging periods.
C
fld1 = report(ip:ip)
C
IF ( fld1 .eq. '4' ) THEN
C
DO i = 1,3
C
ip = ip + 1
iparam = iparam + 1
savper ( i ) = RMISSD
C
C* Get the WMO FM 62 Code Table 2604 value for the
C* averaging period for sea temperature, salinity,
C* and direction and speed of current.
C
fld1 = report(ip:ip)
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
x = FLOAT ( ival )
rivals ( iravgp ( iparam ) ) = x
savper(i) = x
END IF
C
END DO
C
C* Indicator for units of sea-surface current speed.
C* iucsp = 0 indicates m/s; iucsp = 1 indicates kts;
C* iucsp = 9 indicates no sea-current data available.
C
iucsp = 9
jucsp = 9
ip = ip + 1
fld1 = report(ip:ip)
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
iucsp = ival
jucsp = ival
END IF
ELSE
C
C* Comes here if the group 4m(T)m(S)m(c)i(c) was included for the
C* first observation, but not included for subsequent observations.
C
DO i = 1,3
rivals ( iravgp ( i ) ) = savper ( i )
END DO
iucsp = jucsp
ip = ip - 2
C
END IF
C
C* Save indicator for units of sea-sfc current speed into Interface.
C
rivals ( irucsp ) = FLOAT ( iucsp )
C
C* TRACKOB data has only 3 parameters (SST, sfc salinity, sfc current)
C* with 3 corresponding indicators for averaging period (Code table 2604).
C* ( rivals(irntrk) corresponds to rivals(iravgp(i)) ).
C
rivals ( irntrk ) = 3.0
C
C* Set the depth for the TRACKOB SST and salinity parameter
C* to 0.0 meters.
C
rivals ( irdbss ( 1 ) ) = 0.0
C
C* Only 1 level of TRACKOB SST and/or salinity data.
C
rivals ( irndts ) = 1.0
C
more = .true.
C
DO WHILE ( ip .lt. ( lenrpt - 2 ) )
C
C* Get the next group.
C
ip = ip + 2
fld1 = report(ip:ip)
C
IF ( fld1 .eq. '6' ) THEN
C
C* Sea surface temperature group.
C
ip = ip + 1
fld1 = report(ip:ip)
C
C* Get sign of sea surface temperature.
C
IF ( fld1 .eq. '0' ) THEN
xsign = 1.0
ELSE IF ( fld1 .eq. '1' ) THEN
xsign = -1.0
ELSE
xsign = 0.0
END IF
C
ip = ip + 1
fld3 = report(ip:ip+2)
ip = ip + 2
C
CALL ST_INTG ( fld3, ival, ier )
IF ( ier .eq. 0 .and. xsign .ne. 0.0 ) THEN
rval = xsign * FLOAT ( ival )
rivals ( irstmp ( 1 ) ) = .1 * rval
END IF
ELSE IF ( fld1 .eq. '8' ) THEN
C
C* Get salinity, in hundredths of a part per thousand (%).
C
ip = ip + 1
fld4 = report ( ip:ip+3 )
CALL ST_INTG ( fld4, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( irsaln ( 1 ) ) = .01 * FLOAT ( ival )
END IF
ip = ip + 3
ELSE IF ( fld1 .eq. '9' .and. ( iucsp .eq. 0 .or.
+ iucsp .eq. 1 ) ) THEN
C
C* Direction of surface current in tens of degrees.
C* Store into Interface as whole degrees.
C
ip = ip + 1
fld2 = report ( ip:ip+1 )
CALL ST_INTG ( fld2, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( irdroc ( 1 ) ) = 10. * FLOAT ( ival )
END IF
C
C* Speed of the surface current in m/s.
C* (Reported as either tenths of a m/s or tenths of a kt).
C
ip = ip + 2
fld2 = report ( ip:ip+1 )
CALL ST_INTG ( fld2, ival, ier )
IF ( ier .eq. 0 ) THEN
C
x = .1 * FLOAT ( ival )
C
IF ( iucsp .eq. 0 ) THEN
rivals ( irspoc ( 1 ) ) = x
ELSE IF ( iucsp .eq. 1 ) THEN
C
C* Convert from knots to m/s.
C
rivals ( irspoc ( 1 ) ) = PR_KNMS ( x )
END IF
END IF
IF ( ( .not. ERMISS ( rivals ( irdroc ( 1 ) ) ) ) .or.
+ ( .not. ERMISS ( rivals ( irspoc ( 1 ) ) ) ) ) THEN
rivals ( irnddc ) = 1.0
rivals ( irdbsc ( 1 ) ) = 0.0
END IF
ELSE
C
C* Comes here if no more groups in report.
C
IF ( ip .lt. (lenrpt-35) ) THEN
ip = ip - 2
RETURN
END IF
END IF
C
END DO
C*
RETURN
END