*DECK DRVADD SUBROUTINE DRVADD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * * STANDARD ADDITION 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 ; 21/12/93 --- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY) CHARACTER HENTRY(NENTRY)*12 TYPE(C_PTR) KENTRY(NENTRY) *---- * LOCAL VARIABLES *---- CHARACTER HSMG*131,TEXT12*12 TYPE(C_PTR) IPLIST1,IPLIST2 *---- * PARAMETER VALIDATION. *---- IF(NENTRY.LE.1) CALL XABORT('DRVADD: TWO PARAMETERS EXPECTED.') TEXT12=HENTRY(1) IF((JENTRY(1).EQ.2).OR.(IENTRY(1).GT.2)) CALL XABORT('DRVADD: LIN' 1 //'KED LIST OR XSM FILE IN CREATION OR MODIFICATION MODE EXPECTE' 2 //'D AT LHS ('//TEXT12//').') IF((JENTRY(2).NE.2).OR.(IENTRY(2).GT.2)) CALL XABORT('DRVADD: LIN' 1 //'KED LIST OR XSM FILE IN READ-ONLY MODE EXPECTED AT RHS.') *---- * COPY THE SECOND RHS INTO THE LHS. *---- IF(JENTRY(1).EQ.0) THEN IF(NENTRY.LE.2) CALL XABORT('DRVADD: 3 PARAMETERS EXPECTED.') IF((JENTRY(3).NE.2).OR.(IENTRY(3).GT.2)) CALL XABORT('DRVADD: ' 1 //'LINKED LIST OR XSM FILE IN READ-ONLY MODE EXPECTED AT SECON' 2 //'D RHS.') NUNIT=KDROPN('DUMMYSQ',0,2,0) IF(NUNIT.LE.0) CALL XABORT('DRVADD: KDROPN FAILURE.') CALL LCMEXP(KENTRY(3),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,'(29HDRVADD: KDRCLS FAILURE. IERR=,I3)') IERR CALL XABORT(HSMG) ENDIF ENDIF *---- * PERFORM THE ADDITION. *---- IPLIST1=KENTRY(1) IPLIST2=KENTRY(2) CALL LCMADD(IPLIST2,IPLIST1) RETURN END