*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 15:32:54  mclareni
* Initial revision
*
*
#include "kuip/pilot.h"
#if defined(CERNLIB_IBMALL)
*CMZ :  2.05/05 01/06/94  16.55.25  by  Alfred Nathaniel
*-- Author :    Alfred Nathaniel   15/10/92
*
* Interface between C and F77 routines with CHARACTER variables
*
      SUBROUTINE K77CHECK(F77,C,L,N)
      CHARACTER*(*) F77,C
      IF(L.GT.LEN(C)) THEN
         PRINT '(A,I1,3A,I4)'
     +      ,' *** argument C',N,' in ',F77
     +      ,' has to be increased to CHARACTER*',L
      ENDIF
      END
*
      FUNCTION K77C(KF77,K1,L1)
      EXTERNAL KF77
      CHARACTER*1024 C1
      CALL K77CHECK('K77C',C1,L1,1)
      CALL UHTOC(K1,4,C1,L1)
      K77C = KF77(C1(:L1))
      CALL FMEMCPY(K1,C1(:L1))
      END
*
      FUNCTION K77CC(KF77,K1,L1,K2,L2)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2
      CALL K77CHECK('K77CC',C1,L1,1)
      CALL K77CHECK('K77CC',C2,L2,2)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      K77CC = KF77(C1(:L1),C2(:L2))
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77C3(KF77,K1,L1,K2,L2,K3,L3)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2,C3
      CALL K77CHECK('K77C3',C1,L1,1)
      CALL K77CHECK('K77C3',C2,L2,2)
      CALL K77CHECK('K77C3',C3,L3,3)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      CALL UHTOC(K3,4,C3,L3)
      K77C3 = KF77(C1(:L1),C2(:L2),C3(:L3))
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      CALL FMEMCPY(K3,C3(:L3))
      END
*
      FUNCTION K77C7(KF77,K1,L1,K2,L2,K3,L3,K4,L4,K5,L5,K6,L6,K7,L7)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2,C3,C4,C5,C6,C7
      CALL K77CHECK('K77C7',C1,L1,1)
      CALL K77CHECK('K77C7',C2,L2,2)
      CALL K77CHECK('K77C7',C3,L3,3)
      CALL K77CHECK('K77C7',C4,L4,4)
      CALL K77CHECK('K77C7',C5,L5,5)
      CALL K77CHECK('K77C7',C6,L6,6)
      CALL K77CHECK('K77C7',C7,L7,7)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      CALL UHTOC(K3,4,C3,L3)
      CALL UHTOC(K4,4,C4,L4)
      CALL UHTOC(K5,4,C5,L5)
      CALL UHTOC(K6,4,C6,L6)
      CALL UHTOC(K7,4,C7,L7)
      K77C7 = KF77(C1(:L1),C2(:L2),C3(:L3),C4(:L4),
     +             C5(:L5),C6(:L6),C7(:L7))
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      CALL FMEMCPY(K3,C3(:L3))
      CALL FMEMCPY(K4,C4(:L4))
      CALL FMEMCPY(K5,C5(:L5))
      CALL FMEMCPY(K6,C6(:L6))
      CALL FMEMCPY(K7,C7(:L7))
      END
*
      FUNCTION K77CCx(KF77,K1,L1,K2,L2,X3)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2
      CALL K77CHECK('K77CCx',C1,L1,1)
      CALL K77CHECK('K77CCx',C2,L2,2)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      K77CCx = KF77(C1(:L1),C2(:L2),X3)
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77CCxx(KF77,K1,L1,K2,L2,X3,X4)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2
      CALL K77CHECK('K77CCxx',C1,L1,1)
      CALL K77CHECK('K77CCxx',C2,L2,2)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      K77CCxx = KF77(C1(:L1),C2(:L2),X3,X4)
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77CCx3(KF77,K1,L1,K2,L2,X3,X4,X5)
      EXTERNAL KF77
      CHARACTER*1024 C1,C2
      CALL K77CHECK('K77CCx3',C1,L1,1)
      CALL K77CHECK('K77CCx3',C2,L2,2)
      CALL UHTOC(K1,4,C1,L1)
      CALL UHTOC(K2,4,C2,L2)
      K77CCx3 = KF77(C1(:L1),C2(:L2),X3,X4,X5)
      CALL FMEMCPY(K1,C1(:L1))
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77Cx(KF77,K1,L1,X2)
      EXTERNAL KF77
      CHARACTER*1024 C1
      CALL K77CHECK('K77Cx',C1,L1,1)
      CALL UHTOC(K1,4,C1,L1)
      K77Cx = KF77(C1(:L1),X2)
      CALL FMEMCPY(K1,C1(:L1))
      END
