dbinfo.f

        SUBROUTINE DB_INFO  ( dbinfo, iret )
C************************************************************************
C* DB_INFO                                                              *
C*                                                                      *
C* This subroutine puts DB info into common.                            *
C*                                                                      *
C* DB_INFO  ( DBINFO, IRET )                                            *
C*                                                                      *
C* Input parameters:                                                    *
C*      DBINFO          CHAR*          DB info                          *
C*                                                                      *
C* Output parameters:                                                   *
C*      IRET            INTEGER         Return code                     *
C*                                        0 = normal return             *
C*                                      -14 = could not set db def parms*
C**                                                                     *
C* Log:                                                                 *
C* m.gamazaychikov/CWS	07/09                                           *
C* m.gamazaychikov/CWS  02/11   Removed setting the dbhost              *
C************************************************************************
        INCLUDE         'GEMPRM.PRM'
        INCLUDE         'dbcmn.cmn'
C*
        CHARACTER*(*)   dbinfo
C*
        CHARACTER       sourc*6, parms*5, pfile*4
        CHARACTER       carr(5)*128, carr2(2)*80, sprtr*2
        DATA            sourc / 'SOURCE' /
        DATA            parms / 'PARMS' /
        DATA            pfile / 'FILE' /
        DATA            sprtr / '--' /
        LOGICAL         issource, isparms, isfile
C------------------------------------------------------------------------
        DO ii = 1, 2
          carr(ii) = ' '
          carr2(ii) = ' '
        END DO
        dbdatasrc = ' ' 
        dbparms   = ' ' 
        dbprmfile = ' ' 
        issource = .false.
        isparms = .false.
        isfile = .false.
        CALL ST_CLS2 ( dbinfo, '|', '--', 5, carr, num, ier )
C
C*      Match alias with its attribute list.
C
        DO icarr = 2, num
           IF ( carr(icarr) .ne. sprtr ) THEN  
              CALL ST_CLS2 ( carr(icarr), ':', ' ', 2, carr2, 
     +                       num2, ier )
              IF ( num2 .eq. 2 ) THEN
                 CALL ST_LSTR ( carr2(1), ilstr1, ier )
                 CALL ST_LSTR ( carr2(2), ilstr2, ier )
                 IF (carr2(1)(:ilstr1) .eq. sourc) THEN
                   dbdatasrc = carr2(2)(1:ilstr2)
                   issource = .true.
                 ELSE IF (carr2(1)(:ilstr1) .eq. parms) THEN
                   dbparms   = carr2(2)(1:ilstr2)
                   isparms = .true.
                 ELSE IF (carr2(1)(:ilstr1) .eq. pfile) THEN
                   dbprmfile = carr2(2)(1:ilstr2)
                   isfile = .true.
                 END IF
              END IF
           END IF
        END DO
        
        IF ( .not. issource .or. .not. isparms .or. .not. isfile ) THEN
           iret = -14
C           CALL ER_WMSG  ( 'DB', iret, ' ', ier )
           RETURN
        END IF
C*
        RETURN
        END