text:
     ZMP is a communications/file transfer program for CP/M which
performs  Xmodem,  Xmodem-1k  (often erroneously called  Ymodem),
true Ymodem and Zmodem file transfer protocols.

     This   library  contains  an  un-installed  ZMP.COM  (called
ZMPX.COM)   and  five  .OVR files.  There is  also a file  called
ZMP-OVL.UPD  which describes the changes which need to be made to
the user-written overlay to allow it to operate with this version
of ZMP. YOU need to read this one!!

     Details of changes made to this version are in the ZMPxx.NEW
file.

ext: for


!*==claein.f90  processed by SPAG 7.51RB at 20:08 on  3 Mar 2022
!> \brief \b CLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration.
!
!  =========== DOCUMENTATION ===========
!
! Online html documentation available at
!            http://www.netlib.org/lapack/explore-html/
!
!> \htmlonly
!> Download CLAEIN + dependencies
!>
!> [TGZ]
!>
!> [ZIP]
!>
!> [TXT]
!> \endhtmlonly
!
!  Definition:
!  ===========
!
!       SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK,
!                          EPS3, SMLNUM, INFO )
!
!       .. Scalar Arguments ..
!       LOGICAL            NOINIT, RIGHTV
!       INTEGER            INFO, LDB, LDH, N
!       REAL               EPS3, SMLNUM
!       COMPLEX            W
!       ..
!       .. Array Arguments ..
!       REAL               RWORK( * )
!       COMPLEX            B( LDB, * ), H( LDH, * ), V( * )
!       ..
!
!
!> \par Purpose:
!  =============
!>
!> \verbatim
!>
!> CLAEIN uses inverse iteration to find a right or left eigenvector
!> corresponding to the eigenvalue W of a complex upper Hessenberg
!> matrix H.
!> \endverbatim
!
!  Arguments:
!  ==========
!
!> \param[in] RIGHTV
!> \verbatim
!>          RIGHTV is LOGICAL
!>          = .TRUE. : compute right eigenvector;
!>          = .FALSE.: compute left eigenvector.
!> \endverbatim
!>
!> \param[in] NOINIT
!> \verbatim
!>          NOINIT is LOGICAL
!>          = .TRUE. : no initial vector supplied in V
!>          = .FALSE.: initial vector supplied in V.
!> \endverbatim
!>
!> \param[in] N
!> \verbatim
!>          N is INTEGER
!>          The order of the matrix H.  N >= 0.
!> \endverbatim
!>
!> \param[in] H
!> \verbatim
!>          H is COMPLEX array, dimension (LDH,N)
!>          The upper Hessenberg matrix H.
!> \endverbatim
!>
!> \param[in] LDH
!> \verbatim
!>          LDH is INTEGER
!>          The leading dimension of the array H.  LDH >= max(1,N).
!> \endverbatim
!>
!> \param[in] W
!> \verbatim
!>          W is COMPLEX
!>          The eigenvalue of H whose corresponding right or left
!>          eigenvector is to be computed.
!> \endverbatim
!>
!> \param[in,out] V
!> \verbatim
!>          V is COMPLEX array, dimension (N)
!>          On entry, if NOINIT = .FALSE., V must contain a starting
!>          vector for inverse iteration; otherwise V need not be set.
!>          On exit, V contains the computed eigenvector, normalized so
!>          that the component of largest magnitude has magnitude 1; here
!>          the magnitude of a complex number (x,y) is taken to be
!>          |x| + |y|.
!> \endverbatim
!>
!> \param[out] B
!> \verbatim
!>          B is COMPLEX array, dimension (LDB,N)
!> \endverbatim
!>
!> \param[in] LDB
!> \verbatim
!>          LDB is INTEGER
!>          The leading dimension of the array B.  LDB >= max(1,N).
!> \endverbatim
!>
!> \param[out] RWORK
!> \verbatim
!>          RWORK is REAL array, dimension (N)
!> \endverbatim
!>
!> \param[in] EPS3
!> \verbatim
!>          EPS3 is REAL
!>          A small machine-dependent value which is used to perturb
!>          close eigenvalues, and to replace zero pivots.
!> \endverbatim
!>
!> \param[in] SMLNUM
!> \verbatim
!>          SMLNUM is REAL
!>          A machine-dependent value close to the underflow threshold.
!> \endverbatim
!>
!> \param[out] INFO
!> \verbatim
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          = 1:  inverse iteration did not converge; V is set to the
!>                last iterate.
!> \endverbatim
!
!  Authors:
!  ========
!
!> \author Univ. of Tennessee
!> \author Univ. of California Berkeley
!> \author Univ. of Colorado Denver
!> \author NAG Ltd.
!
!> \date December 2016
!
!> \ingroup complexOTHERauxiliary
!
!  =====================================================================
      SUBROUTINE CLAEIN(Rightv,Noinit,N,H,Ldh,W,V,B,Ldb,Rwork,Eps3,     &
     &                  Smlnum,Info)
      IMPLICIT NONE
!*--CLAEIN153
!
!  -- LAPACK auxiliary routine (version 3.7.0) --
!  -- LAPACK is a software package provided by Univ. of Tennessee,    --
!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
!     December 2016
!
!     .. Scalar Arguments ..
      LOGICAL Noinit , Rightv
      INTEGER Info , Ldb , Ldh , N
      REAL Eps3 , Smlnum
      COMPLEX W
!     ..
!     .. Array Arguments ..
      REAL Rwork(*)
      COMPLEX B(Ldb,*) , H(Ldh,*) , V(*)
!     ..
!
!  =====================================================================
!
!     .. Parameters ..
      REAL ONE , TENTH
      PARAMETER (ONE=1.0E+0,TENTH=1.0E-1)
      COMPLEX ZERO
      PARAMETER (ZERO=(0.0E+0,0.0E+0))
!     ..
!     .. Local Scalars ..
      CHARACTER normin , trans
      INTEGER i , ierr , its , j
      REAL growto , nrmsml , rootn , rtemp , scale , vnorm
      COMPLEX cdum , ei , ej , temp , x
!     ..
!     .. External Functions ..
      INTEGER ICAMAX
      REAL SCASUM , SCNRM2
      COMPLEX CLADIV
      EXTERNAL ICAMAX , SCASUM , SCNRM2 , CLADIV
!     ..
!     .. External Subroutines ..
      EXTERNAL CLATRS , CSSCAL
!     ..
!     .. Intrinsic Functions ..
      INTRINSIC ABS , AIMAG , MAX , REAL , SQRT
!     ..
!     .. Statement Functions ..
      REAL CABS1
!     ..
!     .. Statement Function definitions ..
      CABS1(cdum) = ABS(REAL(cdum)) + ABS(AIMAG(cdum))
!     ..
!     .. Executable Statements ..
!
      Info = 0
!
!     GROWTO is the threshold used in the acceptance test for an
!     eigenvector.
!
      rootn = SQRT(REAL(N))
      growto = TENTH/rootn
      nrmsml = MAX(ONE,Eps3*rootn)*Smlnum
!
!     Form B = H - W*I (except that the subdiagonal elements are not
!     stored).
!
      DO j = 1 , N
         DO i = 1 , j - 1
            B(i,j) = H(i,j)
         ENDDO
         B(j,j) = H(j,j) - W
      ENDDO
!
      IF ( Noinit ) THEN
!
!        Initialize V.
!
         DO i = 1 , N
            V(i) = Eps3
         ENDDO
      ELSE
!
!        Scale supplied initial vector.
!
         vnorm = SCNRM2(N,V,1)
         CALL CSSCAL(N,(Eps3*rootn)/MAX(vnorm,nrmsml),V,1)
      ENDIF
!
      IF ( Rightv ) THEN
!
!        LU decomposition with partial pivoting of B, replacing zero
!        pivots by EPS3.
!
         DO i = 1 , N - 1
            ei = H(i+1,i)
            IF ( CABS1(B(i,i))<CABS1(ei) ) THEN
!
!              Interchange rows and eliminate.
!
               x = CLADIV(B(i,i),ei)
               B(i,i) = ei
               DO j = i + 1 , N
                  temp = B(i+1,j)
                  B(i+1,j) = B(i,j) - x*temp
                  B(i,j) = temp
               ENDDO
            ELSE
!
!              Eliminate without interchange.
!
               IF ( B(i,i)==ZERO ) B(i,i) = Eps3
               x = CLADIV(ei,B(i,i))
               IF ( x/=ZERO ) THEN
                  DO j = i + 1 , N
                     B(i+1,j) = B(i+1,j) - x*B(i,j)
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         IF ( B(N,N)==ZERO ) B(N,N) = Eps3
!
         trans = 'N'
!
      ELSE
!
!        UL decomposition with partial pivoting of B, replacing zero
!        pivots by EPS3.
!
         DO j = N , 2 , -1
            ej = H(j,j-1)
            IF ( CABS1(B(j,j))<CABS1(ej) ) THEN
!
!              Interchange columns and eliminate.
!
               x = CLADIV(B(j,j),ej)
               B(j,j) = ej
               DO i = 1 , j - 1
                  temp = B(i,j-1)
                  B(i,j-1) = B(i,j) - x*temp
                  B(i,j) = temp
               ENDDO
            ELSE
!
!              Eliminate without interchange.
!
               IF ( B(j,j)==ZERO ) B(j,j) = Eps3
               x = CLADIV(ej,B(j,j))
               IF ( x/=ZERO ) THEN
                  DO i = 1 , j - 1
                     B(i,j-1) = B(i,j-1) - x*B(i,j)
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         IF ( B(1,1)==ZERO ) B(1,1) = Eps3
!
         trans = 'C'
!
      ENDIF
!
      normin = 'N'
      DO its = 1 , N
!
!        Solve U*x = scale*v for a right eigenvector
!          or U**H *x = scale*v for a left eigenvector,
!        overwriting x on v.
!
         CALL CLATRS('Upper',trans,'Nonunit',normin,N,B,Ldb,V,scale,    &
     &               Rwork,ierr)
         normin = 'Y'
!
!        Test for sufficient growth in the norm of v.
!
         vnorm = SCASUM(N,V,1)
         IF ( vnorm>=growto*scale ) GOTO 100
!
!        Choose new orthogonal starting vector and try again.
!
         rtemp = Eps3/(rootn+ONE)
         V(1) = Eps3
         DO i = 2 , N
            V(i) = rtemp
         ENDDO
         V(N-its+1) = V(N-its+1) - Eps3*rootn
      ENDDO
!
!     Failure to find eigenvector in N iterations.
!
      Info = 1
!
!
!     Normalize eigenvector.
!
 100  i = ICAMAX(N,V,1)
      CALL CSSCAL(N,ONE/CABS1(V(i)),V,1)
!
!
!     End of CLAEIN
!
      END SUBROUTINE CLAEIN