*
      FUNCTION K77Cxx(KF77,K1,L1,X2,X3)
      EXTERNAL KF77
      CHARACTER*1024 C1
      CALL K77CHECK('K77Cxx',C1,L1,1)
      CALL UHTOC(K1,4,C1,L1)
      K77Cxx = KF77(C1(:L1),X2,X3)
      CALL FMEMCPY(K1,C1(:L1))
      END
*
      FUNCTION K77xC(KF77,X1,K2,L2)
      EXTERNAL KF77
      CHARACTER*1024 C2
      CALL K77CHECK('K77xC',C2,L2,2)
      CALL UHTOC(K2,4,C2,L2)
      K77xC = KF77(X1,C2(:L2))
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77xCC(KF77,X1,K2,L2,K3,L3)
      EXTERNAL KF77
      CHARACTER*1024 C2,C3
      CALL K77CHECK('K77xCC',C2,L2,2)
      CALL K77CHECK('K77xCC',C3,L3,3)
      CALL UHTOC(K2,4,C2,L2)
      CALL UHTOC(K3,4,C3,L3)
      K77xCC = KF77(X1,C2(:L2),C3(:L3))
      CALL FMEMCPY(K2,C2(:L2))
      CALL FMEMCPY(K3,C3(:L3))
      END
*
      FUNCTION K77xCCx(KF77,X1,K2,L2,K3,L3,X4)
      EXTERNAL KF77
      CHARACTER*1024 C2,C3
      CALL K77CHECK('K77xCCx',C2,L2,2)
      CALL K77CHECK('K77xCCx',C3,L3,3)
      CALL UHTOC(K2,4,C2,L2)
      CALL UHTOC(K3,4,C3,L3)
      K77xCCx = KF77(X1,C2(:L2),C3(:L3),X4)
      CALL FMEMCPY(K2,C2(:L2))
      CALL FMEMCPY(K3,C3(:L3))
      END
*
      FUNCTION K77xCx(KF77,X1,K2,L2,X3)
      EXTERNAL KF77
      CHARACTER*1024 C2
      CALL K77CHECK('K77xCx',C2,L2,2)
      CALL UHTOC(K2,4,C2,L2)
      K77xCx = KF77(X1,C2(:L2),X3)
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      FUNCTION K77xCx8(KF77,X1,K2,L2,X3,X4,X5,X6,X7,X8,X9,X10)
      EXTERNAL KF77
      CHARACTER*1024 C2
      CALL K77CHECK('K77xCx8',C2,L2,2)
      CALL UHTOC(K2,4,C2,L2)
      K77xCx8 = KF77(X1,C2(:L2),X3,X4,X5,X6,X7,X8,X9,X10)
      CALL FMEMCPY(K2,C2(:L2))
      END
*
      SUBROUTINE KIGMENU(F77,MN,HTIT,LTIT,X1,X2,Y1,Y2,
     +   NBU,HUSER,LUSER,N,HITEM,LITEM,HDEF,LDEF,HVAL,LVAL,
     +   ICHOIC,HOPT,LOPT)
      EXTERNAL F77
      DIMENSION HUSER(LUSER/4,*)
      DIMENSION HITEM(LITEM/4,*)
      DIMENSION HDEF(LDEF/4,*)
      DIMENSION HVAL(LVAL/4,*)
      CHARACTER*80 CHTIT
      CHARACTER*80 CHUSER(10)
      CHARACTER*80 CHITEM(100)
      CHARACTER*80 CHDEF(100)
      CHARACTER*80 CHVAL(100)
      CHARACTER*80 CHOPT
*
      CALL UHTOC(HTIT,4,CHTIT,LTIT)
      DO 10 I=1,NBU
         CHUSER(I)=' '
         CALL UHTOC(HUSER(1,I),4,CHUSER(I),LUSER)
 10   CONTINUE
      DO 20 I=1,N
         CHITEM(I)=' '
         CALL UHTOC(HITEM(1,I),4,CHITEM(I),LITEM)
         CHDEF(I)=' '
         CALL UHTOC(HDEF(1,I),4,CHDEF(I),LDEF)
 20   CONTINUE
      CALL UHTOC(HOPT,4,CHOPT,LOPT)
*
      CALL F77(MN,CHTIT(:LTIT),X1,X2,Y1,Y2,
     +   NBU,CHUSER,N,CHITEM,CHDEF,CHVAL,ICHOIC,CHOPT(:LOPT))
*
      DO 30 I=1,N
         CALL FMEMCPY(CHVAL(I),HVAL(1,I),4,LVAL)
 30   CONTINUE
      END
#endif
