      SUBROUTINE ELPQU(DU1,DU2,KVERT,KMID,DCORVG,ELE,ICUB,U,UX,UY,MFILE)
      IMPLICIT DOUBLE PRECISION (A,C-H,O-U,W-Z),LOGICAL(B)
      PARAMETER (NNBAS=21,NNDER=6,NNCUBP=36,NNVE=4)
      CHARACTER FMT*15,SUB*6,CPARAM*120
      DIMENSION DU1(*), DU2(*)
      DIMENSION KVERT(NNVE,*),KMID(NNVE,*),DCORVG(2,*)
      DIMENSION KDFG(NNBAS),KDFL(NNBAS)
      COMMON /OUTPUT/ M,MT,MKEYB,MTERM,MERR,MPROT,MSYS,MTRC,IRECL8
      COMMON /ERRCTL/ IER,ICHECK
      COMMON /CHAR/   SUB,FMT(3),CPARAM
      COMMON /ELEM/   DX(NNVE),DY(NNVE),DJAC(2,2),DETJ,
     *                DBAS(NNBAS,NNDER),BDER(NNDER),KVE(NNVE),IEL
      COMMON /TRIAD/  NEL,NVT,NMT,NVE,NVEL,NBCT,NVBD
      COMMON /CUB/    DXI(NNCUBP,3),DOMEGA(NNCUBP),NCUBP,ICUBP
      COMMON /COAUX1/ KDFG,KDFL,IDFL
      SAVE
C
      SUB='ELPQU'
      IER=0
C
      IELTYP=-1
      CALL ELE(0D0,0D0,IELTYP)
      IF (IER.NE.0) GOTO 99999
      IDFL=NDFL(IELTYP)
      IF (IER.LT.0) GOTO 99999
      CALL CB2Q(ICUB)
      IF (IER.NE.0) GOTO 99999
      DO 1 IDER=1,NNDER
1     BDER(IDER)=.FALSE.
      BDER(1)=.TRUE.
      BDER(2)=.TRUE.
      BDER(3)=.TRUE.
C
      ERRL2= 0D0
      ERRH1= 0D0
      DIVL2= 0D0
      DIVLI=-1D0
      DNL2=  0D0
      DNH1=  0D0
      CALL ELE(0D0,0D0,-2)
C
      DO 100 IEL=1,NEL
C
      CALL NDFGL(IEL,1,IELTYP,KVERT,KMID,KDFG,KDFL)
      IF (IER.LT.0) GOTO 99999
C
      DO 110 IVE=1,NVE
      JP=KVERT(IVE,IEL)
      KVE(IVE)=JP
      DX(IVE)=DCORVG(1,JP)
      DY(IVE)=DCORVG(2,JP)
110   CONTINUE
C
      DJ1=0.5D0*(-DX(1)-DX(2)+DX(3)+DX(4))
      DJ2=0.5D0*( DX(1)-DX(2)+DX(3)-DX(4))
      DJ3=0.5D0*(-DY(1)+DY(2)-DY(3)+DY(4))
      DJ4=0.5D0*(-DY(1)+DY(2)+DY(3)-DY(4))
C
      DO 200 ICUBP=1,NCUBP
C
      XI1=DXI(ICUBP,1)
      XI2=DXI(ICUBP,2)
C	
      DJAC(1,1)=0.5D0*(DX(2)-DX(1)+DJ2)+0.5D0*DJ2*XI2
      DJAC(1,2)=0.5D0*DJ1+0.5D0*DJ2*XI1
      DJAC(2,1)=0.5D0*DJ4-0.5D0*DJ3*XI2
      DJAC(2,2)=0.5D0*(DY(3)-DY(1)-DJ4)-0.5D0*DJ3*XI1
      DETJ=DJAC(1,1)*DJAC(2,2)-DJAC(1,2)*DJAC(2,1)
C	
      OM=DOMEGA(ICUBP)*DETJ

      CALL ELE(XI1,XI2,-3)
      IF (IER.LT.0) GOTO 99999
C  
      XX=0.5D0*(DX(1)+DX(2)+DJ1)+0.5D0*(DX(2)-DX(1)+DJ2)*XI1
     *  +0.5D0*DJ1*XI2+0.5D0*DJ2*XI1*XI2
      YY=0.5D0*(DY(1)+DY(3)+DJ3)+0.5D0*DJ4*XI1+0.5D0*
     *  (DY(3)-DY(1)-DJ4)*XI2-0.5D0*DJ3*XI1*XI2   