text:
*> \brief \b ZLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix.
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLARZ + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
*  Definition:
*  ===========
*
*       SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
*
*       .. Scalar Arguments ..
*       CHARACTER          SIDE
*       INTEGER            INCV, L, LDC, M, N
*       COMPLEX*16         TAU
*       ..
*       .. Array Arguments ..
*       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> ZLARZ applies a complex elementary reflector H to a complex
*> M-by-N matrix C, from either the left or the right. H is represented
*> in the form
*>
*>       H = I - tau * v * v**H
*>
*> where tau is a complex scalar and v is a complex vector.
*>
*> If tau = 0, then H is taken to be the unit matrix.
*>
*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
*> tau.
*>
*> H is a product of k elementary reflectors as returned by ZTZRZF.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] SIDE
*> \verbatim
*>          SIDE is CHARACTER*1
*>          = 'L': form  H * C
*>          = 'R': form  C * H
*> \endverbatim
*>
*> \param[in] M
*> \verbatim
*>          M is INTEGER
*>          The number of rows of the matrix C.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The number of columns of the matrix C.
*> \endverbatim
*>
*> \param[in] L
*> \verbatim
*>          L is INTEGER
*>          The number of entries of the vector V containing
*>          the meaningful part of the Householder vectors.
*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
*> \endverbatim
*>
*> \param[in] V
*> \verbatim
*>          V is COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
*>          The vector v in the representation of H as returned by
*>          ZTZRZF. V is not used if TAU = 0.
*> \endverbatim
*>
*> \param[in] INCV
*> \verbatim
*>          INCV is INTEGER
*>          The increment between elements of v. INCV <> 0.
*> \endverbatim
*>
*> \param[in] TAU
*> \verbatim
*>          TAU is COMPLEX*16
*>          The value tau in the representation of H.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
*>          C is COMPLEX*16 array, dimension (LDC,N)
*>          On entry, the M-by-N matrix C.
*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
*>          or C * H if SIDE = 'R'.
*> \endverbatim
*>
*> \param[in] LDC
*> \verbatim
*>          LDC is INTEGER
*>          The leading dimension of the array C. LDC >= max(1,M).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is COMPLEX*16 array, dimension
*>                         (N) if SIDE = 'L'
*>                      or (M) if SIDE = 'R'
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date September 2012
*
*> \ingroup complex16OTHERcomputational
*
*> \par Contributors:
*  ==================
*>
*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
*
*> \par Further Details:
*  =====================
*>
*> \verbatim
*> \endverbatim
*>
*  =====================================================================
      SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
*
*  -- LAPACK computational routine (version 3.4.2) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     September 2012
*
*     .. Scalar Arguments ..
      CHARACTER          SIDE
      INTEGER            INCV, L, LDC, M, N
      COMPLEX*16         TAU
*     ..
*     .. Array Arguments ..
      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX*16         ONE, ZERO
      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
*     ..
*     .. External Subroutines ..
      EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     ..
*     .. Executable Statements ..
*
      IF( LSAME( SIDE, 'L' ) ) THEN
*
*        Form  H * C
*
         IF( TAU.NE.ZERO ) THEN
*
*           w( 1:n ) = conjg( C( 1, 1:n ) )
*
            CALL ZCOPY( N, C, LDC, WORK, 1 )
            CALL ZLACGV( N, WORK, 1 )
*
*           w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )**H * v( 1:l ) )
*
            CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
     $                  LDC, V, INCV, ONE, WORK, 1 )
            CALL ZLACGV( N, WORK, 1 )
*
*           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
*
            CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
*
*           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
*                               tau * v( 1:l ) * w( 1:n )**H
*
            CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
     $                  LDC )
         END IF
*
      ELSE
*
*        Form  C * H
*
         IF( TAU.NE.ZERO ) THEN
*
*           w( 1:m ) = C( 1:m, 1 )
*
            CALL ZCOPY( M, C, 1, WORK, 1 )
*
*           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
*
            CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
     $                  V, INCV, ONE, WORK, 1 )
*
*           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
*
            CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
*
*           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
*                               tau * w( 1:m ) * v( 1:l )**H
*
            CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
     $                  LDC )
*
         END IF
*
      END IF
*
      RETURN
*
*     End of ZLARZ
*
      END

ext: f

max_stars_repo_name: cooparation/caffe-android

max_issues_repo_name: WatsonZhouAnda/Cheetah-Software

max_forks_repo_name: WatsonZhouAnda/Cheetah-Software


text:
void main() {
  int prec = 4;
  gl_FragColor = vec4(round(gl_Color.r * prec) / prec, round(gl_Color.g * prec) / prec, round(gl_Color.b * prec) / prec, gl_Color.a);
}


text:
! THIS VERSION: GALAHAD 2.1 - 22/03/2007 AT 09:00 GMT.

!-*-*-*-*-*-*-*-*-  G A L A H A D   R U N Q P C _ S I F  *-*-*-*-*-*-*-*-*-*-

!  Copyright reserved, Gould/Orban/Toint, for GALAHAD productions
!  Principal authors: Nick Gould and Dominique Orban

!  History -
!   originally released pre GALAHAD Version 1.0. October 17th 1997
!   update released with GALAHAD Version 2.0. August 11th 2005

!  For full documentation, see
!   http://galahad.rl.ac.uk/galahad-www/specs.html

   PROGRAM RUNQPB_SIF

!    ----------------------------------------------------------
!    | Main program for the SIF/CUTEr interface to QPB,       |
!    | an interior-point algorithm for quadratic programming  |
!    ----------------------------------------------------------

   USE GALAHAD_USEQPB_double

!  Problem input characteristics

   INTEGER, PARAMETER :: input = 55
   CHARACTER ( LEN = 16 ) :: prbdat = 'OUTSDIF.d'

!  Open the data input file

   OPEN( input, FILE = prbdat, FORM = 'FORMATTED', STATUS = 'OLD'  )
   REWIND input

!  Call the CUTEr interface

   CALL USE_QPB( input )

!  Close the data input file

   CLOSE( input  )
   STOP

!  End of RUNQPB_SIF

   END PROGRAM RUNQPB_SIF

max_forks_repo_name: dynamics-of-stellar-systems/dynamite


text:
      COMPLEX*16 FUNCTION JINTEG(M12,M22,P2)
*-------------------------------------------
      IMPLICIT NONE!
*-------------------
      REAL*8 P2,DABS
      COMPLEX*16 M12,M22,SQR,P2P,P2M,X1,X2,OMX1,OMX2,F1
      COMPLEX*16 LOG,SQRT,DCMPLX,XSPENZ
*-
      IF((DREAL(M12).EQ.DREAL(M22)).AND.DREAL(M12).LT.1d-6) THEN
       JINTEG=-1D0/2*LOG(P2**2/M12/M22)
       RETURN
      ENDIF
*-
      SQR=SQRT(P2**2+2D0*P2*(M12+M22)+(M12-M22)**2)
      P2P=P2-M12+M22+SQR
      P2M=P2-M12+M22-SQR
      IF(DABS(DREAL(P2P)).GE.DABS(DREAL(P2M))) THEN
        X1=P2P/2D0/P2
        X2=-2D0*M12/P2P
      ELSE
        X2=P2M/2D0/P2
        X1=-2D0*M12/P2M
      ENDIF
      P2P=P2+M12-M22+SQR
      P2M=P2+M12-M22-SQR
      IF(DABS(DREAL(P2P)).GE.DABS(DREAL(P2M))) THEN
        OMX2=P2P/2D0/P2
        OMX1=-2D0*M22/P2P
      ELSE
        OMX1=P2M/2D0/P2
        OMX2=-2D0*M22/P2M
      ENDIF
*-
      JINTEG=1d0/2*(LOG(OMX2/(-X2))-LOG(OMX1/(-X1)))
*-
      RETURN
      END


text:
Nikos Menicou, DDS practices general dentistry, the office is known as Twin Pines Dental. Dr. Mandeep Randhawa is his associate.

To explore other dentists in the Davis area, please visit our Dentists page.

20061213 22:59:26 nbsp I saw this dentist for the first time back in April. He did a great job, was friendly, and backed up his work. I had a small filling that was needed and he did it then and there, even fixing another old filling in the process. My only complaint is that when he numbed me, I was told it would be aboud 2 hours, but it took 34 hours to regain feeling in my cheek and tongue. Oh well, beats feeling someone drill a hole into my tooth. In short, Im sad my new insurance does not cover him and I must again find someone new...... Users/KaitlinSufit

20070110 14:54:55 nbsp He hit on me and tried to get me to go to lunch with him. Totally inappropriate. Im like 20 years younger!! Users/SoCalGal

20070110 19:36:40 nbsp Nearly every dentist Ive been to in Yolo County with the exception of Dr Nik has wanted to do unneccesary work. I was in an out quick, and even invited out to lunch at a later date to give my filling a test drive. Awesome place and great staff.  Users/ChrisThompson

20070223 13:13:07 nbsp It was a good envirnoment and the people were friendly, but they never actually used a scraper or water thing to get the plaque of my teeth.  I havent been to the dentist in over a year and my last one always spent like 1020 minutes doing this.  When i went i sat down, they took a bunch of xrays, did the polish and then the dentist came in for like 30 seconds to say my teeth look OK.  Based on this experience i might try to find another dentist in Davis. Users/BobKays

20070622 13:26:42 nbsp I would recommend Dr. Menicou. Everyone was very friendly, and my teeth were scraped surprisingly quickly. They recommended whitening to me, but there was no pressure when I said I couldnt afford it. The hygienist also caught a few things my previous dentist (who had had been seeing since I was a child) had missed, such as the fact that Ive been grinding my teeth and should really get a mouth guard if I dont want to end up with a bunch of cracked teeth and root canals.  Users/AnnaJones

20070728 20:44:28 nbsp I had a great expirence here.  I have not been to the dentist for a few years and he and his staff made me feel comfortable and welcome.  His staff was very professional and I would highly recommend him to anyone.    Users/fire12

20070815 20:16:56 nbsp  have seen this dentist after having a bad experience with dr storm. He made everything better and was so nice to talk to and worked quickly. Also his staff is super friendly. I am not the easiest person to take xrays because of my high gag reflex ,but the assistants here make you comfortable and feel like you are not even at the dentist office. All the xrays are now digitial making it much faster to get a reading from the doctor about your teeth. My recent visit I had the opportunity to see the disney room which is being build for the children that come into the dentist. How many disney movie characters can you find? Anyway the great thing is this was a great experience and they are good about sending reminders for future appointments ,but not annoying and do not pressure any kind of services. UCD students: this is a Delta Dentist to go to if you have SHIP insurance!1 Users/ElizabethBarthel

20080208 20:47:09 nbsp Dr. Menicou was a wonderful dentist. He made me feel very at ease, having had horrible experiences in the past  he reminded me a lot of a walking, talking Mel Brooks movie. He did two fillings in under 20 minutes without pain and explaining every bit of the procedure to a nervous wreck like me  it was awesome. Definitely would reccommend him and Im going back for my cleaning when I can. Users/SamanthaA

20080806 13:49:18 nbsp Thank you wiki users!  I tried contacting his office last year and basically got turned off by the person answering the phone not seeming to care, and the huge wait for a visit.  Now I realize I probably made my decision too hastily (based on so many nice reviews) and might try going back to him. Users/carnitasPorFavor

20080923 16:39:14 nbsp Alright, back again after getting my teeth cleaned  this is definitely the best dentist Ive ever had. No unnecessary procedures, the staff are very caring  they work around your schedule and help you as much as they can. I absolutely recommend Dr. Menicou and his office to everyone.  Users/SamanthaA

20081210 18:25:46 nbsp After reading comments, I went to Dr. Menicou for a checkup and cleaning. I had three cavities (not abnormal for me and I hadnt been to a dentist in over a year). He even showed me the xrays so I knew he wasnt ripping me off or anything (I have read about this happening elsewhere on DavisWiki). He was great at making sure the filling was perfect and made sure I had plenty of local anesthetic. The whole office is very friendly and accommodating. Ive been there three times and will definitely be going back at my next 6 month checkup! Users/ArielleWeiler

20090116 08:37:12 nbsp I highly recommend Dr. Menicou, Ive been very happy with his work, and have been a patient of his for ~34 years now.  He won my loyalty when he spent 23 visits adjusting my bite after a filling free of charge, despite the fact that the problem wasnt the tooth hed filled, but rather one another dentist had put in a couple of years earlier which hadnt been adjusted quite right.  Hes the secondbest dentist Ive ever had, and the only reason hes not the best one is that I grew up in a small town and knew my dentist there socially as well as professionally, so that was a closer relationship.  Ive recommended Dr. Menicou to at least one friend in Davis who was having troubles with his dentist, and I was thanked later for teh recomendation because the friend also really liked Dr. Menicous work. Users/BrianWilliams

20090213 16:47:26 nbsp I dont feel good about this dental office. I was assigned by my insurance company to see this dentist. But when I called to make an appointment, they said they couldt accept me because they had some problem with the insurance company. If they dont like the company, why dont they just contact the company to solve the problem instead of trying to shut the door to patients who have already been assigned to them? Users/coco

