Added missing unconstrained quadruple functions

src/test/u_elfun_quadruple.f

@@ -0,0 +1,100 @@
+      SUBROUTINE ELFUN_q ( FUVALS, XVALUE, EPVALU, NCALCF, ITYPEE,
+     *                   ISTAEV, IELVAR, INTVAR, ISTADH, ISTEPA,
+     *                   ICALCF, LTYPEE, LSTAEV, LELVAR, LNTVAR,
+     *                   LSTADH, LSTEPA, LCALCF, LFVALU, LXVALU,
+     *                   LEPVLU, IFFLAG, IFSTAT )
+      USE ISO_FORTRAN_ENV
+      INTEGER NCALCF, IFFLAG, LTYPEE, LSTAEV, LELVAR, LNTVAR
+      INTEGER LSTADH, LSTEPA, LCALCF, LFVALU, LXVALU, LEPVLU
+      INTEGER IFSTAT
+      INTEGER ITYPEE(LTYPEE), ISTAEV(LSTAEV), IELVAR(LELVAR)
+      INTEGER INTVAR(LNTVAR), ISTADH(LSTADH), ISTEPA(LSTEPA)
+      INTEGER ICALCF(LCALCF)
+      REAL(REAL128) FUVALS(LFVALU), XVALUE(LXVALU), EPVALU(LEPVLU)
+C
+C  PROBLEM NAME : ALLINITU
+C
+      INTEGER IELEMN, IELTYP, IHSTRT, ILSTRT, IGSTRT, IPSTRT
+      INTEGER JCALCF
+      REAL(REAL128) X     , Y     , Z     , SINX  , COSX
+      REAL(REAL128) XX    , YY
+      INTRINSIC SIN   , COS
+      IFSTAT = 0
+      DO     5 JCALCF = 1, NCALCF
+       IELEMN = ICALCF(JCALCF)
+       ILSTRT = ISTAEV(IELEMN) - 1
+       IGSTRT = INTVAR(IELEMN) - 1
+       IPSTRT = ISTEPA(IELEMN) - 1
+       IF ( IFFLAG .EQ. 3 ) IHSTRT = ISTADH(IELEMN) - 1
+       IELTYP = ITYPEE(IELEMN)
+       GO TO (    1,    2,    3,    4
+     *                                                        ), IELTYP
+C
+C  ELEMENT TYPE : SQR
+C
+    1  CONTINUE
+       X      = XVALUE(IELVAR(ILSTRT+     1))
+       IF ( IFFLAG .EQ. 1 ) THEN
+        FUVALS(IELEMN)= X * X
+       ELSE
+        FUVALS(IGSTRT+     1)= X + X
+        IF ( IFFLAG .EQ. 3 ) THEN
+         FUVALS(IHSTRT+     1)=2.0
+        END IF
+       END IF
+       GO TO     5
+C
+C  ELEMENT TYPE : SQR2
+C
+    2  CONTINUE
+       Y      = XVALUE(IELVAR(ILSTRT+     1))
+       Z      = XVALUE(IELVAR(ILSTRT+     2))
+       X      =   Y
+     *          + Z
+       IF ( IFFLAG .EQ. 1 ) THEN
+        FUVALS(IELEMN)= X * X
+       ELSE
+        FUVALS(IGSTRT+     1)= X + X
+        IF ( IFFLAG .EQ. 3 ) THEN
+         FUVALS(IHSTRT+     1)=2.0
+        END IF
+       END IF
+       GO TO     5
+C
+C  ELEMENT TYPE : SINSQR
+C
+    3  CONTINUE
+       X      = XVALUE(IELVAR(ILSTRT+     1))
+       SINX   = SIN( X )
+       COSX   = COS( X )
+       IF ( IFFLAG .EQ. 1 ) THEN
+        FUVALS(IELEMN)= SINX * SINX
+       ELSE
+        FUVALS(IGSTRT+     1)= 2.0 * SINX * COSX
+        IF ( IFFLAG .EQ. 3 ) THEN
+         FUVALS(IHSTRT+     1)=2.0 * ( COSX * COSX - SINX * SINX )
+        END IF
+       END IF
+       GO TO     5
+C
+C  ELEMENT TYPE : PRODSQR
+C
+    4  CONTINUE
+       X      = XVALUE(IELVAR(ILSTRT+     1))
+       Y      = XVALUE(IELVAR(ILSTRT+     2))
+       XX     = X * X
+       YY     = Y * Y
+       IF ( IFFLAG .EQ. 1 ) THEN
+        FUVALS(IELEMN)= XX * YY
+       ELSE
+        FUVALS(IGSTRT+     1)= 2.0 * X * YY
+        FUVALS(IGSTRT+     2)= 2.0 * XX * Y
+        IF ( IFFLAG .EQ. 3 ) THEN
+         FUVALS(IHSTRT+     1)=2.0 * YY
+         FUVALS(IHSTRT+     2)=4.0 * X * Y
+         FUVALS(IHSTRT+     3)=2.0 * XX
+        END IF
+       END IF
+    5 CONTINUE
+      RETURN
+      END

