SUBROUTINE CX_TBLB ( lutblb, iret ) C************************************************************************ C* CX_TBLB * C* * C* This subroutine reads CREX Table B which contains the element * C* descriptor data. * C* * C* CX_TBLB ( LUTBLB, IRET ) * C* * C* Input parameters: * C* LUTBLB INTEGER CREX Table B logical unit number* C* * C* Output parameters: * C* NTBLBRC INTEGER Number of Table B records * C* * C* ELMDESC (ITBLBSZ) * C* INTEGER Element descriptors in Table B * C* ELMNAME (ITBLBSZ) * C* CHAR* Element descriptor names * C* UNITS (ITBLBSZ) * C* CHAR* Element descriptor Units * C* ISCALE (ITBLBSZ) * C* INTEGER Element descriptor scale values * C* IWIDTH (ITBLBSZ) * C* INTEGER Element descriptor data widths * C* * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = fatal error * C* * C** * C* Log: * C* R. Hollern/NCEP 8/03 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'cxcmn.cmn' C* LOGICAL more C----------------------------------------------------------------------- iret = 0 more = .true. ntblbrc = 0 j = 0 c DO WHILE ( more ) C j = j + 1 C IF ( j .gt. ITBLBSZ ) THEN iret = 1 loglvl = 2 logmsg = ' ' logmsg(1:30) = 'CREX Table B size exceeded -- ' logmsg(31:41) = 'FATAL ERROR' CALL DC_WLOG( loglvl, 'CX', 2, logmsg, ierwlg ) RETURN END IF C READ ( lutblb, 100, IOSTAT=iostat ) elmdesc(j), + elmname(j), units(j), iscale(j), iwidth(j) C 100 FORMAT ( a6, 2x, a64, 2x, a16, 2x, i3, 1x, i4 ) C IF ( iostat .lt. 0 .OR. elmdesc(j) .eq. 'ENDEND' ) THEN C C* No more records in table. Close the file. C CALL FL_CLOS ( lutblb, iercls ) RETURN ELSE IF ( iostat .gt. 0 ) THEN C C* I/O Error reading table. C iret = 1 loglvl = 2 logmsg = ' ' logmsg(1:30) = 'I/O error reading CREX Table B' logmsg(31:45) = ' -- FATAL ERROR' CALL DC_WLOG( loglvl, 'CX', 2, logmsg, ierwlg ) RETURN ELSE ntblbrc = ntblbrc + 1 END IF C END DO C* RETURN END