Patch provided by Lawrence Mulholland from Nag on Nov 1st 2013

Email below: 
============
I have been incorporating some routines into the NAG Library,
which means some automatic code translation and writing some
example and test programs.

The routines I have been adding are:
?geqrt, ?gemqrt, ?tpqrt, ?tpmqrt, ?orcsd, ?uncsd

At the end of this message I will give you my current svn status
and svn diff for consideration and approval before I commit.

In each case, when testing immediate exits, my tests failed because
constraints were mutually exclusive for the immediate return case.
I have already committed changes to the constraints for some of
the above to allow immediate exit.
I have completed this for the remainder of this set.

Less importantly, there are things in the code that trip up a checking
compiler:
  a) an
           IF ( clause1(i) .AND. clause2(array(i)) ) THEN

      where array(i) is either not initialized or is out of bounds if
      clause1(i) is .FALSE.

      This is wrong since a Fortran compiler is at liberty to test clause2 first.
      In my changes this has been split into two as best suits the case.

 b) an
          CALL SUB (i, array(N-i+2))
     with i = 1 and array(N+1) either not initialized or out of bounds, but
     internally array(N+1) is not referenced.

     In this case I don't think the Fortran standard is clear, but it trips up the
     nagfor compiler with checking on. So in the NAG incorporated versions
     of Lapack routines such calls are protected and/or
     a special i=1 call is made.
     The changes I want to commit also do this.

 c) workspace queries passing zero instead of array references
         e.g.
                lwork = -1
                call barf(n,m,0,0,0,0,0,-1,info)

     a checking compiler won't like this.
     I have changed cases like this to pass available arrays of sufficient size
     and the right shape in place of the zeros.

1 files changed, 4 insertions, 1 deletions

diff --git a/SRC/zbbcsd.f b/SRC/zbbcsd.f
index 4a6b5c53..84090b12 100644
--- a/SRC/zbbcsd.f
+++ b/SRC/zbbcsd.f
@@ -476,7 +476,10 @@
 *     Initial deflation
 *
       IMAX = Q
-      DO WHILE((IMAX.GT.1).AND.(PHI(MAX(IMAX-1,1)).EQ.ZERO))
+      DO WHILE( IMAX .GT. 1 )
+         IF( PHI(IMAX-1) .NE. ZERO ) THEN
+            EXIT
+         END IF
          IMAX = IMAX - 1
       END DO
       IMIN = IMAX - 1