src/test/u_group_quadruple.f

@@ -0,0 +1,48 @@
+      SUBROUTINE GROUP_q ( GVALUE, LGVALU, FVALUE, GPVALU, NCALCG,
+     *                   ITYPEG, ISTGPA, ICALCG, LTYPEG, LSTGPA,
+     *                   LCALCG, LFVALU, LGPVLU, DERIVS, IGSTAT )
+      USE ISO_FORTRAN_ENV
+      INTEGER LGVALU, NCALCG, LTYPEG, LSTGPA
+      INTEGER LCALCG, LFVALU, LGPVLU, IGSTAT
+      LOGICAL DERIVS
+      INTEGER ITYPEG(LTYPEG), ISTGPA(LSTGPA), ICALCG(LCALCG)
+      REAL(REAL128) GVALUE(LGVALU,3), FVALUE(LFVALU), GPVALU(LGPVLU)
+C
+C  PROBLEM NAME : ALLINITU
+C
+      INTEGER IGRTYP, IGROUP, IPSTRT, JCALCG
+      REAL GVAR
+      IGSTAT = 0
+      DO     3 JCALCG = 1, NCALCG
+       IGROUP = ICALCG(JCALCG)
+       IGRTYP = ITYPEG(IGROUP)
+       IF ( IGRTYP .EQ. 0 ) GO TO     3
+       IPSTRT = ISTGPA(IGROUP) - 1
+       GO TO (    1,    2
+     *                                                        ), IGRTYP
+C
+C  GROUP TYPE : TRIVIAL
+C
+    1  CONTINUE
+       GVAR  = FVALUE(IGROUP)
+       IF ( .NOT. DERIVS ) THEN
+        GVALUE(IGROUP,1)= GVAR
+       ELSE
+        GVALUE(IGROUP,2)= 1.0
+        GVALUE(IGROUP,3)= 0.0
+       END IF
+       GO TO     3
+C
+C  GROUP TYPE : L2
+C
+    2  CONTINUE
+       GVAR  = FVALUE(IGROUP)
+       IF ( .NOT. DERIVS ) THEN
+        GVALUE(IGROUP,1)= GVAR * GVAR
+       ELSE
+        GVALUE(IGROUP,2)= GVAR + GVAR
+        GVALUE(IGROUP,3)= 2.0
+       END IF
+    3 CONTINUE
+      RETURN
+      END

src/test/u_range_quadruple.f

@@ -0,0 +1,36 @@
+      SUBROUTINE RANGE_q( IELEMN, TRANSP, W1, W2, NELVAR, NINVAR,
+     *                  ITYPE, LW1, LW2 )
+      USE ISO_FORTRAN_ENV
+      INTEGER IELEMN, NELVAR, NINVAR, ITYPE, LW1, LW2
+      LOGICAL TRANSP
+      REAL(REAL128) W1( LW1 ), W2( LW2 )
+C
+C  PROBLEM NAME : ALLINITU
+C
+C  TRANSP = .FALSE. <=> W2 = U * W1
+C  TRANSP = .TRUE.  <=> W2 = U(TRANSPOSE) * W1
+C
+      INTEGER I
+      GO TO (99998,    2,99998,99998
+     *                                                        ), ITYPE
+C
+C  ELEMENT TYPE : SQR2      
+C
+    2 CONTINUE
+      IF ( TRANSP ) THEN
+         W2(     1 ) =   W1(     1 ) 
+         W2(     2 ) =   W1(     1 ) 
+      ELSE
+         W2(     1 ) =   W1(     1 ) 
+     *                 + W1(     2 ) 
+      END IF
+      RETURN
+C
+C  ELEMENTS WITHOUT INTERNAL VARIABLES.
+C
+99998 CONTINUE
+      DO 99999 I = 1, NELVAR
+         W2( I ) = W1( I )
+99999 CONTINUE
+      RETURN
+      END