C
      UH1 =0D0
      UH2 =0D0
      UH1X=0D0
      UH2X=0D0
      UH1Y=0D0
      UH2Y=0D0
      DO 210 JDOFE=1,IDFL
      IEQ=KDFG(JDOFE)
      ILO=KDFL(JDOFE)
      UH1 =UH1 +DU1(IEQ)*DBAS(ILO,1)
      UH2 =UH2 +DU2(IEQ)*DBAS(ILO,1)
      UH1X=UH1X+DU1(IEQ)*DBAS(ILO,2)
      UH2X=UH2X+DU2(IEQ)*DBAS(ILO,2)
      UH1Y=UH1Y+DU1(IEQ)*DBAS(ILO,3)
      UH2Y=UH2Y+DU2(IEQ)*DBAS(ILO,3)
210   CONTINUE
C
      ERRL2=ERRL2+OM*((U (XX,YY,1)-UH1 )**2+(U (XX,YY,2)-UH2 )**2)
      ERRH1=ERRH1+OM*((UX(XX,YY,1)-UH1X)**2+(UY(XX,YY,1)-UH1Y)**2)
      ERRH1=ERRH1+OM*((UX(XX,YY,2)-UH2X)**2+(UY(XX,YY,2)-UH2Y)**2)
      DIVL2=DIVL2+OM*(UH1X+UH2Y)**2
      DIVLI=MAX(DIVLI,ABS(UH1X+UH2Y))
      DNL2=DNL2+OM*(U (XX,YY,1)**2+U (XX,YY,2)**2)
      DNH1=DNH1+OM*(UX(XX,YY,1)**2+UY(XX,YY,1)**2)
      DNH1=DNH1+OM*(UX(XX,YY,2)**2+UY(XX,YY,2)**2)
C
200   CONTINUE
100   CONTINUE
C
      IF (DNL2.LT.1D-15) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '* ELPQU * EXACT SOLUTION ZERO !!!'
       WRITE(MFILE,*)
       WRITE(MFILE,*) '* ELPQU * EXACT SOLUTION ZERO !!!'
       DNL2=1D0
      ENDIF
C
      IF (DNH1.LT.1D-15) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '* ELPQU * EXACT DERIVATIVE ZERO !!!'
       WRITE(MFILE,*)
       WRITE(MFILE,*) '* ELPQU * EXACT DERIVATIVE ZERO !!!'
       DNH1=1D0
      ENDIF
C
c     IF (MT.GT.0) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '*ELPQU*REL. L2-H1-ERROR',
     *                 SQRT(ERRL2/DNL2),SQRT(ERRH1/DNH1),IELTYP,ICUB
       WRITE(MTERM,*) '*ELPQU*DIVERGENZ       ',SQRT(DIVL2),DIVLI
c      ENDIF
C
       IF (MTERM.NE.MFILE) THEN
        WRITE(MFILE,*)
        WRITE(MFILE,*) '*ELPQU*REL. L2-H1-ERROR',
     *                 SQRT(ERRL2/DNL2),SQRT(ERRH1/DNH1),IELTYP,ICUB
        WRITE(MFILE,*) '*ELPQU*DIVERGENZ       ',SQRT(DIVL2),DIVLI
       ENDIF
C
C
C
99999 END
C
C=======================================================================
C
      SUBROUTINE ELPQP(P,PERR,KVERT,KMID,DCORVG,ELE,ICUB,EP,MFILE)
      IMPLICIT DOUBLE PRECISION (A,C-H,O-U,W-Z),LOGICAL(B)
      PARAMETER (NNBAS=21,NNDER=6,NNCUBP=36,NNVE=4)
      CHARACTER FMT*15,SUB*6,CPARAM*120
      DIMENSION P(*),PERR(*)
      DIMENSION KVERT(NNVE,*),KMID(NNVE,*),DCORVG(2,*)
      DIMENSION KDFG(NNBAS),KDFL(NNBAS)
      COMMON /OUTPUT/ M,MT,MKEYB,MTERM,MERR,MPROT,MSYS,MTRC,IRECL8
      COMMON /ERRCTL/ IER,ICHECK
      COMMON /CHAR/   SUB,FMT(3),CPARAM
      COMMON /ELEM/   DX(NNVE),DY(NNVE),DJAC(2,2),DETJ,
     *                DBAS(NNBAS,NNDER),BDER(NNDER),KVE(NNVE),IEL
      COMMON /TRIAD/  NEL,NVT,NMT,NVE,NVEL,NBCT,NVBD
      COMMON /CUB/    DXI(NNCUBP,3),DOMEGA(NNCUBP),NCUBP,ICUBP
      COMMON /COAUX1/ KDFG,KDFL,IDFL
      SAVE
