SUBROUTINE CH_KGETTRDESC(KLIST,KPARM,KELE,CDSTNID, 3,1
& KDESC,KLDESC,KNDESC)
C
#if defined (DOC)
*-----------------------------------------------------------------------
*
***function CH_KGETTRDESC -- Get observation descriptor from BURP record
* list KLIST
*
*Author .Y. Yang Feb. 2005
*
*Revision:
* Y.J. Rochon ARQX/MSC May/June 2005
* - Indentation alignment.
* - Modified to allow finding more than one element (addition
* of K*DESC). Now a subroutine instead of a function.
* - Use CH_IFIND instead of IFIND to search species obs only.
*
*
* PURPOSE: Get observation descriptor from the list of BURP record KLIST
*
* ARGUMENTS:
* INPUT:
*
* KLIST : list of elements in the data block
* KELE : number of elements in this record
* KPARM : Species id or 0 if dynamics
* CDSTNID: Station/instrument ID. Equals ' ' if irrelevant.
*
* OUTPUT:
*
* KNDESC: Number of obs descriptors found
* KDESC : List of obs descriptors found
* KLDESC: List of indices for location in initial list.
*
*-----------------------------------------------------------------------
#endif
IMPLICIT NONE
#include "comlun.cdk"
#include "comdim.cdk"
#include "comchem.cdk"
#include "comnumbr.cdk"
C
CHARACTER*(*) CDSTNID
INTEGER KELE
INTEGER KLIST(KELE),KDESC(KELE),KNDESC,KLDESC(KELE),KPARM
INTEGER CH_IFIND
INTEGER JI, ILEM, IC
C
EXTERNAL CH_IFIND
C
IC=0
DO JI=1,KELE
ILEM=CH_IFIND
(KLIST(JI),KPARM,CDSTNID)
IF (ILEM .GT. 0) THEN
IC=IC+1
KLDESC(IC)=JI
KDESC(IC) = KLIST(JI)
ENDIF
ENDDO
KNDESC=IC
C
return
end