* PACKAGE LSVDSL  !" $B@~7?2r@O(B : SVD $BK!$K$h$kFC0[O"N)J}Dx<0$N2r(B
*
*"  [HIS] 93/08/12(takepiro) NUMERICAL RECIPIES $B;HMQ(B
*"        93/09/27(takepiro) 0 $B8GM-CMH=Dj4p=`$N@_Dj(B
*
**********************************************************************
      SUBROUTINE LSVDSL
     M            ( AMAT   , 
     M              BVEC   ,
     O              IERR   , 
     I              EPS    ,
     I              MATDIM , OSVDC  )
*
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 
      INCLUDE   (ZLDIM)                      !" $B3J;RE@?t(B, $BGH?t(B
#else
#include        "zcdim.F"                    !" 
#include        "zldim.F"                    !" $B78?t9TNs$NBg$-$5(B
#endif
*
*   [MODIFY] 
      REAL      AMAT  ( MATDMX, MATDMX )     !" $B78?t9TNs(B
      REAL      BVEC  ( MATDMX )             !" $B1&JU%Y%/%H%k(B / $B2r(B
*
*   [OUTPUT] 
      INTEGER   IERR                         !" $B%5%V%k!<%A%s%(%i!<%3!<%I(B
*
*   [INPUT] 
      REAL      EPS                          !" $BFC0[@-H=Dj4p=`(B
      INTEGER   MATDIM                       !" $B7W;;$9$k<!85(B
      LOGICAL   OSVDC                        !" SVD $BJ,2r7W;;%9%$%C%A(B
*
*   [INTERNAL WORK] 
      REAL      XVEC  ( MATDMX )             !" $B8GM-CM<B?tIt(B
      REAL      WDIAG ( MATDMX )             !" $B8GM-CM5u?tIt(B
      REAL      WORKV ( MATDMX, MATDMX )     !" $B8GM-%Y%/%H%k<B?tIt(B
*
      INTEGER   IUNIT , I
      LOGICAL   OFIRST 
      DATA      OFIRST  / .TRUE. /
*
      SAVE      OFIRST
*
      IF ( OFIRST )THEN
         OFIRST = .FALSE.
         CALL GLPGET( 'MSGUNIT', IUNIT )
         WRITE ( IUNIT, * ) ' SINGULAR VALUE DECOMPOSITION : 93/09/27'
      ENDIF
*
*"  < 1. SVD $BJ,2r(B >
*
      IF ( OSVDC )THEN
         CALL SVDCMP
     M        ( AMAT   , 
     O          IERR   ,
     I          MATDMX , MATDIM , 
     I          MATDMX , MATDIM , 
     W          WDIAG  , WORKV    )
      ENDIF
*
*"  < 2. $BFC0[@-$N=|5n(B >
*
      DO 100 I = 1, MATDIM
         IF ( ABS(WDIAG(I)) .LT. EPS )THEN
            WDIAG(I) = 0.
         ENDIF
 100  CONTINUE 
*
*"  < 3. $B2r$r5a$a$k(B >
*
      CALL SVBKSB
     I       ( AMAT   , 
     W         WDIAG  , WORKV  ,
     I         MATDMX , MATDIM , 
     I         MATDMX , MATDIM , 
     I         BVEC   , 
     O         XVEC               )
*
      CALL COPY( BVEC , XVEC , MATDIM )
*
      RETURN
      END