C
      SUB='ELPQP'
      IER=0
C
      IELTYP=-1
      CALL ELE(0D0,0D0,IELTYP)
      IF (IER.NE.0) GOTO 99999
      IDFL=NDFL(IELTYP)
      IF (IER.LT.0) GOTO 99999
      CALL CB2Q(ICUB)
      IF (IER.NE.0) GOTO 99999
      DO 1 IDER=1,NNDER
1     BDER(IDER)=.FALSE.
      BDER(1)=.TRUE.
      BDER(2)=.FALSE.
      BDER(3)=.FALSE.
C
      ERRL2=0D0
      DNL2=0D0
      CALL ELE(0D0,0D0,-2)
C
      DO 100 IEL=1,NEL
C
      CALL NDFGL(IEL,1,IELTYP,KVERT,KMID,KDFG,KDFL)
      IF (IER.LT.0) GOTO 99999
C
      DO 110 IVE=1,NVE
      JP=KVERT(IVE,IEL)
      KVE(IVE)=JP
      DX(IVE)=DCORVG(1,JP)
      DY(IVE)=DCORVG(2,JP)
110   CONTINUE
C
      DJ1=0.5D0*(-DX(1)-DX(2)+DX(3)+DX(4))
      DJ2=0.5D0*( DX(1)-DX(2)+DX(3)-DX(4))
      DJ3=0.5D0*(-DY(1)+DY(2)-DY(3)+DY(4))
      DJ4=0.5D0*(-DY(1)+DY(2)+DY(3)-DY(4))
C
      DO 200 ICUBP=1,NCUBP
C
      XI1=DXI(ICUBP,1)
      XI2=DXI(ICUBP,2)
C	
      DJAC(1,1)=0.5D0*(DX(2)-DX(1)+DJ2)+0.5D0*DJ2*XI2
      DJAC(1,2)=0.5D0*DJ1+0.5D0*DJ2*XI1
      DJAC(2,1)=0.5D0*DJ4-0.5D0*DJ3*XI2
      DJAC(2,2)=0.5D0*(DY(3)-DY(1)-DJ4)-0.5D0*DJ3*XI1
      DETJ=DJAC(1,1)*DJAC(2,2)-DJAC(1,2)*DJAC(2,1)
C	
      OM=DOMEGA(ICUBP)*DETJ
C
      CALL ELE(XI1,XI2,-3)
      IF (IER.LT.0) GOTO 99999
C
C   
      XX=0.5D0*(DX(1)+DX(2)+DJ1)+0.5D0*(DX(2)-DX(1)+DJ2)*XI1
     *  +0.5D0*DJ1*XI2+0.5D0*DJ2*XI1*XI2
      YY=0.5D0*(DY(1)+DY(3)+DJ3)+0.5D0*DJ4*XI1+0.5D0*
     *  (DY(3)-DY(1)-DJ4)*XI2-0.5D0*DJ3*XI1*XI2   
C
      PH=0D0
      DO 210 JDOFE=1,IDFL
      IEQ=KDFG(JDOFE)
      ILO=KDFL(JDOFE)
      PH =PH +P(IEQ)*DBAS(ILO,1)
210   CONTINUE
C
C
      ERRL2=ERRL2+OM*(EP(XX,YY)-PH)**2
      DNL2 =DNL2 +OM* EP(XX,YY)**2
      PERR(IEQ)=ABS(EP(XX,YY)-PH)
C
200   CONTINUE
100   CONTINUE
C
      IF (DNL2.LT.1D-15) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '* ELPQP * EXACT SOLUTION ZERO !!!'
       WRITE(MFILE,*)
       WRITE(MFILE,*) '* ELPQP * EXACT SOLUTION ZERO !!!'
       DNL2=1D0
       DNH1=1D0
      ENDIF