20090315 01:59:49 nbsp Nikos Menicou is doing a disservice to his patients, and cheating the insurance companies.  He will polish your teeth and call it a cleaning.  A thorough cleaning should include scaling as well as inspection of the gums and measurement of your pockets.  I was very disappointed when I went to see him based on the glowing reviews on this page and discovered that he barely glanced in my mouth and had a hygenist do a polish, then recommended a 4 quad cleaning (root planing).  This is an expensive procedure (that my insurance covered, so he figured I would go along with it)  Yes, he has a nice digital xray maching, but that is because he is quick, slick, and interested in maximizing profits at the expense of quality time and care of his patients.  I went to Kristina Wiley in Dixon for a second opinion  and she was shocked at the recommendation.  She did a thorough cleaning and pronounced my teeth and gums healthy, and absolutely not in need of further treatment.  Nikos Menicou was also overly friendly in an unprofessional manner.  Go elsewhere.   Users/turtlek75

20090316 16:17:50 nbsp Dr. Menicou and his associate Dr. Bautista are both excellent dentists!  My husband and I both have dental phobias stemming from poor experience as children; additionally, my husband was without insurance for twelve years, so by the time wild horses dragged us back into the chair we were both in bad shape.  Doctor Nik is very funny and his cheery demeanor puts me at ease.  The hygenists are skilled and friendly.  Dr. Menicou works fast and efficiently, and his patter keeps me distracted from the work (except when I try to grin around the instruments!)  Dr. Bautista is very thorough and reassuring.  Doing so much work at once really taxed my familys checkbook, and the office staff was really good about helping us manage the payments.  Theyve also been awesome with my children  even though they ultimately recommended that we take the two youngest to a pediatric dentist, their main concerns were getting our kids the best treatment and making sure their dental experience was positive.  I just scheduled my second cleaning, and Im psyching up to start on a second root canal... and I feel better about my teeth than I have in years.  I would recommend Dr. Menicou and his office to anyone. Users/ErinBlackman

20090325 13:25:36 nbsp I have never actually seen Dr. Menicou but I have seen Dr. Batista. I would not recommend this place to ANYBODY. I had to switch insurance and out of all the places that I could pick from to go to, this seemed like a good place. I had seen my old dentist not too long before my first visit here and everything was fine, however when I got here all of a sudden I had 6 cavities that needed to be filled and one was a possible crown. Also, I watched him take about 20 minutes to look at my xrays at those 6 cavities he really looked like he was having a heck of a time seeing them I saw him highlight the screen to a negative color quite a few times as well. My red flag is WAY up on this place! I have never been un happy going to the dentist until I had to go here! Users/jo29

20090703 18:00:24 nbsp I first started seeing Dr. Menicou almost a year and a half ago. I have a severe dental phobia, it had been years since I last went to the dentist before seeing Dr. Menicou. He has done everything even through some difficult repairs to make me feel comfortable. He has been friendly and supportive even though I have been severely nervous. His staff is friendly and courteous. I still dont look forward to the dentist, but I will say that under Dr. Menicous care I feel comfortable and have been continuing to visit his service. He is not overly stiff, but for me his friendly demeanor allows me to relax a little in what can be a very stressful situation. He also cares greatly for his patients and really does want to make sure you are comfortable and taken care of in his office. I cannot thank or recommend him enough for how great he has been to me and my family. Users/AHBlackman

20090904 12:54:51 nbsp Stephanie was a champ. She is a professional hygienist who has done the deep cleaning on my teeth. She did a really great job. I rarely felt much pain both during and after the process, and my gum color now looks better :D (as if a brand new carshiny&crisp). Everyone at the office was friendly, although the down side was they didnt have enough water jet tools(no idea what its called??)for the patients at one point during my deep cleaning. So, the work had to be rushed on me :. Despite that incident, they were great and recommended. (Maybe they had many appointments this day, but its a good idea to provide their skillful employees with a complete set of tools.)     Users/superdavis

20100415 11:53:04 nbsp So far, Ive had great experiences here.  Ive only been seen by Dr. Bautista, who is awesome.  I appreciated being able to SEE my cavities in the xrays.  Even better, during the filling process, I was actually fully numb before the drilling started!  A comfortable atmosphere and very nice, skilled people.  Highly recommended!  users/MeghanSkaer

20100530 18:15:31 nbsp Rey (Bautista) is awesome! He and Heather (the assistant) have been working together to fix all the teeth I screwed up in college). They have been amazing, keeping me aware of the costs  even when it meant that they would have to send me to another dentist to get work done. Dr. Bautista gave me his cell phone #, I can text him and call him whenever I have pain in my mouth  he responds ASAP. Dr. Nick is awesome too. He cleans my parents teeth and he did a root cancal on me. Hes a trip  what a funny guy. Jo29  Rey sees everything  including things that another dentist I used to have missed  I would think it was a plus if he didnt find the six cavities. . Both dentists do everything they can to save us money  they dont recommend a bunch of crap like teeth bleaching or teeth/gam scaling and have saved our family probably thousands of dollars. Thanks guys  we recommend you to everybody.  Users/ElizabethKelly

20100718 09:08:02 nbsp Hi, For those of you who have a night guard fitted at this dentist, please Id be interested as to how it worked out and whether you were comfortable wearing at night. Who fitted it? Best regards, Tom. Users/tictac

20101024 13:26:46 nbsp Dr. Nick is absolutely THE. BEST. I moved to Roseville two years ago and still drive almost an hour back for my (extensive) dental appointments. Hes skillful, genuinely funny, and cares about getting the best work done. And I really mean skillful  he pulled out two wisdom teeth in less than five minutes apiece, negating a trip to the endodontist and getting anesthesia. The whole office is great and superfriendly (they all know me by name by now, haha), and focuses on getting your teeth fixed the best way that works for you. I wouldnt be comfortable going anywhere else. Users/Maren

20101209 12:31:48 nbsp I had a very unpleasant experience with this office. Although I had an examination that was covered fully by my insurance they charged me $50 for doctor fees. I had my insurance documentation with me and I showed them that what they did (a consult basically) was fully covered. They did reverse the charge (after telling me that i should read the small print) but I do not feel comfortable going there again.   Users/anamaria2

20110122 12:56:37 nbsp These guys are the absolute best! I had my wisdom teeth extracted, which took about 2 minutes per tooth, and there was very, very little pain. Dr. Nik called me in the evening to check on how I was doing and told me not to hesitate to call if I needed anything.
This is the second time they have been wonderful, the first time being when I had a crown put in.
I would recommend them to anyone! Thanks, guys! Users/Millie

20110804 11:26:58 nbsp Dr. Menicou is wonderful. Weve been seeing him for the past three years. Dr. Menicou is excellent at diagnosing and treating, and is much less painful (and also less expensive  a perk!) than our previous dentist. Plus, he and his staff are caring and considerate. Hes a doll with children, too. (My daughter is happy to go to her visits.) Even our orthodontist said Dr. Menicou is great. (Note: Dr. Battista is no longer with this office, and I wouldnt have recommended him, anyway.) Users/Chamoudah

20111027 22:00:35 nbsp I was incredibly displeased with Dr. Menicou. He clearly wants to do a good job and have a good reputation, but he did some really shoddy work on my teeth. Ive never had cavities, but when I switched to Menicou he told me I had cavities between my back molars. He removed the cavities but and put the filler in, my left side one day and my right side another. My molars continued to be painful, so I returned to him at which point he gave me Sensodyne to numb my nerves. Another few weeks past and the pain hadnt receded, so I went back a third time. He redid the fillers, acknowledging that there was too much contact between the molars, which was causing my pain.

Ive since moved out of Davis and have found a new dentist. She said the filling were of poor quality and would likely have to be redone. I could see on the xray where one filler had a sharp edge (from when Menicou fixed it) and another was flat where it should have been a peak. I still have trouble getting floss between the molars, which means that its hard to clean out bacteria.

So, I missed three days of work, was given local anesthesia three times, was in pain for a month, paid $300 out of pocket, and what do I have to show for it? Fillings that will likely be replaced soon.   Users/DannyMilks

20120719 19:08:16 nbsp I had a very similar experience as anamarie2.  I asked for a preauthorization for a mouth guard.  When they got my insurances approval, the admin told me that it was going to cost me $200 out of pocket. However, I also received a copy of the preauth and my portion of it was only $47.  When I brought that up, the admin went and got Dr. Menicou, who told me that he would never have agreed to the amount that my insurance company says he gets paid for the work.  But he is a contracted provider and did agree to the amount.  He told me that he would not honor my insurance and that I could either pay extra $100 or go to another dentist.  In the past Ive been suspicious of being pushed to purchase treatments that I did not need, but this sealed it.  I found it especially bad that they knowingly tried to overcharge me, then when I questioned it, the admin left the room and Dr. Menicou tried to tell my why I should pay more. Users/MikeCarr

20121030 21:35:06 nbsp When my insurance changed, I had to go to another dentist.  That practice told me I had a broken filling and recommended an expensive replacement that is not covered by insurance.  I was uncomfortable with the whole experience so I changed insurance carriers so I could go back to Dr. Menicou.  When he checked my teeth 6 months later, he confirmed what I suspected all along  no broken filling.  My teeth looked fine except for 20 year old fillings that we need to keep an eye on due to age.  But nothing urgent or expensive needed to be done.  I trust Dr. Menicou to give me an honest diagnosis and his staff is very friendly. Users/LauraShapiro

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


! { dg-do compile }

subroutine f1
!$omp declare reduction (.le.:integer:omp_out = omp_out + omp_in) ! { dg-error "Invalid operator for" }
end subroutine f1
subroutine f2
!$omp declare reduction (bar:real(kind=4):omp_out = omp_out + omp_in)
  real(kind=4) :: r
  integer :: i
  r = 0.0
!$omp parallel do reduction (bar:r)
  do i = 1, 10
    r = r + i
  end do
!$omp parallel do reduction (foo:r) ! { dg-error "foo not found" }
  do i = 1, 10
    r = r + i
  end do
!$omp parallel do reduction (.gt.:r) ! { dg-error "cannot be used as a defined operator" }
  do i = 1, 10
    r = r + i
  end do
end subroutine f2
subroutine f3
!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "Unclassifiable OpenMP directive" }
end subroutine f3
subroutine f4
!$omp declare reduction (foo:integer:a => null()) ! { dg-error "Invalid character in name" }
!$omp declare reduction (foo:integer:omp_out = omp_in + omp_out) &
!$omp & initializer(a => null()) ! { dg-error "Invalid character in name" }
end subroutine f4
subroutine f5
  integer :: a, b
!$omp declare reduction (foo:integer:a = b + 1) ! { dg-error "Variable other than OMP_OUT or OMP_IN used in combiner" }
!$omp declare reduction (bar:integer:omp_out = omp_out * omp_in) &
!$omp & initializer(b = a + 1) ! { dg-error "Variable other than OMP_PRIV or OMP_ORIG used in INITIALIZER clause" }
end subroutine f5
subroutine f6
!$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) &
!$omp & initializer(omp_orig=omp_priv)
end subroutine f6


text:
*=======================================================================
* File:    dlsoqp.f
* Author:  Alex Stivala, based on spsolqp.m by Prof. Yinyu Ye.
* Created: July 2008
*
* This is a reimplementation using FORTRAN-77 and LAPACK
* of spsolqp.m from Prof. Yinyu Ye
* http://www.stanford.edu/~yyye/matlab/spsolqp.m
*
* Note that the original MATLAB code uses MATLAB sparse matrix
* facilities, implemented in MATALB with the CHOLMOD routines
* from Tim Davis et al. LAPACK is for dense systems, this implementation
* uses just LAPACK so does not use sparseness (hence no 'sp' prefix
* on name, 'dl' is for 'dense LAPACK').
*
* $Id: dlsoqp.F 3240 2010-01-18 03:28:54Z alexs $
*=======================================================================

      subroutine solvqp(Q, ldq, A, lda, m, n,  b, c, x, y, info)
!      USE IFPORT
      implicit none
