* * $Id: k77calls.F,v 1.1.1.1 1996/03/08 15:32:55 mclareni Exp $ * * $Log: k77calls.F,v $ * Revision 1.1.1.1 1996/03/08 15:32:55 mclareni * Kuip * * #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