New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
lib_isml.f90 in trunk/NEMO/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/lib_isml.f90 @ 941

Last change on this file since 941 was 719, checked in by ctlod, 16 years ago

get back to the nemo_v2_3 version for trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.3 KB
Line 
1!
2! subroutines for PCG or SOR solvers
3! (used if the ISML library is not available)
4!
5! linrg
6!   gauss
7!   vmov
8!   desremopt
9!   dtrsv
10!   dger
11!   xerbla
12!   lsame
13! folr (empty)
14!
15!!----------------------------------------------------------------------
16!!  OPA 9.0 , LOCEAN-IPSL (2005)
17!! $Header$
18!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
19!!----------------------------------------------------------------------
20   SUBROUTINE linrg(kn,pa,klda,painv,kldainv)
21
22      !! compute inverse matrix
23
24      IMPLICIT NONE
25      INTEGER kn,klda,kldainv
26      REAL (kind=8) ::   pa(kn,kn),painv(kn,kn)
27      REAL (kind=8) ::   zb(kn,kn)
28      REAL (kind=8) ::   zv(kn)
29      INTEGER iplin(kn)
30      INTEGER ji
31
32      IF( kn /= klda .OR. kn /= kldainv ) THEN
33          write(0,*)'change your parameters'
34          STOP
35      ENDIF
36
37      CALL vmov( kn*kn, pa, painv )
38
39      CALL gauss( kn, painv, iplin, zv )
40
41      zb(:,:) = 0.e0   
42      DO ji = 1, kn
43        zb(ji,ji) = 1.e0
44        CALL desremopt( kn, painv, iplin, zb(1,ji), zb(1,ji), zv )
45      END DO
46      CALL vmov( kn*kn, zb, painv )
47
48   END SUBROUTINE linrg
49!---------------------------------------------------------
50   SUBROUTINE gauss(kn,pa,kplin,pv)
51
52      IMPLICIT NONE
53      INTEGER kn
54      INTEGER ji,jj,jk
55      INTEGER ik,ipp
56      REAL (kind=8) ::   pa(kn,kn),pv(kn)
57!!    REAL (kind=8) ::   zpivmax,zalpha
58      REAL (kind=8) ::   zalpha
59      INTEGER kplin(kn)
60      INTEGER isamax
61      EXTERNAL isamax
62
63!  factorisation de Gauss de la matrice a avec pivot partiel .
64!  initialisation des pointeurs .
65      DO ji=1,kn
66        kplin(ji)=ji
67      END DO
68      DO jk=1,kn-1
69!  recherche du pivot maximal .
70!!      ik=jk
71!!      zpivmax=dabs(pa(jk,jk))
72!!        DO ji=jk,kn
73!!          IF(dabs(pa(ji,jk)) > zpivmax) THEN
74!!            zpivmax=dabs(pa(ji,jk))
75!!            ik=ji
76!!          ENDIF
77!!        END DO
78        ik=isamax( kn-jk+1, pa(jk,jk) )+jk-1
79!  permutation de la ligne jk et de la ligne ik .
80        IF(jk == 58) THEN
81            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
82            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
83        ENDIF
84        ipp=kplin(ik)
85        kplin(ik)=kplin(jk)
86        kplin(jk)=ipp
87        DO jj=1,kn
88          pv(jj)=pa(ik,jj)
89          pa(ik,jj)=pa(jk,jj)
90          pa(jk,jj)=pv(jj)
91        END DO
92        IF(jk == 58) THEN
93            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
94            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
95        ENDIF 
96!  calcul des coefficients de la colonne k ligne a ligne .
97        DO ji=jk+1,kn
98          IF(pa(jk,jk) == 0) THEN
99              PRINT *,'probleme diagonale nulle',jk,pa(jk,jk)
100              pa(ji,jk)=pa(ji,jk)/1.E-20
101          ENDIF
102          IF(pa(jk,jk) /= 0) pa(ji,jk)=pa(ji,jk)/pa(jk,jk)
103        END DO 
104!!        DO ji=jk+1,kn
105!!          DO jj=jk+1,kn
106!!            pa(ji,jj)=pa(ji,jj)-pa(ji,jk)*pa(jk,jj)
107!!          END DO
108!!        END DO
109        zalpha=-1.
110        CALL dger(kn-jk,kn-jk,zalpha,pa(jk+1,jk),1,pa(jk,jk+1),kn,   &
111            pa(jk+1,jk+1),kn)
112      END DO
113
114   END SUBROUTINE gauss
115!---------------------------------------------------------
116   FUNCTION isamax( I, X )
117      DIMENSION X(I)
118      ISAMAX = 0
119      XMIN = -1e+50
120      DO N = 1, I
121         IF(ABS(X(N)) > XMIN ) THEN
122            XMIN = X(N)
123            ISAMAX = N
124         ENDIF
125      END DO
126   END FUNCTION isamax
127!---------------------------------------------------------
128   SUBROUTINE vmov(kn,px,py)
129
130      IMPLICIT NONE
131      INTEGER kn
132      REAL (kind=8) ::   px(kn),py(kn)
133      INTEGER ji
134
135      DO ji=1,kn
136         py(ji)=px(ji)
137      END DO
138
139   END SUBROUTINE vmov
140!---------------------------------------------------------
141   subroutine desremopt(n,a,plin,y,x,v)
142      implicit none
143      integer n,i,  j0
144!!    integer n,i,j,j0
145      real (kind=8) ::   a(n,n),x(n),y(n),v(n)
146      integer plin(n)
147!  descente remontee du systeme .
148!  initialisation du vecteur resultat .
149!  prise en compte de la permutation des lignes .
150      do i=1,n
151        v(i)=y(plin(i))
152      end do
153      do i=1,n
154        if(v(i) /= 0.) then
155          j0=i-1
156          goto 1
157        endif
158      end do
1591     continue
160!  descente du systeme L v = v , L est a diagonale unitaire .
161!!      do j=j0+1,n
162!!        do i=j+1,n
163!!          v(i)=v(i)-a(i,j)*v(j)
164!!        end do
165!!      end do
166      call dtrsv('L','N','U',n-j0,a(j0+1,j0+1),n,v(j0+1),1)
167!  remontee du systeme U v = v .
168!!      do j=n,1,-1
169!!        v(j)=v(j)/a(j,j)
170!!        do i=1,j-1
171!!          v(i)=v(i)-a(i,j)*v(j)
172!!        end do
173!!      end do         
174      call dtrsv('U','N','N',n,a,n,v,1)
175!  prise en compte de la permutation des colonnes .
176      do i=1,n
177        x(i)=v(i)
178      end do
179
180   end SUBROUTINE desremopt
181!---------------------------------------------------------
182   SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
183!!    .. Scalar Arguments ..
184      INTEGER            INCX, LDA, N
185      CHARACTER (len=1) ::   DIAG, TRANS, UPLO
186!!    .. Array Arguments ..
187!     DOUBLE PRECISION   A( LDA, * ), X( * )
188      REAL (kind=8) ::     A( LDA, * ), X( * )
189!!    ..
190
191!! Purpose
192!! =======
193
194!! DTRSV  solves one of the systems of equations
195
196!!    A*x = b,   or   A'*x = b,
197
198!! where b and x are n element vectors and A is an n by n unit, or
199!! non-unit, upper or lower triangular matrix.
200
201!! No test for singularity or near-singularity is included in this
202!! routine. Such tests must be performed before calling this routine.
203
204!! Parameters
205!! ==========
206
207!! UPLO   - CHARACTER*1.
208!!          On entry, UPLO specifies whether the matrix is an upper or
209!!          lower triangular matrix as follows:
210
211!!             UPLO = 'U' or 'u'   A is an upper triangular matrix.
212
213!!             UPLO = 'L' or 'l'   A is a lower triangular matrix.
214
215!!          Unchanged on exit.
216
217!! TRANS  - CHARACTER*1.
218!!          On entry, TRANS specifies the equations to be solved as
219!!          follows:
220
221!!             TRANS = 'N' or 'n'   A*x = b.
222
223!!             TRANS = 'T' or 't'   A'*x = b.
224
225!!             TRANS = 'C' or 'c'   A'*x = b.
226
227!!          Unchanged on exit.
228
229!! DIAG   - CHARACTER*1.
230!!          On entry, DIAG specifies whether or not A is unit
231!!          triangular as follows:
232
233!!             DIAG = 'U' or 'u'   A is assumed to be unit triangular.
234
235!!             DIAG = 'N' or 'n'   A is not assumed to be unit
236!!                                 triangular.
237
238!!          Unchanged on exit.
239
240!! N      - INTEGER.
241!!          On entry, N specifies the order of the matrix A.
242!!          N must be at least zero.
243!!          Unchanged on exit.
244
245!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
246!!          Before entry with  UPLO = 'U' or 'u', the leading n by n
247!!          upper triangular part of the array A must contain the upper
248!!          triangular matrix and the strictly lower triangular part of
249!!          A is not referenced.
250!!          Before entry with UPLO = 'L' or 'l', the leading n by n
251!!          lower triangular part of the array A must contain the lower
252!!          triangular matrix and the strictly upper triangular part of
253!!          A is not referenced.
254!!          Note that when  DIAG = 'U' or 'u', the diagonal elements of
255!!          A are not referenced either, but are assumed to be unity.
256!!          Unchanged on exit.
257
258!! LDA    - INTEGER.
259!!          On entry, LDA specifies the first dimension of A as declared
260!!          in the calling (sub) program. LDA must be at least
261!!          max( 1, n ).
262!!          Unchanged on exit.
263
264!! X      - DOUBLE PRECISION array of dimension at least
265!!          ( 1 + ( n - 1 )*abs( INCX ) ).
266!!          Before entry, the incremented array X must contain the n
267!!          element right-hand side vector b. On exit, X is overwritten
268!!          with the solution vector x.
269
270!! INCX   - INTEGER.
271!!          On entry, INCX specifies the increment for the elements of
272!!          X. INCX must not be zero.
273!!          Unchanged on exit.
274
275
276!! Level 2 Blas routine.
277
278!! -- Written on 22-October-1986.
279!!    Jack Dongarra, Argonne National Lab.
280!!    Jeremy Du Croz, Nag Central Office.
281!!    Sven Hammarling, Nag Central Office.
282!!    Richard Hanson, Sandia National Labs.
283
284
285!!    .. Parameters ..
286!     DOUBLE PRECISION   ZERO
287!     PARAMETER        ( ZERO = 0.0D+0 )
288      REAL (kind=8) ::                 ZERO
289      PARAMETER        ( ZERO = 0.0 )
290!!    .. Local Scalars ..
291!     DOUBLE PRECISION   TEMP
292      REAL (kind=8) ::                 TEMP
293      INTEGER            I, INFO, IX, J, JX, KX
294      LOGICAL            NOUNIT
295!!    .. External Functions ..
296      LOGICAL            LSAME
297      EXTERNAL           LSAME
298!!    .. External Subroutines ..
299      EXTERNAL           XERBLA
300!!    .. Intrinsic Functions ..
301      INTRINSIC          MAX
302!!    ..
303!!    .. Executable Statements ..
304
305!!    Test the input parameters.
306
307      INFO = 0
308      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.   &
309               .NOT.LSAME( UPLO , 'L' )      )THEN
310         INFO = 1
311      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.   &
312               .NOT.LSAME( TRANS, 'T' ).AND.   &
313               .NOT.LSAME( TRANS, 'C' )      )THEN
314         INFO = 2
315      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.   &
316               .NOT.LSAME( DIAG , 'N' )      )THEN
317         INFO = 3
318      ELSE IF( N < 0 )THEN
319         INFO = 4
320      ELSE IF( LDA < MAX( 1, N ) )THEN
321         INFO = 6
322      ELSE IF( INCX == 0 )THEN
323         INFO = 8
324      END IF
325      IF( INFO /= 0 )THEN
326         CALL XERBLA( 'DTRSV ', INFO )
327         RETURN
328      END IF
329
330!!    Quick return if possible.
331
332      IF( N == 0 )   RETURN
333
334      NOUNIT = LSAME( DIAG, 'N' )
335
336!!    Set up the start point in X if the increment is not unity. This
337!!    will be  ( N - 1 )*INCX  too small for descending loops.
338
339      IF( INCX <= 0 )THEN
340         KX = 1 - ( N - 1 )*INCX
341      ELSE IF( INCX /= 1 )THEN
342         KX = 1
343      END IF
344
345!!    Start the operations. In this version the elements of A are
346!!    accessed sequentially with one pass through A.
347
348      IF( LSAME( TRANS, 'N' ) )THEN
349
350!!       Form  x := inv( A )*x.
351
352         IF( LSAME( UPLO, 'U' ) )THEN
353            IF( INCX == 1 )THEN
354               DO 20, J = N, 1, -1
355                  IF( X( J ) /= ZERO )THEN
356                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
357                     TEMP = X( J )
358                     DO 10, I = J - 1, 1, -1
359                        X( I ) = X( I ) - TEMP*A( I, J )
360   10                CONTINUE
361                  END IF
362   20          CONTINUE
363            ELSE
364               JX = KX + ( N - 1 )*INCX
365               DO 40, J = N, 1, -1
366                  IF( X( JX ) /= ZERO )THEN
367                     IF( NOUNIT )  X( JX ) = X( JX )/A( J, J )
368                     TEMP = X( JX )
369                     IX   = JX
370                     DO 30, I = J - 1, 1, -1
371                        IX      = IX      - INCX
372                        X( IX ) = X( IX ) - TEMP*A( I, J )
373   30                CONTINUE
374                  END IF
375                  JX = JX - INCX
376   40          CONTINUE
377            END IF
378         ELSE
379            IF( INCX == 1 )THEN
380               DO 60, J = 1, N
381                  IF( X( J ) /= ZERO )THEN
382                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
383                     TEMP = X( J )
384                     DO 50, I = J + 1, N
385                        X( I ) = X( I ) - TEMP*A( I, J )
386   50                CONTINUE
387                  END IF
388   60          CONTINUE
389            ELSE
390               JX = KX
391               DO 80, J = 1, N
392                  IF( X( JX ) /= ZERO )THEN
393                     IF( NOUNIT )   X( JX ) = X( JX )/A( J, J )
394                     TEMP = X( JX )
395                     IX   = JX
396                     DO 70, I = J + 1, N
397                        IX      = IX      + INCX
398                        X( IX ) = X( IX ) - TEMP*A( I, J )
399   70                CONTINUE
400                  END IF
401                  JX = JX + INCX
402   80          CONTINUE
403            END IF
404         END IF
405      ELSE
406
407!!       Form  x := inv( A' )*x.
408
409         IF( LSAME( UPLO, 'U' ) )THEN
410            IF( INCX == 1 )THEN
411               DO 100, J = 1, N
412                  TEMP = X( J )
413                  DO 90, I = 1, J - 1
414                     TEMP = TEMP - A( I, J )*X( I )
415   90             CONTINUE
416                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
417                  X( J ) = TEMP
418  100          CONTINUE
419            ELSE
420               JX = KX
421               DO 120, J = 1, N
422                  TEMP = X( JX )
423                  IX   = KX
424                  DO 110, I = 1, J - 1
425                     TEMP = TEMP - A( I, J )*X( IX )
426                     IX   = IX   + INCX
427  110             CONTINUE
428                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
429                  X( JX ) = TEMP
430                  JX      = JX   + INCX
431  120          CONTINUE
432            END IF
433         ELSE
434            IF( INCX == 1 )THEN
435               DO 140, J = N, 1, -1
436                  TEMP = X( J )
437                  DO 130, I = N, J + 1, -1
438                     TEMP = TEMP - A( I, J )*X( I )
439  130             CONTINUE
440                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
441                  X( J ) = TEMP
442  140          CONTINUE
443            ELSE
444               KX = KX + ( N - 1 )*INCX
445               JX = KX
446               DO 160, J = N, 1, -1
447                  TEMP = X( JX )
448                  IX   = KX
449                  DO 150, I = N, J + 1, -1
450                     TEMP = TEMP - A( I, J )*X( IX )
451                     IX   = IX   - INCX
452  150             CONTINUE
453                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
454                  X( JX ) = TEMP
455                  JX      = JX   - INCX
456  160          CONTINUE
457            END IF
458         END IF
459      END IF
460
461   END SUBROUTINE DTRSV
462!---------------------------------------------------------
463   SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
464!!    .. Scalar Arguments ..
465!     DOUBLE PRECISION   ALPHA
466      REAL (kind=8) ::                 ALPHA
467      INTEGER            INCX, INCY, LDA, M, N
468!!    .. Array Arguments ..
469!     DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
470      REAL (kind=8) ::   A( LDA, * ), X( * ), Y( * )
471!!    ..
472
473!! Purpose
474!! =======
475
476!! DGER   performs the rank 1 operation
477
478!!    A := alpha*x*y' + A,
479
480!! where alpha is a scalar, x is an m element vector, y is an n element
481!! vector and A is an m by n matrix.
482
483!! Parameters
484!! ==========
485
486!! M      - INTEGER.
487!!          On entry, M specifies the number of rows of the matrix A.
488!!          M must be at least zero.
489!!          Unchanged on exit.
490
491!! N      - INTEGER.
492!!          On entry, N specifies the number of columns of the matrix A.
493!!          N must be at least zero.
494!!          Unchanged on exit.
495
496!! ALPHA  - DOUBLE PRECISION.
497!!          On entry, ALPHA specifies the scalar alpha.
498!!          Unchanged on exit.
499
500!! X      - DOUBLE PRECISION array of dimension at least
501!!          ( 1 + ( m - 1 )*abs( INCX ) ).
502!!          Before entry, the incremented array X must contain the m
503!!          element vector x.
504!!          Unchanged on exit.
505
506!! INCX   - INTEGER.
507!!          On entry, INCX specifies the increment for the elements of
508!!          X. INCX must not be zero.
509!!          Unchanged on exit.
510
511!! Y      - DOUBLE PRECISION array of dimension at least
512!!          ( 1 + ( n - 1 )*abs( INCY ) ).
513!!          Before entry, the incremented array Y must contain the n
514!!          element vector y.
515!!          Unchanged on exit.
516
517!! INCY   - INTEGER.
518!!          On entry, INCY specifies the increment for the elements of
519!!          Y. INCY must not be zero.
520!!          Unchanged on exit.
521
522!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
523!!          Before entry, the leading m by n part of the array A must
524!!          contain the matrix of coefficients. On exit, A is
525!!          overwritten by the updated matrix.
526
527!! LDA    - INTEGER.
528!!          On entry, LDA specifies the first dimension of A as declared
529!!          in the calling (sub) program. LDA must be at least
530!!          max( 1, m ).
531!!          Unchanged on exit.
532
533
534!! Level 2 Blas routine.
535
536!! -- Written on 22-October-1986.
537!!    Jack Dongarra, Argonne National Lab.
538!!    Jeremy Du Croz, Nag Central Office.
539!!    Sven Hammarling, Nag Central Office.
540!!    Richard Hanson, Sandia National Labs.
541
542
543!!    .. Parameters ..
544!     DOUBLE PRECISION   ZERO
545!     PARAMETER        ( ZERO = 0.0D+0 )
546      REAL (kind=8) ::                 ZERO
547      PARAMETER        ( ZERO = 0.0 )
548!!    .. Local Scalars ..
549!     DOUBLE PRECISION   TEMP
550      REAL (kind=8) ::                 TEMP
551      INTEGER            I, INFO, IX, J, JY, KX
552!!    .. External Subroutines ..
553      EXTERNAL           XERBLA
554!!    .. Intrinsic Functions ..
555      INTRINSIC          MAX
556!!    ..
557!!    .. Executable Statements ..
558
559!!    Test the input parameters.
560
561      INFO = 0
562      IF     ( M < 0 )THEN
563         INFO = 1
564      ELSE IF( N < 0 )THEN
565         INFO = 2
566      ELSE IF( INCX == 0 )THEN
567         INFO = 5
568      ELSE IF( INCY == 0 )THEN
569         INFO = 7
570      ELSE IF( LDA < MAX( 1, M ) )THEN
571         INFO = 9
572      END IF
573      IF( INFO /= 0 )THEN
574         CALL XERBLA( 'DGER  ', INFO )
575         RETURN
576      END IF
577
578!!    Quick return if possible.
579
580      IF( ( M == 0 ).OR.( N == 0 ).OR.( ALPHA == ZERO ) )   &
581         RETURN
582
583!!    Start the operations. In this version the elements of A are
584!!    accessed sequentially with one pass through A.
585
586      IF( INCY > 0 )THEN
587         JY = 1
588      ELSE
589         JY = 1 - ( N - 1 )*INCY
590      END IF
591      IF( INCX == 1 )THEN
592         DO 20, J = 1, N
593            IF( Y( JY ) /= ZERO )THEN
594               TEMP = ALPHA*Y( JY )
595               DO 10, I = 1, M
596                  A( I, J ) = A( I, J ) + X( I )*TEMP
597   10          CONTINUE
598            END IF
599            JY = JY + INCY
600   20    CONTINUE
601      ELSE
602         IF( INCX > 0 )THEN
603            KX = 1
604         ELSE
605            KX = 1 - ( M - 1 )*INCX
606         END IF
607         DO 40, J = 1, N
608            IF( Y( JY ) /= ZERO )THEN
609               TEMP = ALPHA*Y( JY )
610               IX   = KX
611               DO 30, I = 1, M
612                  A( I, J ) = A( I, J ) + X( IX )*TEMP
613                  IX        = IX        + INCX
614   30          CONTINUE
615            END IF
616            JY = JY + INCY
617   40    CONTINUE
618      END IF
619
620   END SUBROUTINE DGER
621!---------------------------------------------------------
622   SUBROUTINE XERBLA ( SRNAME, INFO )
623!!    ..    Scalar Arguments ..
624      INTEGER            INFO
625      CHARACTER (len=6) ::    SRNAME
626!!    ..
627
628!! Purpose
629!! =======
630
631!! XERBLA  is an error handler for the Level 2 BLAS routines.
632
633!! It is called by the Level 2 BLAS routines if an input parameter is
634!! invalid.
635
636!! Installers should consider modifying the STOP statement in order to
637!! call system-specific exception-handling facilities.
638
639!! Parameters
640!! ==========
641
642!! SRNAME - CHARACTER*6.
643!!          On entry, SRNAME specifies the name of the routine which
644!!          called XERBLA.
645
646!! INFO   - INTEGER.
647!!          On entry, INFO specifies the position of the invalid
648!!          parameter in the parameter-list of the calling routine.
649
650
651!! Auxiliary routine for Level 2 Blas.
652
653!! Written on 20-July-1986.
654
655!!    .. Executable Statements ..
656
657      WRITE (*,99999) SRNAME, INFO
658
659      STOP
660
66199999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,   &
662               ' had an illegal value' )
663
664   END SUBROUTINE XERBLA
665!-----------------------------------------------------------
666   FUNCTION lsame( c1, c2 )
667      logical lsame
668      CHARACTER (len=*), INTENT(in) ::   c1, c2
669      IF( c1 == c2 ) THEN
670          lsame=.TRUE.
671      ELSE
672          lsame=.FALSE.
673      ENDIF
674   END FUNCTION lsame
Note: See TracBrowser for help on using the repository browser.