*
* solvqp - solve quadratic program in standard form
*
*  This program solves quadratic program in standard form:
*
*     minimize    0.5*(x'*Q*x)+c'*x
*     subject to  A*x=b, x>=0.
*
*     This program is the implementation of the interior ellipsoidal
*     trust region and barrier function algorithm with dual solution
*     updating technique in the standard QP form. Two phases are used:
*     the first uses DLPHS1 find an interior feasible point and the
*     second uses DLPHS2 to find a local optimal solution.
*
*  Technical Reference
*
*     Y. Ye, "An extension of Karmarkar's algorithm and the trust region
*     method for convex quadratic programming," in Progress in
*     Mathematical Programming (N. Megiddo ed.), Springer-Verlag, NY
*     (1989) 49-63.
*
*     Y. Ye, "On affine-scaling algorithms for nonconvex quadratic
*     programming," Math. Programming 56 (1992) 285-300.
*
* See also
*
*      Y. Ye.  Interior Point Algorithms: Theory and Analysis.
*      Wiley-Interscience 1997.
*
*  Comment: Each iteration we solve a linear KKT system like
*
*  ( Q+mu X^{-2}   A^T )(dx) = c'
*  (     A          0  )(dy) = 0
*
*  where X = diag(x)  which is a positive diagonal matrix.

*
*     .. Scalar Arguments ..
      integer            ldq,lda,m,n,info
*     ..
*     .. Array Arguments ..
      double precision   Q(ldq,*), A(lda,*), x(*), y(*), b(*), c(*)
*     ..
*

*
* Arguments
* =========
*
* Q      (input) DOUBLE PRECISION array, dimension (n, n)
*        the symmetric objective matrix
*
* ldq    (input) INTGER
*        leading dimension of Q. ldq >= n
*
* A      (input) DOUBLE PRECISION array, dimension (m, n)
*        the constraint left-hand matrix
*
* lda    (input) INTEGER
*        leading dimenion of A. lda >= m
*
* m      (input) INTEGER
*        number of rows in matrix A
*        m <= n
*
* n      (input) INTEGER
*        number of rows and columns in marix Q, also the
*        number of columns in matrix A
*
* b      (input) DOUBLE PRECISION vector, dimension(m)
*        constraint right-hand column vector
*
* c      (input) DOUBLE PRECISION vector, dimension(m)
*        objective column vector
*
* x      (output) DOUBLE PRECISION vector, dimension (n+1)
*        solution vector with objective value appended as last element
*
* y      (output) DOUBLE PRECISION vector, dimension (m)
*        optimal dual solution (Lagrangian multiplier)
*
* info   (output) INTEGER
*        on exit, status of the computation
*        =  0 : successful exit
*        = -1 : phase 1 failed
*        = -2 : sizes exceed maximum dimensions
*        = -3 : LAPACK DSYSV failed
*        = -4 : phase 2 failed
*        = -5 : max number of iterations exceeded
*        =  1 : no feasible point
*        =  2 : problem appears unbounded
*
*=======================================================================
*

*     .. Parameters ..

*     relative stopping tolerance: the objective value close to the
*     local optimum in the range of tolerance.
      double precision toler
      parameter (toler = 1.0d-5)

*     step size 0 < beta < 1
      double precision beta
      parameter (beta = 0.8d0)

*     largest values of array dimensions m and n allowed
      integer mmax,nmax
      parameter(mmax = 220, nmax = 4000)

*     limit on number of iterations
      integer maxiter
      parameter (maxiter = 1000)

*     -inf value (may be system dependent)
      double precision neginf
      parameter (neginf=-1.79769d+308)
*     ..
*     .. Local Scalars ..
      character trans,uplo
      integer i,j,incr,order,nrhs,iter,lde,ldf,ldxx,ldaa,ldewk,lwork
      double precision alpha,gap,ob,z,blasa,blasb,lambda,obvalue,
     $     nora,lower
*     ..
*     .. Local Arrays ..
      double precision avec(mmax),zhis(maxiter)
*     workspace arrays for DLPHS1
*     E, F (each column of F separately), dx, ipiv,v reused for DLPHS2
*     v,ipiv,E and F are also used as working storage in DLSOQP itself
      double precision dx(nmax),E(mmax+nmax, mmax+nmax),
     $     F(mmax+nmax, 2), work(mmax+nmax)
      integer ipiv(mmax+nmax)
      double precision  u(nmax+2), v(nmax+2),
     $     umzv(nmax+2), obz(nmax+2)
*     additional workspace arrays for DLPHS2
      double precision XX(nmax,nmax),AA(mmax,nmax),
     $     Ewk(mmax+nmax, mmax+nmax)
*     ..
*     .. Intrinsic Functions ..
      intrinsic min,abs,max,dsqrt,dble
#if defined(__INTEL_COMPILER) || defined(__PORTLAND_COMPILER)
      intrinsic RANDOM_NUMBER
#else
      intrinsic rand,srand
#endif
*     ..
*     .. External Subroutines and Functions ..
      external dlphs1,dlphs2,drecip,demvv
      double precision dvmin,dvmax
      external dvmin,dvmax
      external rand55
*     LAPACK subroutines
      external dsysv
*     BLAS level 1 subroutines/functions
      external dcopy,dscal,daxpy
      double precision ddot
      external ddot
*     BLAS level 2 subroutines
      external dgemv,dsymv
*     ..
*     .. Executable Statements ..
*

      if  (m .gt. mmax) then
         write(*,*) 'maximum dimensions exceeded, increase mmax'
         info = -2
         return
      endif
      if  (n .gt. nmax) then
         write(*,*) 'maximum dimensions exceeded, increase nmax'
         info = -2
         return
      endif

      lde = mmax+nmax
      ldf = mmax+nmax
      ldxx = nmax
      ldaa = mmax
      ldewk = mmax+nmax

*     length of work vector for DSYSV >= (nmax+mmax)*NB where NB is
*     optimal blocksize for DSYSTRF. NB we are using NB=1, this
*     was optimal on x86 Linux anyway.
      lwork = mmax+nmax

C      call srand(1)

* ----------------------------------------------------------------------
*
*     phase 1: try to find an interior feasible point
*
* ----------------------------------------------------------------------

      alpha = 0.95d0
      do 10 i = 1, n+1
         x(i) = 1.0d0
 10   continue
      ob = x(n+1)
      z = 0.0d0

*     avec = b - A*ones(n,1) (note using x as ones here)
      trans = 'N'
      blasa = -1.0d0
      blasb = 1.0d0
      incr = 1
      call dcopy(m, b, incr, avec, incr)
      call dgemv(trans, m, n, blasa, A, lda, x, incr, blasb,
     $     avec, incr)

      gap = ob - z
 500  if (gap .ge. toler) then
         call dlphs1(A, lda, m, n, avec, b, x, y, z, ob, alpha,
     $        dx, E, lde, F, ldf, ipiv, u, v, umzv, obz,
     $        work, lwork, info)
         if (info .ne. 0) then
            write(*,*) 'phase 1 failed'
            info = -1
            return
         endif

         ob = x(n+1)
         gap = ob - z
         if (z .gt. 0.0d0) then
            gap  = -1.0d0
            write(*,*) 'The system has no feasible solution.'
            info = 1
            return
         endif
         goto 500
      endif

* ----------------------------------------------------------------------
*
*     phase 2: search for an optimal solution
*
* ----------------------------------------------------------------------

*     only using first n elements of x from now on

*     always using increment of 1 in BLAS calls
      incr = 1

      alpha =  0.9d0

*     ==================================================================
*
*     Solve the linear system
*
*     E * comp = F where
*
*     E (m+n, m+n)  =    ( eye (n, n)   A' (n, m) )
*                        ( A  (m, n)    0  (m, m) )
*
*     F (m+n)       =    ( r (n, 1) )
*                        ( 0 (m, 1) )
*
*     where r is an n-vector of psuedorandom number uniformly
*     distributed in [0,1].
*
*     E is square, symmetric, and sparse.
*     It may be positive definite, which can efficiently be tested
*     for with Cholesky factorization, and solved by that means
*     more efficiently than the general case using LU decomposition.
*
*
*     ==================================================================

*      symmetric matrix so store only upper triangle and use DSYSV
*     (tried using packed format and DPPSV but that is slower)
      do 730 j = 1, n
         do 720 i = 1, n
            if (i .eq. j) then
               E(i,j) = 1.0d0
            else
               E(i,j) = 0.0d0
            endif
 720     continue
 730  continue
      do 760 j = 1,m
*        note using INCX=lda for A to get rows
         call dcopy(n, A(j, 1), lda, E(1, n+j), incr)
 760  continue
      do 790 j = n+1, n+m
         do 780 i = n+1, j
            E(i, j) = 0.0d0
 780     continue
 790  continue

*     use first column of F as RHS for linear system, also solution
      do 800 j = 1, n
#if defined(__INTEL_COMPILER) || defined(__PORTLAND_COMPILER)
         CALL RANDOM_NUMBER(F(j,1))
#else
         F(j,1) = dble(rand(0))
#endif
 800  continue
C      call rand55(n, F)
      do 810 j = n+1, n+m
         F(j, 1) = 0.0d0
 810  continue

C       write(*,888),( (E(i,j), j=1,m+n), i=1,m+n)
C  888  format (21(f8.4))
C       write(*,890),(F(i, 1), i = 1, m+n)
C  890  format(f8.4)

      order = m + n
      nrhs = 1
      uplo = 'U'
      call dsysv(uplo, order, nrhs, E, lde, ipiv, F, ldf,
     $           work, lwork, info)
      if (info .ne. 0) then
         info = -3
         return
      endif
*     nora = min(F(1:n,1)./x)
*     DSYSV solution is in F(:,1) and using F(:,2) as temp storage
      call dcopy(n, x, incr, F(1,2), incr)
      call drecip(n, F(1,2))
      call demvv(n, F, F(1,2))
      nora = dvmin(n, F(1,2))

      if (nora .le. 0.0d0) then
         nora = -0.01d0 / nora
      else
         nora = dvmax(n, F(1,2))
         if (nora .eq. 0.0d0) then
            write(*,*) 'The problem has a unique feasible point.'
            x(n+1) = ob
            info = 0
            return
         endif
         nora = 0.01d0 / nora
      endif
*     x = x + nora*F(1:n,1)
      call daxpy(n, nora, F, incr, x, incr)
*     obvalue = (x'*(Q*x))/2 + c'*x
      uplo = 'U'
      blasa = 1.0d0
      blasb = 0.0d0
*     blasb is zero so v can be uninitialized on entry to DSYMV
      call dsymv(uplo, n, blasa, Q, ldq, x, incr, blasb, v, incr)
      obvalue = ddot(n, x, incr, v, incr) / 2.0d0 +
     $          ddot(n, c, incr, x, incr)

      lower = neginf
      gap = 1.0d0
      lambda = max(1.0d0, abs(obvalue)/dsqrt(dsqrt(dble(n))))
      iter = 0
 900  if (gap .ge. toler) then
         iter = iter + 1
         if (iter .ge. maxiter) then
            write(*,*) 'Maximum number of iterations exceeded.'
            x(n+1) = ob
            info = -5
            return
         endif

         call dlphs2(Q, ldq, A, lda, m, n, c,
     $        alpha, beta, lambda, toler,
     $        obvalue, ob, x, y, E, lde, F(1,1), ldf, dx, F(1,2),
     $        XX, ldxx, AA, ldaa, ipiv,
     $        v, Ewk, ldewk, work, lwork, info)

         if (info .ne. 0) then
            write(*,*) 'phase 2 failed'
            info = -4
            return
         endif

C          write(*,910),iter,ob
C  910     format('iter = ',i5,' ob = ',f8.4)

         if (ob .eq. neginf) then
            gap = 0.0d0
            write(*,*) 'The problem is unbounded.'
            info = 2
            return
         else
*           F(1:n,1) = Q*x + c - A'*y
*           first compute F(1:n,1) = Q*x + c, then -A'*y + F(1:n,1)
            uplo = 'U'
            blasa = 1.0d0
            blasb = 1.0d0
            call dcopy(n, c, incr, F, incr)
            call dsymv(uplo, n, blasa, Q, ldq, x, incr, blasb, F, incr)
            trans = 'T'
            blasa = -1.0d0
            blasb = 1.0d0
            call dgemv(trans, m, n, blasa, A, lda, y, incr, blasb,
     $           F, incr)

            if (dvmin(n, F) .ge. 0) then
               zhis(iter+1) = ob - ddot(n, x, incr, F, incr)
               lower = zhis(iter+1)
               gap = (ob-lower)/(1.0d0+abs(ob))
               obvalue = ob
            else
               zhis(iter+1) = zhis(iter)
               lower = zhis(iter+1)
               gap = (obvalue - ob) / (1.0d0 + abs(ob))
               obvalue = ob
            endif
         endif
         goto 900
*     end of while (gap .ge. toler) loop
*     a (local) optimal solution has been found
      endif

*     end of DLSOQP
      x(n+1) = ob
      info = 0
      return
      end

max_stars_repo_name: stivalaa/qptabsearch

max_issues_repo_name: stivalaa/qptabsearch

max_forks_repo_name: stivalaa/qptabsearch


text:
      program t
      implicit none
C open stmt read/write from scratch w/rewind
      character*18::answer
      integer::a
      integer::k

      open (unit=95, status='scratch')
      do k=1,3
         write (95, '(i2)') k
      end do

      rewind (95)

      do k=1,3
         read (95, '(i2)') a
         print *,a
      enddo

      endprogram t

max_stars_repo_name: maddenp/ppp

max_issues_repo_name: maddenp/ppp

max_forks_repo_name: maddenp/ppp


!---------------------------------------------------------------------!
    function colnum_f(unit,col_name_temp,status)
! PURPOSE: Get column number with a paricular name col_name_temp
!   This code check if there more than one column with a similar name and warns the user
      implicit none
      integer :: unit,status,colnum_f
      logical :: casesen,logic
      character (len=30) col_name_temp,col_name,error_description

      casesen = .false. !not case sensitive (if yes, it is)
      call ftgcnn(unit,casesen,col_name_temp,col_name,colnum_f,status)
      call ftgerr(status,error_description)
      do while(status .ne. 0)
         if (status .eq. 219) then
            call ftgerr(status,error_description)
            write(*,'(A,A,A,A)') '!! ATTENTION !! ', trim(error_description) ,': ', col_name_temp
            write(*,*) "   Change the name of the column (type no to avoid)"
            read(*,*)  col_name_temp
            if (col_name_temp .eq. 'no') then
               write(*,*) '   Column avoided'
               colnum_f = -1
               logic = .true.
               goto 11
            else
               logic = .false.
               status = 0
            endif
         else
            write(*,*) '!! ATTENTION !! ', error_description
            write(*,'(A,A8,A)') '   Do you want to use column: ', col_name,'? (T for yes - F for the next one)'
            read(*,*) logic
         endif

11       continue

         if (logic) then
            status = 0
         else
            call ftgcnn(unit,casesen,col_name_temp,col_name,colnum_f,status)
         end if

      enddo
    end function colnum_f
!---------------------------------------------------------------------!


text:
subroutine smc()

  use advance_module
  use chemistry_module
  use derivative_stencil_module
  use initialize_module
  use layout_module
  use make_plotfile_module
  use multifab_module
  use omp_module
  use probin_module
  use runtime_init_module
  use smcdata_module
  use time_module
  use variables_module

  implicit none

  integer :: init_step, istep, ioproc

  real(dp_t) :: dt, courno
  real(dp_t)  , pointer     :: dx(:)

  real(dp_t) :: wt1, wt2, wt_advance, wt_fb, wt_c2p, wt_c, wt_t, wt_hd
  real(dp_t) :: write_pf_time
  type(layout)   :: la
  type(multifab) :: U

  integer :: last_plt_written
  character(len=5)               :: plot_index
  character(len=6)               :: plot_index6
  character(len=256)             :: plot_file_name
  character(len=20), allocatable :: plot_names(:)

  type(bl_prof_timer), save :: bpt_advance

  last_plt_written = -1

  call runtime_init()

  call stencil_init()

  call chemistry_init()

  call init_variables()
  call init_plot_variables()

  allocate(plot_names(n_plot_comps))
  call get_plot_names(plot_names)

  call initialize_from_scratch(la,dt,courno,dx,U)

  call build_smcdata(la)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! print processor and grid info
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  if (parallel_IOProcessor()) then
     print *, ' '
     print *, 'number of MPI processes = ', parallel_nprocs()
     print *, 'number of threads       = ', omp_get_max_threads()
     print *, ' '
     print *, 'number of boxes         = ', nboxes(la)
     print *, ' '
  end if

  istep = 0

  if (plot_int > 0) then
     write(unit=plot_index,fmt='(i5.5)') istep
     plot_file_name = trim(plot_base_name) // plot_index

     call make_plotfile(plot_file_name,la,U,plot_names,time,dx,write_pf_time)

!     call write_job_info(plot_file_name, la, write_pf_time)

     last_plt_written = istep
  end if

  init_step = 1

  if ( parallel_IOProcessor()) then
     print*,""
     print*,"BEGIN MAIN EVOLUTION LOOP"
     print*,""
  end if

  wt1 = parallel_wtime()

  if ( (max_step >= init_step) .and. (time < stop_time .or. stop_time < 0.d0) ) then

     do istep = init_step, max_step

        if (parallel_IOProcessor()) then
           print*,'Advancing time step',istep,'time = ',time
           print*, ""
        end if

        call build(bpt_advance, "advance")     !! vvvvvvvvvvvvvvvvvvvvvvv timer
        call advance(U,dt,courno,dx,istep)
        call destroy(bpt_advance)              !! ^^^^^^^^^^^^^^^^^^^^^^^ timer

        time = time + dt

        if ( parallel_IOProcessor() ) then
           print *, 'End of step', istep,'time = ', time
        end if

        if ( plot_int > 0 .and. mod(istep,plot_int) .eq. 0 ) then

           if (istep <= 99999) then
              write(unit=plot_index,fmt='(i5.5)') istep
              plot_file_name = trim(plot_base_name) // plot_index
           else
              write(unit=plot_index6,fmt='(i6.6)') istep
              plot_file_name = trim(plot_base_name) // plot_index6
           endif

           call make_plotfile(plot_file_name,la,U,plot_names,time,dx,write_pf_time)

!           call write_job_info(plot_file_name, la, write_pf_time)

           last_plt_written = istep

        end if

        if (parallel_IOProcessor() .and. verbose .ge. 2) then
           call flush(6)
        end if

        ! have we reached the stop time?
        if (stop_time >= 0.d0) then
           if (time >= stop_time) then
              goto 999
           end if
        end if

     end do

999  continue
     if (istep > max_step) istep = max_step

     if ( plot_int > 0 .and. last_plt_written .ne. istep ) then

        if (istep <= 99999) then
           write(unit=plot_index,fmt='(i5.5)') istep
           plot_file_name = trim(plot_base_name) // plot_index
        else
           write(unit=plot_index6,fmt='(i6.6)') istep
           plot_file_name = trim(plot_base_name) // plot_index6
        endif

        call make_plotfile(plot_file_name,la,U,plot_names,time,dx,write_pf_time)

!        call write_job_info(plot_file_name, la, write_pf_time)
     end if

  end if

  wt2 = parallel_wtime()

  call destroy_smcdata()

  call destroy(U)

  call destroy(la)

  call chemistry_close()

  call runtime_close()

  deallocate(plot_names)
  deallocate(dx)

  ioproc = parallel_IOProcessorNode()
  call parallel_reduce(wt_advance, wt2-wt1        , MPI_MAX, proc=ioproc)
  call parallel_reduce(wt_fb     , wt_fillboundary, MPI_MAX, proc=ioproc)
  call parallel_reduce(wt_c2p    , wt_ctoprim     , MPI_MAX, proc=ioproc)
  call parallel_reduce(wt_c      , wt_chemterm    , MPI_MAX, proc=ioproc)
  call parallel_reduce(wt_t      , wt_transprop   , MPI_MAX, proc=ioproc)
  call parallel_reduce(wt_hd     , wt_hypdiff     , MPI_MAX, proc=ioproc)

  if (parallel_IOProcessor()) then
     print*, ' '
     print*, 'SMC Advance Time = ', wt_advance
     print*, '  fill boundary Time = ', wt_fb
     print*, '  ctoprim       Time = ', wt_c2p
     print*, '  chemterm      Time = ', wt_c
     print*, '  transprop     Time = ', wt_t
     print*, '  hyper & diff  Time = ', wt_hd
     print*, ' '
  end if

end subroutine smc

max_stars_repo_name: Voskrese/BoxLib-old-msvc

max_issues_repo_name: Voskrese/BoxLib-old-msvc

max_forks_repo_name: Voskrese/BoxLib-old-msvc


text:
C     -*- fortran -*-
C     This file is autogenerated with f2py (version:2)
C     It contains Fortran 77 wrappers to fortran functions.

      subroutine f2pyinitoutput(setupfunc)
      external setupfunc
      integer iout
      common /output/ iout
      call setupfunc(iout)
      end

      subroutine f2pyinitvarable(setupfunc)
      external setupfunc
      double precision aobj
      common /varable/ aobj
      call setupfunc(aobj)
      end

      subroutine f2pyinitcnmn1(setupfunc)
      external setupfunc
      double precision delfun
      double precision dabfun
      double precision fdch
      double precision fdchm
      double precision ct
      double precision ctmin
      double precision ctl
      double precision ctlmin
      double precision alphax
      double precision abobj1
      double precision theta
      double precision obj
      integer ndv
      integer ncon
      integer nside
      integer iprint
      integer nfdg
      integer nscal
      integer linobj
      integer itmax
      integer itrm
      integer icndir
      integer igoto
      integer nac
      integer info
      integer infog
      integer iter
      common /cnmn1/ delfun,dabfun,fdch,fdchm,ct,ctmin,ctl,ctlmin,
     &alphax,abobj1,theta,obj,ndv,ncon,nside,iprint,nfdg,nscal,linobj,it
     &max,itrm,icndir,igoto,nac,info,infog,iter
      call setupfunc(delfun,dabfun,fdch,fdchm,ct,ctmin,ctl,ctlmin,
     &alphax,abobj1,theta,obj,ndv,ncon,nside,iprint,nfdg,nscal,linobj,it
     &max,itrm,icndir,igoto,nac,info,infog,iter)
      end

max_stars_repo_name: robfalck/pyoptsparse

max_issues_repo_name: robfalck/pyoptsparse

max_forks_repo_name: robfalck/pyoptsparse


text:
== Linearly interpolates between two numbers.
==
== Returns: Number
lerp num (val 1, val 2, alpha) ->
    (1 - alpha) * val 1 + alpha * val 2

== Linearly interpolates between two vectors.
==
== Returns: Number
lerp vec (vec 1, vec 2, alpha) -> {
    x <- lerp (vec 1 :: x, vec 2 :: x, alpha)
    y <- lerp (vec 1 :: y, vec 2 :: y, alpha)
}


text:
C  =====================================================================
C  pgm: SH3DT4 .. Get data qualifier for "DQ" keyword or at end of value
C
C  use:     CALL SH3DT4(KHAR,KHPOS,KWAL)
C
C  i/o: KHAR ...... last buffer char obtained - CHAR*1
C  i/o: KHPOS ..... last char loc: 2=eol,1=err-eol,0=eof,neg=err - INT
C  out: KWAL ...... data qualifier found, else set to blank - CHAR*1
C  out:             (set to '-' if code is in error)
C
C  rqd: SHGETK,SHSAVQ,SHQUAL,SHERR,SH2NXD
C  =====================================================================
      SUBROUTINE SH3DT4(KHAR,KHPOS,KWAL)

      EXTERNAL       SHGETK,SHSAVQ,SHQUAL,SHERR,SH2NXD

      CHARACTER*1    KHAR,KWAL
      INTEGER        KHPOS,III
C
C    ================================= RCS keyword statements ==========
      CHARACTER*68     RCSKW1,RCSKW2
      DATA             RCSKW1,RCSKW2 /                                 '
     .$Source: /fs/hseb/ob5/rfc/ofs/src/shefpars_driv/RCS/sh3dt4.f,v $
     . $',                                                             '
     .$Id: sh3dt4.f,v 1.4 2001/06/13 14:11:15 dws Exp $
     . $' /
C    ===================================================================
C

        KWAL = ' '
        IF (KHPOS .GT. 2) THEN

          CALL SHQUAL('GET_VALUE   ',KHAR,KHPOS,KWAL)

          IF (KWAL.NE.' ' .AND. KWAL.NE.'-') THEN
            CALL SHGETK(KHAR,KHPOS)
            IF (KHPOS.GT.2  .AND. KHAR.NE.' '  .AND.
     $          KHAR.NE.'"' .AND. KHAR.NE.'''' .AND.
     $          KHAR.NE.'/' .AND. KHAR.NE.','       ) THEN
              CALL SHERR('A',84,KHPOS,KHAR)
              CALL SH2NXD(KHAR,KHPOS)
              KWAL = '-'
            ELSE
              CALL SHSAVQ('P',III,KWAL)
            ENDIF
          ENDIF

        ENDIF

      RETURN
      END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
Name: Matt Gandara

Email: MailTo(mwgandara AT ucdavis DOT edu)

Lived in the Wake Forest Apartments.


text:
The California Aggie Alumni Marching Band (CAAMB) is the alumni extension of the California Aggie Marching BandUh.  They look a lot like regular bandsmen, but they dont wear silly looking hats or white shirts with their uniforms (except the ones who want to).  They occasionally take the place of or assist the band if much of the Aggie Band is at an away game or parade during a home sporting event.

They can always be found around the ARC band room and Aggie Stadium on Homecoming Bonfire Homecoming and Picnic Day, boring the current bandsmen with stories that start with When I was in band...  and implying that the current band is becoming lax in discipline and show quality.  Mostly they arent serious about it, as older alumni hassled them when they were in band...

Just like the CAMB is the most insane of the Student Organizations, this is the most insane of Alumni Associations.  They help defend and maintain the traditions of the Aggie Band and are total band dorks, and still proud of it.  They marched on Solano Field, performed on Toomey Field Toomey, and lived in the Old Bandroom in the Firehouse where they battled rats and roaches for sheet music and leftover doughnuts.

Alumni Band Members

  Users/RussBowlus  Drums 9197
  Stephen Robinson  Sousaphone
  Users/RobWestergaard  Trombone
  Users/DebWestergaard  Sousaphone 8691
  Mike Levy  Sousaphone
  Users/JimBerry  Sousaphone/Trombone 8387; Announcer 8801


text:
*DECK DSTOD
      SUBROUTINE DSTOD (NEQ, Y, YH, NYH, YH1, EWT, SAVF, ACOR, WM, IWM,
     +   DF, DJAC, RPAR, IPAR)
C***BEGIN PROLOGUE  DSTOD
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DDEBDF
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (STOD-S, DSTOD-D)
C***AUTHOR  Watts, H. A., (SNLA)
C***DESCRIPTION
C
C   DSTOD integrates a system of first order odes over one step in the
C   integrator package DDEBDF.
C ----------------------------------------------------------------------
C DSTOD  performs one step of the integration of an initial value
C problem for a system of ordinary differential equations.
C Note.. DSTOD  is independent of the value of the iteration method
C indicator MITER, when this is .NE. 0, and hence is independent
C of the type of chord method used, or the Jacobian structure.
C Communication with DSTOD  is done with the following variables..
C
C Y      = An array of length .GE. N used as the Y argument in
C          all calls to DF and DJAC.
C NEQ    = Integer array containing problem size in NEQ(1), and
C          passed as the NEQ argument in all calls to DF and DJAC.
C YH     = An NYH by LMAX array containing the dependent variables
C          and their approximate scaled derivatives, where
C          LMAX = MAXORD + 1.  YH(I,J+1) contains the approximate
C          J-th derivative of Y(I), scaled by H**J/FACTORIAL(J)
C          (J = 0,1,...,NQ).  On entry for the first step, the first
C          two columns of YH must be set from the initial values.
C NYH    = A constant integer .GE. N, the first dimension of YH.
C YH1    = A one-dimensional array occupying the same space as YH.
C EWT    = An array of N elements with which the estimated local
C          errors in YH are compared.
C SAVF   = An array of working storage, of length N.
C ACOR   = A work array of length N, used for the accumulated
C          corrections.  On a successful return, ACOR(I) contains
C          the estimated one-step local error in Y(I).
C WM,IWM = DOUBLE PRECISION and INTEGER work arrays associated with
C          matrix operations in chord iteration (MITER .NE. 0).
C DPJAC   = Name of routine to evaluate and preprocess Jacobian matrix
C          if a chord method is being used.
C DSLVS   = Name of routine to solve linear system in chord iteration.
C H      = The step size to be attempted on the next step.
C          H is altered by the error control algorithm during the
C          problem.  H can be either positive or negative, but its
C          sign must remain constant throughout the problem.
C HMIN   = The minimum absolute value of the step size H to be used.
C HMXI   = Inverse of the maximum absolute value of H to be used.
C          HMXI = 0.0 is allowed and corresponds to an infinite HMAX.
C          HMIN and HMXI may be changed at any time, but will not
C          take effect until the next change of H is considered.
C TN     = The independent variable. TN is updated on each step taken.
C JSTART = An integer used for input only, with the following
C          values and meanings..
C               0  Perform the first step.
C           .GT.0  Take a new step continuing from the last.
C              -1  Take the next step with a new value of H, MAXORD,
C                    N, METH, MITER, and/or matrix parameters.
C              -2  Take the next step with a new value of H,
C                    but with other inputs unchanged.
C          On return, JSTART is set to 1 to facilitate continuation.
C KFLAG  = a completion code with the following meanings..
C               0  The step was successful.
C              -1  The requested error could not be achieved.
C              -2  Corrector convergence could not be achieved.
C          A return with KFLAG = -1 or -2 means either
C          ABS(H) = HMIN or 10 consecutive failures occurred.
C          On a return with KFLAG negative, the values of TN and
C          the YH array are as of the beginning of the last
C          step, and H is the last step size attempted.
C MAXORD = The maximum order of integration method to be allowed.
C METH/MITER = The method flags.  See description in driver.
C N      = The number of first-order differential equations.
C ----------------------------------------------------------------------
C
C***SEE ALSO  DDEBDF
C***ROUTINES CALLED  DCFOD, DPJAC, DSLVS, DVNRMS
C***COMMON BLOCKS    DDEBD1
C***REVISION HISTORY  (YYMMDD)
C   820301  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890911  Removed unnecessary intrinsics.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   910722  Updated AUTHOR section.  (ALS)
C   920422  Changed DIMENSION statement.  (WRB)
C***END PROLOGUE  DSTOD
C
      INTEGER I, I1, IALTH, IER, IOD, IOWND, IPAR, IPUP, IREDO, IRET,
     1      IWM, J, JB, JSTART, KFLAG, KSTEPS, L, LMAX, M, MAXORD,
     2      MEO, METH, MITER, N, NCF, NEQ, NEWQ, NFE, NJE, NQ, NQNYH,
     3      NQU, NST, NSTEPJ, NYH
      DOUBLE PRECISION ACOR, CONIT, CRATE, DCON, DDN,
     1      DEL, DELP, DSM, DUP, DVNRMS, EL, EL0, ELCO,
     2      EWT, EXDN, EXSM, EXUP, H, HMIN, HMXI, HOLD, HU, R, RC,
     3      RH, RHDN, RHSM, RHUP, RMAX, ROWND, RPAR, SAVF, TESCO,
     4      TN, TOLD, UROUND, WM, Y, YH, YH1
      EXTERNAL DF, DJAC
C
      DIMENSION Y(*),YH(NYH,*),YH1(*),EWT(*),SAVF(*),ACOR(*),WM(*),
     1          IWM(*),RPAR(*),IPAR(*)
      COMMON /DDEBD1/ ROWND,CONIT,CRATE,EL(13),ELCO(13,12),HOLD,RC,RMAX,
     1                TESCO(3,12),EL0,H,HMIN,HMXI,HU,TN,UROUND,IOWND(7),
     2                KSTEPS,IOD(6),IALTH,IPUP,LMAX,MEO,NQNYH,NSTEPJ,
     3                IER,JSTART,KFLAG,L,METH,MITER,MAXORD,N,NQ,NST,NFE,
     4                NJE,NQU
C
C
C     BEGIN BLOCK PERMITTING ...EXITS TO 690
C        BEGIN BLOCK PERMITTING ...EXITS TO 60
C***FIRST EXECUTABLE STATEMENT  DSTOD
            KFLAG = 0
            TOLD = TN
            NCF = 0
            IF (JSTART .GT. 0) GO TO 160
            IF (JSTART .EQ. -1) GO TO 10
               IF (JSTART .EQ. -2) GO TO 90
C              ---------------------------------------------------------
C               ON THE FIRST CALL, THE ORDER IS SET TO 1, AND OTHER
C               VARIABLES ARE INITIALIZED.  RMAX IS THE MAXIMUM RATIO BY
C               WHICH H CAN BE INCREASED IN A SINGLE STEP.  IT IS
C               INITIALLY 1.E4 TO COMPENSATE FOR THE SMALL INITIAL H,
C               BUT THEN IS NORMALLY EQUAL TO 10.  IF A FAILURE OCCURS
C               (IN CORRECTOR CONVERGENCE OR ERROR TEST), RMAX IS SET AT
C               2 FOR THE NEXT INCREASE.
C              ---------------------------------------------------------
               LMAX = MAXORD + 1
               NQ = 1
               L = 2
               IALTH = 2
               RMAX = 10000.0D0
               RC = 0.0D0
               EL0 = 1.0D0
               CRATE = 0.7D0
               DELP = 0.0D0
               HOLD = H
               MEO = METH
               NSTEPJ = 0
               IRET = 3
            GO TO 50
   10       CONTINUE
C              BEGIN BLOCK PERMITTING ...EXITS TO 30
C                 ------------------------------------------------------
C                  THE FOLLOWING BLOCK HANDLES PRELIMINARIES NEEDED WHEN
C                  JSTART = -1.  IPUP IS SET TO MITER TO FORCE A MATRIX
C                  UPDATE.  IF AN ORDER INCREASE IS ABOUT TO BE
C                  CONSIDERED (IALTH = 1), IALTH IS RESET TO 2 TO
C                  POSTPONE CONSIDERATION ONE MORE STEP.  IF THE CALLER
C                  HAS CHANGED METH, DCFOD  IS CALLED TO RESET THE
C                  COEFFICIENTS OF THE METHOD.  IF THE CALLER HAS
C                  CHANGED MAXORD TO A VALUE LESS THAN THE CURRENT
C                  ORDER NQ, NQ IS REDUCED TO MAXORD, AND A NEW H CHOSEN
C                  ACCORDINGLY.  IF H IS TO BE CHANGED, YH MUST BE
C                  RESCALED.  IF H OR METH IS BEING CHANGED, IALTH IS
C                  RESET TO L = NQ + 1 TO PREVENT FURTHER CHANGES IN H
C                  FOR THAT MANY STEPS.
C                 ------------------------------------------------------
                  IPUP = MITER
                  LMAX = MAXORD + 1
                  IF (IALTH .EQ. 1) IALTH = 2
                  IF (METH .EQ. MEO) GO TO 20
                     CALL DCFOD(METH,ELCO,TESCO)
                     MEO = METH
C              ......EXIT
                     IF (NQ .GT. MAXORD) GO TO 30
                     IALTH = L
                     IRET = 1
C        ............EXIT
                     GO TO 60
   20             CONTINUE
                  IF (NQ .LE. MAXORD) GO TO 90
   30          CONTINUE
               NQ = MAXORD
               L = LMAX
               DO 40 I = 1, L
                  EL(I) = ELCO(I,NQ)
   40          CONTINUE
               NQNYH = NQ*NYH
               RC = RC*EL(1)/EL0
               EL0 = EL(1)
               CONIT = 0.5D0/(NQ+2)
               DDN = DVNRMS(N,SAVF,EWT)/TESCO(1,L)
               EXDN = 1.0D0/L
               RHDN = 1.0D0/(1.3D0*DDN**EXDN + 0.0000013D0)
               RH = MIN(RHDN,1.0D0)
               IREDO = 3
               IF (H .EQ. HOLD) GO TO 660
               RH = MIN(RH,ABS(H/HOLD))
               H = HOLD
               GO TO 100
   50       CONTINUE
C           ------------------------------------------------------------
C            DCFOD  IS CALLED TO GET ALL THE INTEGRATION COEFFICIENTS
C            FOR THE CURRENT METH.  THEN THE EL VECTOR AND RELATED
C            CONSTANTS ARE RESET WHENEVER THE ORDER NQ IS CHANGED, OR AT
C            THE START OF THE PROBLEM.
C           ------------------------------------------------------------
            CALL DCFOD(METH,ELCO,TESCO)
   60    CONTINUE
   70    CONTINUE
C           BEGIN BLOCK PERMITTING ...EXITS TO 680
               DO 80 I = 1, L
                  EL(I) = ELCO(I,NQ)
   80          CONTINUE
               NQNYH = NQ*NYH
               RC = RC*EL(1)/EL0
               EL0 = EL(1)
               CONIT = 0.5D0/(NQ+2)
               GO TO (90,660,160), IRET
C              ---------------------------------------------------------
C               IF H IS BEING CHANGED, THE H RATIO RH IS CHECKED AGAINST
C               RMAX, HMIN, AND HMXI, AND THE YH ARRAY RESCALED.  IALTH
C               IS SET TO L = NQ + 1 TO PREVENT A CHANGE OF H FOR THAT
C               MANY STEPS, UNLESS FORCED BY A CONVERGENCE OR ERROR TEST
C               FAILURE.
C              ---------------------------------------------------------
   90          CONTINUE
               IF (H .EQ. HOLD) GO TO 160
               RH = H/HOLD
               H = HOLD
               IREDO = 3
  100          CONTINUE
  110          CONTINUE
                  RH = MIN(RH,RMAX)
                  RH = RH/MAX(1.0D0,ABS(H)*HMXI*RH)
                  R = 1.0D0
                  DO 130 J = 2, L
                     R = R*RH
                     DO 120 I = 1, N
                        YH(I,J) = YH(I,J)*R
  120                CONTINUE
  130             CONTINUE
                  H = H*RH
                  RC = RC*RH
                  IALTH = L
                  IF (IREDO .NE. 0) GO TO 150
                     RMAX = 10.0D0
                     R = 1.0D0/TESCO(2,NQU)
                     DO 140 I = 1, N
                        ACOR(I) = ACOR(I)*R
  140                CONTINUE
C     ...............EXIT
                     GO TO 690
  150             CONTINUE
C                 ------------------------------------------------------
C                  THIS SECTION COMPUTES THE PREDICTED VALUES BY
C                  EFFECTIVELY MULTIPLYING THE YH ARRAY BY THE PASCAL
C                  TRIANGLE MATRIX.  RC IS THE RATIO OF NEW TO OLD
C                  VALUES OF THE COEFFICIENT  H*EL(1).  WHEN RC DIFFERS
C                  FROM 1 BY MORE THAN 30 PERCENT, IPUP IS SET TO MITER
C                  TO FORCE DPJAC TO BE CALLED, IF A JACOBIAN IS
C                  INVOLVED.  IN ANY CASE, DPJAC IS CALLED AT LEAST
C                  EVERY 20-TH STEP.
C                 ------------------------------------------------------
  160             CONTINUE
  170             CONTINUE
C                    BEGIN BLOCK PERMITTING ...EXITS TO 610
C                       BEGIN BLOCK PERMITTING ...EXITS TO 490
                           IF (ABS(RC-1.0D0) .GT. 0.3D0) IPUP = MITER
                           IF (NST .GE. NSTEPJ + 20) IPUP = MITER
                           TN = TN + H
                           I1 = NQNYH + 1
                           DO 190 JB = 1, NQ
                              I1 = I1 - NYH
                              DO 180 I = I1, NQNYH
                                 YH1(I) = YH1(I) + YH1(I+NYH)
  180                         CONTINUE
  190                      CONTINUE
                           KSTEPS = KSTEPS + 1
C                          ---------------------------------------------
C                           UP TO 3 CORRECTOR ITERATIONS ARE TAKEN.  A
C                           CONVERGENCE TEST IS MADE ON THE R.M.S. NORM
C                           OF EACH CORRECTION, WEIGHTED BY THE ERROR
C                           WEIGHT VECTOR EWT.  THE SUM OF THE
C                           CORRECTIONS IS ACCUMULATED IN THE VECTOR
C                           ACOR(I).  THE YH ARRAY IS NOT ALTERED IN THE
C                           CORRECTOR LOOP.
C                          ---------------------------------------------
  200                      CONTINUE
                              M = 0
                              DO 210 I = 1, N
                                 Y(I) = YH(I,1)
  210                         CONTINUE
                              CALL DF(TN,Y,SAVF,RPAR,IPAR)
                              NFE = NFE + 1
                              IF (IPUP .LE. 0) GO TO 220
C                                ---------------------------------------
C                                 IF INDICATED, THE MATRIX P = I -
C                                 H*EL(1)*J IS REEVALUATED AND
C                                 PREPROCESSED BEFORE STARTING THE
C                                 CORRECTOR ITERATION.  IPUP IS SET TO 0
C                                 AS AN INDICATOR THAT THIS HAS BEEN
C                                 DONE.
C                                ---------------------------------------
                                 IPUP = 0
                                 RC = 1.0D0
                                 NSTEPJ = NST
                                 CRATE = 0.7D0
                                 CALL DPJAC(NEQ,Y,YH,NYH,EWT,ACOR,SAVF,
     1                                      WM,IWM,DF,DJAC,RPAR,IPAR)
C                          ......EXIT
                                 IF (IER .NE. 0) GO TO 440
  220                         CONTINUE
                              DO 230 I = 1, N
                                 ACOR(I) = 0.0D0
  230                         CONTINUE
  240                         CONTINUE
                                 IF (MITER .NE. 0) GO TO 270
C                                   ------------------------------------
C                                    IN THE CASE OF FUNCTIONAL
C                                    ITERATION, UPDATE Y DIRECTLY FROM
C                                    THE RESULT OF THE LAST FUNCTION
C                                    EVALUATION.
C                                   ------------------------------------
                                    DO 250 I = 1, N
                                       SAVF(I) = H*SAVF(I) - YH(I,2)
                                       Y(I) = SAVF(I) - ACOR(I)
  250                               CONTINUE
                                    DEL = DVNRMS(N,Y,EWT)
                                    DO 260 I = 1, N
                                       Y(I) = YH(I,1) + EL(1)*SAVF(I)
                                       ACOR(I) = SAVF(I)
  260                               CONTINUE
                                 GO TO 300
  270                            CONTINUE
C                                   ------------------------------------
C                                    IN THE CASE OF THE CHORD METHOD,
C                                    COMPUTE THE CORRECTOR ERROR, AND
C                                    SOLVE THE LINEAR SYSTEM WITH THAT
C                                    AS RIGHT-HAND SIDE AND P AS
C                                    COEFFICIENT MATRIX.
C                                   ------------------------------------
                                    DO 280 I = 1, N
                                       Y(I) = H*SAVF(I)
     1                                        - (YH(I,2) + ACOR(I))
  280                               CONTINUE
                                    CALL DSLVS(WM,IWM,Y,SAVF)
C                             ......EXIT
                                    IF (IER .NE. 0) GO TO 430
                                    DEL = DVNRMS(N,Y,EWT)
                                    DO 290 I = 1, N
                                       ACOR(I) = ACOR(I) + Y(I)
                                       Y(I) = YH(I,1) + EL(1)*ACOR(I)
  290                               CONTINUE
  300                            CONTINUE
C                                ---------------------------------------
C                                 TEST FOR CONVERGENCE.  IF M.GT.0, AN
C                                 ESTIMATE OF THE CONVERGENCE RATE
C                                 CONSTANT IS STORED IN CRATE, AND THIS
C                                 IS USED IN THE TEST.
C                                ---------------------------------------
                                 IF (M .NE. 0)
     1                              CRATE = MAX(0.2D0*CRATE,DEL/DELP)
                                 DCON = DEL*MIN(1.0D0,1.5D0*CRATE)
     1                                  /(TESCO(2,NQ)*CONIT)
                                 IF (DCON .GT. 1.0D0) GO TO 420
C                                   ------------------------------------
C                                    THE CORRECTOR HAS CONVERGED.  IPUP
C                                    IS SET TO -1 IF MITER .NE. 0, TO
C                                    SIGNAL THAT THE JACOBIAN INVOLVED
C                                    MAY NEED UPDATING LATER.  THE LOCAL
C                                    ERROR TEST IS MADE AND CONTROL
C                                    PASSES TO STATEMENT 500 IF IT
C                                    FAILS.
C                                   ------------------------------------
                                    IF (MITER .NE. 0) IPUP = -1
                                    IF (M .EQ. 0) DSM = DEL/TESCO(2,NQ)
                                    IF (M .GT. 0)
     1                                 DSM = DVNRMS(N,ACOR,EWT)
     2                                       /TESCO(2,NQ)
                                    IF (DSM .GT. 1.0D0) GO TO 380
C                                      BEGIN BLOCK
C                                      PERMITTING ...EXITS TO 360
C                                         ------------------------------
C                                          AFTER A SUCCESSFUL STEP,
C                                          UPDATE THE YH ARRAY.
C                                          CONSIDER CHANGING H IF IALTH
C                                          = 1.  OTHERWISE DECREASE
C                                          IALTH BY 1.  IF IALTH IS THEN
C                                          1 AND NQ .LT. MAXORD, THEN
C                                          ACOR IS SAVED FOR USE IN A
C                                          POSSIBLE ORDER INCREASE ON
C                                          THE NEXT STEP.  IF A CHANGE
C                                          IN H IS CONSIDERED, AN
C                                          INCREASE OR DECREASE IN ORDER
C                                          BY ONE IS CONSIDERED ALSO.  A
C                                          CHANGE IN H IS MADE ONLY IF
C                                          IT IS BY A FACTOR OF AT LEAST
C                                          1.1.  IF NOT, IALTH IS SET TO
C                                          3 TO PREVENT TESTING FOR THAT
C                                          MANY STEPS.
C                                         ------------------------------
                                          KFLAG = 0
                                          IREDO = 0
                                          NST = NST + 1
                                          HU = H
                                          NQU = NQ
                                          DO 320 J = 1, L
                                             DO 310 I = 1, N
                                                YH(I,J) = YH(I,J)
     1                                                    + EL(J)
     2                                                      *ACOR(I)
  310                                        CONTINUE
  320                                     CONTINUE
                                          IALTH = IALTH - 1
                                          IF (IALTH .NE. 0) GO TO 340
C                                            ---------------------------
C                                             REGARDLESS OF THE SUCCESS
C                                             OR FAILURE OF THE STEP,
C                                             FACTORS RHDN, RHSM, AND
C                                             RHUP ARE COMPUTED, BY
C                                             WHICH H COULD BE
C                                             MULTIPLIED AT ORDER NQ -
C                                             1, ORDER NQ, OR ORDER NQ +
C                                             1, RESPECTIVELY.  IN THE
C                                             CASE OF FAILURE, RHUP =
C                                             0.0 TO AVOID AN ORDER
C                                             INCREASE.  THE LARGEST OF
C                                             THESE IS DETERMINED AND
C                                             THE NEW ORDER CHOSEN
C                                             ACCORDINGLY.  IF THE ORDER
C                                             IS TO BE INCREASED, WE
C                                             COMPUTE ONE ADDITIONAL
C                                             SCALED DERIVATIVE.
C                                            ---------------------------
                                             RHUP = 0.0D0
C                       .....................EXIT
                                             IF (L .EQ. LMAX) GO TO 490
                                             DO 330 I = 1, N
                                                SAVF(I) = ACOR(I)
     1                                                    - YH(I,LMAX)
  330                                        CONTINUE
                                             DUP = DVNRMS(N,SAVF,EWT)
     1                                             /TESCO(3,NQ)
                                             EXUP = 1.0D0/(L+1)
                                             RHUP = 1.0D0
     1                                              /(1.4D0*DUP**EXUP
     2                                                + 0.0000014D0)
C                       .....................EXIT
                                             GO TO 490
  340                                     CONTINUE
C                                      ...EXIT
                                          IF (IALTH .GT. 1) GO TO 360
C                                      ...EXIT
                                          IF (L .EQ. LMAX) GO TO 360
                                          DO 350 I = 1, N
                                             YH(I,LMAX) = ACOR(I)
  350                                     CONTINUE
  360                                  CONTINUE
                                       R = 1.0D0/TESCO(2,NQU)
                                       DO 370 I = 1, N
                                          ACOR(I) = ACOR(I)*R
  370                                  CONTINUE
C     .................................EXIT
                                       GO TO 690
  380                               CONTINUE
C                                   ------------------------------------
C                                    THE ERROR TEST FAILED.  KFLAG KEEPS
C                                    TRACK OF MULTIPLE FAILURES.
C                                    RESTORE TN AND THE YH ARRAY TO
C                                    THEIR PREVIOUS VALUES, AND PREPARE
C                                    TO TRY THE STEP AGAIN.  COMPUTE THE
C                                    OPTIMUM STEP SIZE FOR THIS OR ONE
C                                    LOWER ORDER.  AFTER 2 OR MORE
C                                    FAILURES, H IS FORCED TO DECREASE
C                                    BY A FACTOR OF 0.2 OR LESS.
C                                   ------------------------------------
                                    KFLAG = KFLAG - 1
                                    TN = TOLD
                                    I1 = NQNYH + 1
                                    DO 400 JB = 1, NQ
                                       I1 = I1 - NYH
                                       DO 390 I = I1, NQNYH
                                          YH1(I) = YH1(I) - YH1(I+NYH)
  390                                  CONTINUE
  400                               CONTINUE
                                    RMAX = 2.0D0
                                    IF (ABS(H) .GT. HMIN*1.00001D0)
     1                                 GO TO 410
C                                      ---------------------------------
C                                       ALL RETURNS ARE MADE THROUGH
C                                       THIS SECTION.  H IS SAVED IN
C                                       HOLD TO ALLOW THE CALLER TO
C                                       CHANGE H ON THE NEXT STEP.
C                                      ---------------------------------
                                       KFLAG = -1
C     .................................EXIT
                                       GO TO 690
  410                               CONTINUE
C                    ...............EXIT
                                    IF (KFLAG .LE. -3) GO TO 610
                                    IREDO = 2
                                    RHUP = 0.0D0
C                       ............EXIT
                                    GO TO 490
  420                            CONTINUE
                                 M = M + 1
C                             ...EXIT
                                 IF (M .EQ. 3) GO TO 430
C                             ...EXIT
                                 IF (M .GE. 2 .AND. DEL .GT. 2.0D0*DELP)
     1                              GO TO 430
                                 DELP = DEL
                                 CALL DF(TN,Y,SAVF,RPAR,IPAR)
                                 NFE = NFE + 1
                              GO TO 240
  430                         CONTINUE
C                             ------------------------------------------
C                              THE CORRECTOR ITERATION FAILED TO
C                              CONVERGE IN 3 TRIES.  IF MITER .NE. 0 AND
C                              THE JACOBIAN IS OUT OF DATE, DPJAC IS
C                              CALLED FOR THE NEXT TRY.  OTHERWISE THE
C                              YH ARRAY IS RETRACTED TO ITS VALUES
C                              BEFORE PREDICTION, AND H IS REDUCED, IF
C                              POSSIBLE.  IF H CANNOT BE REDUCED OR 10
C                              FAILURES HAVE OCCURRED, EXIT WITH KFLAG =
C                              -2.
C                             ------------------------------------------
C                          ...EXIT
                              IF (IPUP .EQ. 0) GO TO 440
                              IPUP = MITER
                           GO TO 200
  440                      CONTINUE
                           TN = TOLD
                           NCF = NCF + 1
                           RMAX = 2.0D0
                           I1 = NQNYH + 1
                           DO 460 JB = 1, NQ
                              I1 = I1 - NYH
                              DO 450 I = I1, NQNYH
                                 YH1(I) = YH1(I) - YH1(I+NYH)
  450                         CONTINUE
  460                      CONTINUE
                           IF (ABS(H) .GT. HMIN*1.00001D0) GO TO 470
                              KFLAG = -2
C     ........................EXIT
                              GO TO 690
  470                      CONTINUE
                           IF (NCF .NE. 10) GO TO 480
                              KFLAG = -2
C     ........................EXIT
                              GO TO 690
  480                      CONTINUE
                           RH = 0.25D0
                           IPUP = MITER
                           IREDO = 1
C                 .........EXIT
                           GO TO 650
  490                   CONTINUE
                        EXSM = 1.0D0/L
                        RHSM = 1.0D0/(1.2D0*DSM**EXSM + 0.0000012D0)
                        RHDN = 0.0D0
                        IF (NQ .EQ. 1) GO TO 500
                           DDN = DVNRMS(N,YH(1,L),EWT)/TESCO(1,NQ)
                           EXDN = 1.0D0/NQ
                           RHDN = 1.0D0/(1.3D0*DDN**EXDN + 0.0000013D0)
  500                   CONTINUE
                        IF (RHSM .GE. RHUP) GO TO 550
                           IF (RHUP .LE. RHDN) GO TO 540
                              NEWQ = L
                              RH = RHUP
                              IF (RH .GE. 1.1D0) GO TO 520
                                 IALTH = 3
                                 R = 1.0D0/TESCO(2,NQU)
                                 DO 510 I = 1, N
                                    ACOR(I) = ACOR(I)*R
  510                            CONTINUE
C     ...........................EXIT
                                 GO TO 690
  520                         CONTINUE
                              R = EL(L)/L
                              DO 530 I = 1, N
                                 YH(I,NEWQ+1) = ACOR(I)*R
  530                         CONTINUE
                              NQ = NEWQ
                              L = NQ + 1
                              IRET = 2
C           ..................EXIT
                              GO TO 680
  540                      CONTINUE
                        GO TO 580
  550                   CONTINUE
                        IF (RHSM .LT. RHDN) GO TO 580
                           NEWQ = NQ
                           RH = RHSM
                           IF (KFLAG .EQ. 0 .AND. RH .LT. 1.1D0)
     1                        GO TO 560
                              IF (KFLAG .LE. -2) RH = MIN(RH,0.2D0)
C                             ------------------------------------------
C                              IF THERE IS A CHANGE OF ORDER, RESET NQ,
C                              L, AND THE COEFFICIENTS.  IN ANY CASE H
C                              IS RESET ACCORDING TO RH AND THE YH ARRAY
C                              IS RESCALED.  THEN EXIT FROM 680 IF THE
C                              STEP WAS OK, OR REDO THE STEP OTHERWISE.
C                             ------------------------------------------
C                 ............EXIT
                              IF (NEWQ .EQ. NQ) GO TO 650
                              NQ = NEWQ
                              L = NQ + 1
                              IRET = 2
C           ..................EXIT
                              GO TO 680
  560                      CONTINUE
                           IALTH = 3
                           R = 1.0D0/TESCO(2,NQU)
                           DO 570 I = 1, N
                              ACOR(I) = ACOR(I)*R
  570                      CONTINUE
C     .....................EXIT
                           GO TO 690
  580                   CONTINUE
                        NEWQ = NQ - 1
                        RH = RHDN
                        IF (KFLAG .LT. 0 .AND. RH .GT. 1.0D0) RH = 1.0D0
                        IF (KFLAG .EQ. 0 .AND. RH .LT. 1.1D0) GO TO 590
                           IF (KFLAG .LE. -2) RH = MIN(RH,0.2D0)
C                          ---------------------------------------------
C                           IF THERE IS A CHANGE OF ORDER, RESET NQ, L,
C                           AND THE COEFFICIENTS.  IN ANY CASE H IS
C                           RESET ACCORDING TO RH AND THE YH ARRAY IS
C                           RESCALED.  THEN EXIT FROM 680 IF THE STEP
C                           WAS OK, OR REDO THE STEP OTHERWISE.
C                          ---------------------------------------------
C                 .........EXIT
                           IF (NEWQ .EQ. NQ) GO TO 650
                           NQ = NEWQ
                           L = NQ + 1
                           IRET = 2
C           ...............EXIT
                           GO TO 680
  590                   CONTINUE
                        IALTH = 3
                        R = 1.0D0/TESCO(2,NQU)
                        DO 600 I = 1, N
                           ACOR(I) = ACOR(I)*R
  600                   CONTINUE
C     ..................EXIT
                        GO TO 690
  610                CONTINUE
C                    ---------------------------------------------------
C                     CONTROL REACHES THIS SECTION IF 3 OR MORE FAILURES
C                     HAVE OCCURRED.  IF 10 FAILURES HAVE OCCURRED, EXIT
C                     WITH KFLAG = -1.  IT IS ASSUMED THAT THE
C                     DERIVATIVES THAT HAVE ACCUMULATED IN THE YH ARRAY
C                     HAVE ERRORS OF THE WRONG ORDER.  HENCE THE FIRST
C                     DERIVATIVE IS RECOMPUTED, AND THE ORDER IS SET TO
C                     1.  THEN H IS REDUCED BY A FACTOR OF 10, AND THE
C                     STEP IS RETRIED, UNTIL IT SUCCEEDS OR H REACHES
C                     HMIN.
C                    ---------------------------------------------------
                     IF (KFLAG .NE. -10) GO TO 620
C                       ------------------------------------------------
C                        ALL RETURNS ARE MADE THROUGH THIS SECTION.  H
C                        IS SAVED IN HOLD TO ALLOW THE CALLER TO CHANGE
C                        H ON THE NEXT STEP.
C                       ------------------------------------------------
                        KFLAG = -1
C     ..................EXIT
                        GO TO 690
  620                CONTINUE
                     RH = 0.1D0
                     RH = MAX(HMIN/ABS(H),RH)
                     H = H*RH
                     DO 630 I = 1, N
                        Y(I) = YH(I,1)
  630                CONTINUE
                     CALL DF(TN,Y,SAVF,RPAR,IPAR)
                     NFE = NFE + 1
                     DO 640 I = 1, N
                        YH(I,2) = H*SAVF(I)
  640                CONTINUE
                     IPUP = MITER
                     IALTH = 5
C              ......EXIT
                     IF (NQ .NE. 1) GO TO 670
                  GO TO 170
  650             CONTINUE
  660             CONTINUE
                  RH = MAX(RH,HMIN/ABS(H))
               GO TO 110
  670          CONTINUE
               NQ = 1
               L = 2
               IRET = 3
  680       CONTINUE
         GO TO 70
  690 CONTINUE
      HOLD = H
      JSTART = 1
      RETURN
C     ----------------------- END OF SUBROUTINE DSTOD
C     -----------------------
      END


text:
      program w10

C     Side effects in while loop condition

      integer ms

      ms = 0

      do while(inc(ms).le.2)
         print *, ms
      enddo

      print *, ms

      end

      integer function inc(i)
      i = i + 1
      inc = i
      end