1 files changed, 72 insertions, 0 deletions
diff --git a/Ganlib/src/DRVMPX.f b/Ganlib/src/DRVMPX.f
new file mode 100644
index 0000000..8fe70ff
--- /dev/null
+++ b/Ganlib/src/DRVMPX.f
@@ -0,0 +1,72 @@
+*DECK DRVMPX
+      SUBROUTINE DRVMPX(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+* STANDARD MULTIPLICATION MODULE.
+*
+* INPUT/OUTPUT PARAMETERS:
+*  NENTRY : NUMBER OF LINKED LISTS AND FILES USED BY THE MODULE.
+*  HENTRY : CHARACTER*12 NAME OF EACH LINKED LIST OR FILE.
+*  IENTRY : =0 CLE-2000 VARIABLE; =1 LINKED LIST; =2 XSM FILE;
+*           =3 SEQUENTIAL BINARY FILE; =4 SEQUENTIAL ASCII FILE.
+*  JENTRY : =0 THE LINKED LIST OR FILE IS CREATED.
+*           =1 THE LINKED LIST OR FILE IS OPEN FOR MODIFICATIONS;
+*           =2 THE LINKED LIST OR FILE IS OPEN IN READ-ONLY MODE.
+*  KENTRY : =FILE UNIT NUMBER; =LINKED LIST ADDRESS OTHERWISE.
+*           DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
+*           KENTRY(NENTRY)
+*
+*-------------------------------------- AUTHOR: A. HEBERT ; 23/07/94 ---
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR) KENTRY(NENTRY)
+      CHARACTER HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPLIST1
+      CHARACTER HSMG*131,TEXT4*4,TEXT12*12
+      DOUBLE PRECISION DFLOTT
+*
+* PARAMETER VALIDATION.
+      IF(NENTRY.EQ.0) CALL XABORT('DRVMPX: ONE PARAMETER EXPECTED.')
+      TEXT12=HENTRY(1)
+      IF((JENTRY(1).EQ.2).OR.(IENTRY(1).GT.2)) CALL XABORT('DRVMPX: LIN'
+     1 //'KED LIST OR XSM FILE IN CREATION OR MODIFICATION MODE EXPECTE'
+     2 //'D AT LHS ('//TEXT12//').')
+*
+* COPY THE RHS INTO THE LHS.
+      IF(JENTRY(1).EQ.0) THEN
+         IF(NENTRY.LE.1) CALL XABORT('DRVMPX: TWO PARAMETERS EXPECTED.')
+         IF((JENTRY(2).NE.2).OR.(IENTRY(2).GT.2)) CALL XABORT('DRVMPX: '
+     1   //'LINKED LIST OR XSM FILE IN READ-ONLY MODE EXPECTED AT RHS.')
+         NUNIT=KDROPN('DUMMYSQ',0,2,0)
+         IF(NUNIT.LE.0) CALL XABORT('DRVMPX: KDROPN FAILURE.')
+         CALL LCMEXP(KENTRY(2),0,NUNIT,1,1)
+         REWIND(NUNIT)
+         CALL LCMEXP(KENTRY(1),0,NUNIT,1,2)
+         IERR=KDRCLS(NUNIT,2)
+         IF(IERR.LT.0) THEN
+            WRITE(HSMG,'(29HDRVMPX: KDRCLS FAILURE. IERR=,I3)') IERR
+            CALL XABORT(HSMG)
+         ENDIF
+      ENDIF
+*
+* READ THE REAL NUMBER
+      CALL REDGET(ITYP,NITMA,FLOTT,TEXT4,DFLOTT)
+      IF(ITYP.NE.2) CALL XABORT('DRVMPX: REAL DATA EXPECTED.')
+      CALL REDGET(ITYP,NITMA,FLOTT,TEXT4,DFLOTT)
+      IF((ITYP.NE.3).OR.(TEXT4.NE.';')) THEN
+         CALL XABORT('DRVMPX: ; EXPECTED.')
+      ENDIF
+*
+* PERFORM THE MULTIPLICATION.
+      IPLIST1=KENTRY(1)
+      CALL LCMULT(IPLIST1,FLOTT)
+      RETURN
+      END