c     IF (MT.GT.0) THEN
       WRITE(MTERM,*) '*ELPQP*REL. L2-ERROR   '
     *                 ,SQRT(ERRL2/DNL2),IELTYP,ICUB
       WRITE(MTERM,*)
c      ENDIF
C
       IF (MTERM.NE.MFILE) THEN
        WRITE(MFILE,*) '*ELPQP*REL. L2-ERROR   '
     *                  ,SQRT(ERRL2/DNL2),IELTYP,ICUB
        WRITE(MFILE,*)
       ENDIF
C
C
C
99999 END
C
C=======================================================================
C
      SUBROUTINE ELPQN(DU1,DU2,KVERT,KMID,DCORVG,ELE,ICUB,U,UX,UY,MFILE)
      IMPLICIT DOUBLE PRECISION (A,C-H,O-U,W-Z),LOGICAL(B)
      PARAMETER (NNBAS=21,NNDER=6,NNCUBP=36,NNVE=4,NNCOF=6)
      CHARACTER FMT*15,SUB*6,CPARAM*120
      DIMENSION DU1(*), DU2(*)
      DIMENSION KVERT(NNVE,*),KMID(NNVE,*),DCORVG(2,*)
      DIMENSION KDFG(NNBAS),KDFL(NNBAS)
      COMMON /OUTPUT/ M,MT,MKEYB,MTERM,MERR,MPROT,MSYS,MTRC,IRECL8
      COMMON /ERRCTL/ IER,ICHECK
      COMMON /CHAR/   SUB,FMT(3),CPARAM
      COMMON /ELEM/   DX(NNVE),DY(NNVE),DJAC(2,2),DETJ,
     *                DBAS(NNBAS,NNDER),BDER(NNDER),KVE(NNVE),IEL
      COMMON /TRIAD/  NEL,NVT,NMT,NVE,NVEL,NBCT,NVBD
      COMMON /CUB/    DXI(NNCUBP,3),DOMEGA(NNCUBP),NCUBP,ICUBP
      COMMON /COAUX1/ KDFG,KDFL,IDFL
      COMMON /COFBAS/ COB(NNBAS,NNCOF)
      SAVE
C
      SUB='ELPQN'
      IER=0
C
      IELTYP=-1
      CALL ELE(0D0,0D0,IELTYP)
      IF (IER.NE.0) GOTO 99999
      IDFL=NDFL(IELTYP)
      IF (IER.LT.0) GOTO 99999
      CALL CB2Q(ICUB)
      IF (IER.NE.0) GOTO 99999
      DO 1 IDER=1,NNDER
1     BDER(IDER)=.FALSE.
      BDER(1)=.TRUE.
      BDER(2)=.TRUE.
      BDER(3)=.TRUE.
C
      ERRL2= 0D0
      ERRH1= 0D0
      DIVL2= 0D0
      DIVLI=-1D0
      DNL2=  0D0
      DNH1=  0D0
C
      DO 100 IEL=1,NEL
C
      CALL NDFGL(IEL,1,IELTYP,KVERT,KMID,KDFG,KDFL)
      IF (IER.LT.0) GOTO 99999
C
      DO 110 IVE=1,NVE
      JP=KVERT(IVE,IEL)
      KVE(IVE)=JP
      DX(IVE)=DCORVG(1,JP)
      DY(IVE)=DCORVG(2,JP)
110   CONTINUE
C
      DJ1=0.5D0*(-DX(1)-DX(2)+DX(3)+DX(4))
      DJ2=0.5D0*( DX(1)-DX(2)+DX(3)-DX(4))
      DJ3=0.5D0*(-DY(1)+DY(2)-DY(3)+DY(4))
      DJ4=0.5D0*(-DY(1)+DY(2)+DY(3)-DY(4))
C
      CALL ELE(0D0,0D0,-2)
C
      DO 200 ICUBP=1,NCUBP
C
      XI1=DXI(ICUBP,1)
      XI2=DXI(ICUBP,2)
