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 |