Appendix D. Complete Fortran77 Example

C  Example of the FORTRAN call to NetSolve
C  This program sends :
C 
C     - One blocking request for the problem 'dgesv'
C     - One non-blocking request for the problem 'dgesv'
C  
C   and
C 
C     - One blocking request for the problem 'linsol'
C     - One non-blocking request for the problem 'linsol'
C 
C  The problem 'linsol' is a simplified version of 'dgesv'
C 
C  WARNING : The matrix may be singular, in which case NetSolve
C            will print an error message.
C  

      PROGRAM EXAMPLE
 
      INCLUDE '../../include/fnetsolve.h'

      INTEGER MAX
      PARAMETER (MAX = 500)
      INTEGER M
      DOUBLE PRECISION A1(MAX,MAX)
      DOUBLE PRECISION A2(MAX,MAX)
      DOUBLE PRECISION A3(MAX,MAX)
      DOUBLE PRECISION A4(MAX,MAX)
      DOUBLE PRECISION B1(MAX)
      DOUBLE PRECISION B2(MAX)
      DOUBLE PRECISION B3(MAX)
      DOUBLE PRECISION B4(MAX)

      INTEGER PIVOT(MAX)
      INTEGER IERR

      INTEGER I,J, II, III
      INTEGER INIT
      INTEGER INFO,REQUEST

      EXTERNAL FNETSL, FNETSLNB, FNETSLPB, FNETSLWT

      INTRINSIC DBLE, MOD

      WRITE(*,*) 'Enter the size of your matrix   M ='
      READ(*,*) M

      IF(M.GT.MAX) THEN
        WRITE(*,*) 'Too big !!'
        STOP
      ENDIF

C
C      Generating the matrices
C
      WRITE(*,*) 'Generating the problem ...'
      INIT = 1325
      DO 10 I = 1,M
        DO 11 J = 1,M
          INIT = MOD(2315*INIT,65536)
          A1(J,I) = (DBLE(INIT) - 32768.D0)/16384.D0
          A2(J,I) = A1(J,I)
          A3(J,I) = A1(J,I)
          A4(J,I) = A1(J,I)
11      CONTINUE
10    CONTINUE


C
C      Generating the right-hand sides
C
      DO 12 I = 1,M
        INIT = MOD(2315*INIT,65536)
        B1(I) = (DBLE(INIT) - 32768.D0)/16384.D0
        B2(I) = B1(I)
        B3(I) = B1(I)
        B4(I) = B1(I)
12    CONTINUE

C  Calling Netsolve for 'dgesv' in a blocking fashion 
C  For 'dgesv', the right-hand side is overwritten  
C  with the solution                                 

      WRITE(*,*) 'Calling NetSolve for "dgesv", blocking :'
      CALL FNETSL( 'dgesv()',INFO,M,1,A1,MAX,PIVOT,B1,MAX,IERR )
      IF( INFO.LT.0 ) THEN
        CALL FNETSLERR( INFO )
        STOP
      END IF
      IF( IERR.NE.0 ) THEN
        WRITE(*,*) 'Cannot solve for this Matrix and right-hand side'
      ELSE
        WRITE(*,*) '*************'
        WRITE(*,*) '** Success **'
        WRITE(*,*) '*************'
        WRITE(*,*) '        Result :'
        DO 13 I = 1,M
          WRITE(*,*) '           --> ',B1(I)
13      CONTINUE
      END IF
    
C  Calling Netsolve for 'dgesv' in a non-blocking fashion
C  For 'dgesv', the right-hand side is overwritten        
C  with the solution                                     
    
      WRITE(*,*) 'Calling NetSolve for "dgesv", non-blocking :'
      CALL FNETSLNB( 'dgesv()',REQUEST,M,1,A2,MAX,PIVOT,B2,MAX,IERR )
      IF( REQUEST.LT.0 ) THEN
        CALL FNETSLERR( REQUEST )
        STOP
      END IF
      WRITE(*,*) 'Request #',INFO,' being processed'
      WRITE(*,*) 'Probing......'
14    CONTINUE
      CALL FNETSLPR( REQUEST, INFO )
      IF( INFO.EQ.NetSolveNotReady ) THEN
         DO 21 II=1,50
            III = II + 3*II
21       CONTINUE
         GO TO 14
      END IF
      IF( INFO.EQ.NetSolveOK )
     $   CALL FNETSLWT( REQUEST, INFO )

      IF( IERR.NE.0 ) THEN
        WRITE(*,*) 'Cannot solve for this Matrix and right-hand side'
      ELSE
        WRITE(*,*) '*************'
        WRITE(*,*) '** Success **'
        WRITE(*,*) '*************'
        WRITE(*,*) '        Result :'
        DO 16 I = 1,M
          WRITE(*,*) '           --> ',B2(I)
16      CONTINUE
      END IF
     
C   Calling Netsolve for 'linsol' in a blocking fashion 
C   For 'linsol', the right-hand side is overwritten 
C   with the solution                                 
     
      WRITE(*,*) 'Calling NetSolve for "linsol", blocking :'
      CALL FNETSL( 'linsol()',INFO,M,1,A3,MAX,B3,MAX )
      IF( INFO.LT.0 ) THEN
        CALL FNETSLERR( INFO )
      ELSE
        WRITE(*,*) '*************'
        WRITE(*,*) '** Success **'
        WRITE(*,*) '*************'
        WRITE(*,*) '        Result :'
        DO 17 I= 1,M
          WRITE(*,*) '           -->',B3(I)
17      CONTINUE
      END IF

C   Calling Netsolve for 'linsol' in a non-blocking fashion 
C   For 'linsol', the right-hand side is overwritten    
C   with the solution                                     
     
      WRITE(*,*) 'Calling NetSolve for "linsol", non-blocking :'
      CALL FNETSLNB( 'linsol()',REQUEST,M,1,A4,MAX,B4,MAX )
      IF( REQUEST.LT.0 ) THEN
        CALL FNETSLERR( INFO )
        STOP
      END IF
      WRITE(*,*) 'Request #',REQUEST,' being processed'
      WRITE(*,*) 'Probing......'
18    CONTINUE
      CALL FNETSLPR(REQUEST,INFO)
      IF (INFO.EQ.NetSolveNotReady) THEN
         DO 22 II=1,50
            III = II + 3*II
22       CONTINUE
         GO TO 18
      END IF
      IF( INFO.EQ.NetSolveOK )
     $   CALL FNETSLWT( REQUEST, INFO )

      IF( INFO.LT.0 ) THEN
        CALL FNETSLERR( INFO )
      ELSE
        WRITE(*,*) '*************'
        WRITE(*,*) '** Success **'
        WRITE(*,*) '*************'
        WRITE(*,*) '        Result :'
        DO 20 I= 1,M
          WRITE(*,*) '           -->',B4(I)
20      CONTINUE
      END IF

      STOP
      END