C	
      DJAC(1,1)=0.5D0*(DX(2)-DX(1)+DJ2)+0.5D0*DJ2*XI2
      DJAC(1,2)=0.5D0*DJ1+0.5D0*DJ2*XI1
      DJAC(2,1)=0.5D0*DJ4-0.5D0*DJ3*XI2
      DJAC(2,2)=0.5D0*(DY(3)-DY(1)-DJ4)-0.5D0*DJ3*XI1
      DETJ=DJAC(1,1)*DJAC(2,2)-DJAC(1,2)*DJAC(2,1)
C	
      XX=0.5D0*(DX(1)+DX(2)+DJ1)+0.5D0*(DX(2)-DX(1)+DJ2)*XI1
     *  +0.5D0*DJ1*XI2+0.5D0*DJ2*XI1*XI2
      YY=0.5D0*(DY(1)+DY(3)+DJ3)+0.5D0*DJ4*XI1+0.5D0*
     *  (DY(3)-DY(1)-DJ4)*XI2-0.5D0*DJ3*XI1*XI2   
C
      OM=DOMEGA(ICUBP)*DETJ
C
      CALL ELE(XX,YY,-3)
      IF (IER.LT.0) GOTO 99999
C  
      UH1 =0D0
      UH2 =0D0
      UH1X=0D0
      UH2X=0D0
      UH1Y=0D0
      UH2Y=0D0
      DO 210 JDOFE=1,IDFL
      IEQ=KDFG(JDOFE)
      ILO=KDFL(JDOFE)
      UH1 =UH1 +DU1(IEQ)*DBAS(ILO,1)
      UH2 =UH2 +DU2(IEQ)*DBAS(ILO,1)
      UH1X=UH1X+DU1(IEQ)*DBAS(ILO,2)
      UH2X=UH2X+DU2(IEQ)*DBAS(ILO,2)
      UH1Y=UH1Y+DU1(IEQ)*DBAS(ILO,3)
      UH2Y=UH2Y+DU2(IEQ)*DBAS(ILO,3)
210   CONTINUE
C
      ERRL2=ERRL2+OM*((U (XX,YY,1)-UH1 )**2+(U (XX,YY,2)-UH2 )**2)
      ERRH1=ERRH1+OM*((UX(XX,YY,1)-UH1X)**2+(UY(XX,YY,1)-UH1Y)**2)
      ERRH1=ERRH1+OM*((UX(XX,YY,2)-UH2X)**2+(UY(XX,YY,2)-UH2Y)**2)
      DIVL2=DIVL2+OM*(UH1X+UH2Y)**2
      DIVLI=MAX(DIVLI,ABS(UH1X+UH2Y))
      DNL2=DNL2+OM*(U (XX,YY,1)**2+U (XX,YY,2)**2)
      DNH1=DNH1+OM*(UX(XX,YY,1)**2+UY(XX,YY,1)**2)
      DNH1=DNH1+OM*(UX(XX,YY,2)**2+UY(XX,YY,2)**2)
C
200   CONTINUE
100   CONTINUE
C
      IF (DNL2.LT.1D-15) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '* ELPQN * EXACT SOLUTION ZERO !!!'
       WRITE(MFILE,*)
       WRITE(MFILE,*) '* ELPQN * EXACT SOLUTION ZERO !!!'
       DNL2=1D0
      ENDIF
C
      IF (DNH1.LT.1D-15) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '* ELPQN * EXACT DERIVATIVE ZERO !!!'
       WRITE(MFILE,*)
       WRITE(MFILE,*) '* ELPQN * EXACT DERIVATIVE ZERO !!!'
       DNH1=1D0
      ENDIF
C
c     IF (MT.GT.0) THEN
       WRITE(MTERM,*)
       WRITE(MTERM,*) '*ELPQN*REL. L2-H1-ERROR',
     *                 SQRT(ERRL2/DNL2),SQRT(ERRH1/DNH1),IELTYP,ICUB
       WRITE(MTERM,*) '*ELPQN*DIVERGENZ       ',SQRT(DIVL2),DIVLI
c      ENDIF
C
       IF (MTERM.NE.MFILE) THEN
        WRITE(MFILE,*)
        WRITE(MFILE,*) '*ELPQN*REL. L2-H1-ERROR',
     *                 SQRT(ERRL2/DNL2),SQRT(ERRH1/DNH1),IELTYP,ICUB
        WRITE(MFILE,*) '*ELPQN*DIVERGENZ       ',SQRT(DIVL2),DIVLI
       ENDIF
C
C
C
99999 END
C
