[SCM] UNNAMED PROJECT branch, master, updated. debian/4.4-13-30-gc8f6f09
Bastien ROUCARIÈS
roucaries.bastien at gmail.com
Sun Jun 26 16:15:12 UTC 2011
The following commit has been merged in the master branch:
commit b5815e0dcfa1ae2220017576f1c17818a476c746
Author: Bastien ROUCARIÈS <roucaries.bastien at gmail.com>
Date: Wed Jun 15 16:04:07 2011 +0200
uncompress example file
diff --git a/cfortran.examples.tar.gz b/cfortran.examples.tar.gz
deleted file mode 100644
index 7c57891..0000000
Binary files a/cfortran.examples.tar.gz and /dev/null differ
diff --git a/eg/abc/abc.C b/eg/abc/abc.C
new file mode 120000
index 0000000..798e896
--- /dev/null
+++ b/eg/abc/abc.C
@@ -0,0 +1 @@
+abc.c
\ No newline at end of file
diff --git a/eg/abc/abc.c b/eg/abc/abc.c
new file mode 100644
index 0000000..afa6371
--- /dev/null
+++ b/eg/abc/abc.c
@@ -0,0 +1,20 @@
+/* abc.c == abc.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires abc_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFSUB3(ABC,abc, STRING, PSTRING, PSTRING)
+#define ABC(A1,A2,A3) CCALLSFSUB3(ABC,abc, STRING, PSTRING, PSTRING, A1, A2, A3)
+
+main() {
+static char aa[] = "one ", bb[] = "two ", cc[] = "three"; int i;
+for (i=0; i<10; i++) {printf("%s;%s;%s;\n",aa,bb,cc); ABC(aa,bb,cc);}
+return EXIT_SUCCESS;
+}
diff --git a/eg/abc/abc_f.f b/eg/abc/abc_f.f
new file mode 100644
index 0000000..a91386b
--- /dev/null
+++ b/eg/abc/abc_f.f
@@ -0,0 +1,14 @@
+C /* abc_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires abc.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine abc(a,b,c)
+ implicit none
+ character*(*) b,a,c
+ character*(13) d
+ d = a
+ a = b
+ b = c
+ c = d
+ return
+ end
diff --git a/eg/cf14/cf14.C b/eg/cf14/cf14.C
new file mode 120000
index 0000000..a6edc53
--- /dev/null
+++ b/eg/cf14/cf14.C
@@ -0,0 +1 @@
+cf14.c
\ No newline at end of file
diff --git a/eg/cf14/cf14.c b/eg/cf14/cf14.c
new file mode 100644
index 0000000..88b0504
--- /dev/null
+++ b/eg/cf14/cf14.c
@@ -0,0 +1,26 @@
+/* cf14.c == cf14.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires cf14_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Cf14( int *a, int *b, int *c, int *d, int *e, int *f, int *g, int *h, int *i, int *j, int *k, int *l, int *m, int *n)
+ { *a = 1; *b = 2; *c = 3; *d = 4; *e = 5; *f = 6; *g = 7;
+ *h = 8; *i = 9; *j = 10; *k = 11; *l = 12; *m = 13; *n = 14;
+ return;}
+FCALLSCSUB14(Cf14,CF14,cf14, PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT)
+
+
+ PROTOCCALLSFSUB14(F14,f14, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT)
+#define F14(A,B,C,D,E,F,G,H,I,J,K,L,M,N) \
+ CCALLSFSUB14(F14,f14, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, A, B, C, D, E, F, G, H, I, J, K, L, M, N)
+
+main() {
+int a=0, b=0, c=0, d=0, e=0, f=0, g=0, h=0, i=0, j=0, k=0, l=0, m=0, n=0;
+F14( a,b,c,d,e,f,g,h,i,j,k,l,m,n);
+printf("CF14: %3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d.\n",
+ a,b,c,d,e,f,g,h,i,j,k,l,m,n);
+return EXIT_SUCCESS;
+}
diff --git a/eg/cf14/cf14_f.f b/eg/cf14/cf14_f.f
new file mode 100644
index 0000000..48e2e6d
--- /dev/null
+++ b/eg/cf14/cf14_f.f
@@ -0,0 +1,10 @@
+C /* cf14_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires cf14.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine f14(a,b,c,d,e,f,g,h,i,j,k,l,m,n)
+ implicit none
+ integer a,b,c,d,e,f,g,h,i,j,k,l,m,n
+ call cf14(a,b,c,d,e,f,g,h,i,j,k,l,m,n)
+ return
+ end
diff --git a/eg/e2/e2.C b/eg/e2/e2.C
new file mode 120000
index 0000000..4cd82f3
--- /dev/null
+++ b/eg/e2/e2.C
@@ -0,0 +1 @@
+e2.c
\ No newline at end of file
diff --git a/eg/e2/e2.c b/eg/e2/e2.c
new file mode 100644
index 0000000..66ff36e
--- /dev/null
+++ b/eg/e2/e2.c
@@ -0,0 +1,19 @@
+/* e2.c == e2.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires e2_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* Only to demo. that we can force a wrapper to be used for subroutines. */
+PROTOCCALLSFFUN2(VOID,EASY,easy,PINT,INT)
+#define EASY(A,B) CCALLSFFUN2(EASY,easy, PINT, INT, A, B)
+
+main() {
+int a;
+printf("\nEASY (2) EXAMPLE\n");
+EASY(a,7);
+printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
+return EXIT_SUCCESS;
+}
diff --git a/eg/e2/e2_f.f b/eg/e2/e2_f.f
new file mode 120000
index 0000000..f7b58bb
--- /dev/null
+++ b/eg/e2/e2_f.f
@@ -0,0 +1 @@
+../easy/easy_f.f
\ No newline at end of file
diff --git a/eg/easy/easy.C b/eg/easy/easy.C
new file mode 120000
index 0000000..b5b026b
--- /dev/null
+++ b/eg/easy/easy.C
@@ -0,0 +1 @@
+easy.c
\ No newline at end of file
diff --git a/eg/easy/easy.c b/eg/easy/easy.c
new file mode 100644
index 0000000..0a4999f
--- /dev/null
+++ b/eg/easy/easy.c
@@ -0,0 +1,21 @@
+/* easy.c */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires easy_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFSUB2(EASY,easy, PINT, INT)
+#define EASY(A,B) CCALLSFSUB2(EASY,easy, PINT, INT, A, B)
+
+main() {
+int a;
+EASY(a,7);
+printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
+return EXIT_SUCCESS;
+}
diff --git a/eg/easy/easy_f.f b/eg/easy/easy_f.f
new file mode 100644
index 0000000..4028bd4
--- /dev/null
+++ b/eg/easy/easy_f.f
@@ -0,0 +1,11 @@
+C /* easy_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires easy.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine EASY(a,b)
+ implicit none
+ integer a,b
+ a = b
+ return
+ end
+
diff --git a/eg/eq/eq.C b/eg/eq/eq.C
new file mode 120000
index 0000000..05fa643
--- /dev/null
+++ b/eg/eq/eq.C
@@ -0,0 +1 @@
+eq.c
\ No newline at end of file
diff --git a/eg/eq/eq.c b/eg/eq/eq.c
new file mode 100644
index 0000000..e789ba2
--- /dev/null
+++ b/eg/eq/eq.c
@@ -0,0 +1,61 @@
+/* eq.c == eq.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires eq_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+/* FORTRAN_REAL, instead of float, is only required for CRAY T3E. */
+
+ PROTOCCALLSFSUB0(FEQ,feq)
+#define FEQ() CCALLSFSUB0(FEQ,feq)
+
+#define KWBANK 690
+typedef struct {
+ int nzebra;
+ FORTRAN_REAL gversn,zversn;
+ int ixstor,ixdiv,ixcons;
+ FORTRAN_REAL fendq[16];
+ union {
+ struct {
+ int Lmain,Lr1;
+ union {FORTRAN_REAL Ws[KWBANK]; int Iws[2];}u;
+ }s;
+ union {
+ int Lq[80];
+ struct {
+ int dummy[8];
+ union {FORTRAN_REAL Q[2]; int Iq[2];}u;
+ }s;
+ }u;
+ }u;
+} GCBANK_DEF;
+#define lmain u.s.Lmain
+#define lr1 u.s.Lr1
+#define ws u.s.u.Ws
+#define iws u.s.u.Iws
+#define lq u.u.Lq
+#define q u.u.s.u.Q
+#define iq u.u.s.u.Iq
+#define GCbank COMMON_BLOCK(GCBANK,gcbank)
+COMMON_BLOCK_DEF(GCBANK_DEF,GCbank);
+GCBANK_DEF GCbank;
+
+main() {
+FEQ();
+printf("GCbank.nzebra = %d.\n", GCbank.nzebra);
+printf("GCbank.gversn = %f.\n", GCbank.gversn);
+printf("GCbank.zversn = %f.\n", GCbank.zversn);
+printf("GCbank.ixstor = %d.\n", GCbank.ixstor);
+printf("GCbank.ixcons = %d.\n", GCbank.ixcons);
+printf("GCbank.fendq[15] = %f.\n", GCbank.fendq[15]);
+printf("GCbank.lmain = %d.\n", GCbank.lmain);
+printf("GCbank.lr1 = %d.\n", GCbank.lr1);
+printf("GCbank.ws[KWBANK-1] = %f.\n", GCbank.ws[KWBANK-1]);
+printf("GCbank.iq[0] = %d.\n", GCbank.iq[0]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/eq/eq_f.f b/eg/eq/eq_f.f
new file mode 100644
index 0000000..e08b291
--- /dev/null
+++ b/eg/eq/eq_f.f
@@ -0,0 +1,23 @@
+C /* eq_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires eq.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine feq()
+ parameter (kwbank=690)
+C The & in the next line is for f90 line continuation.
+C It is in column 74, i.e. part of f77 comments.
+ common/gcbank/nzebra,gversn,zversn,ixstor,ixdiv,ixcons,fendq(16) &
+ & ,lmain,lr1,ws(kwbank)
+ dimension iq(2),q(2),lq(80),iws(2)
+ equivalence (q(1),iq(1),lq(9)),(lq(1),lmain) ,(iws(1),ws(1))
+ nzebra = 1
+ gversn = 2
+ zversn = 3
+ ixstor = 4
+ ixcons = 5
+ fendq(16) = 6
+ lmain = 7
+ lr1 = 8
+ ws(kwbank) = 9
+ lq(9) = 10
+ end
diff --git a/eg/f0/f0.C b/eg/f0/f0.C
new file mode 120000
index 0000000..64932db
--- /dev/null
+++ b/eg/f0/f0.C
@@ -0,0 +1 @@
+f0.c
\ No newline at end of file
diff --git a/eg/f0/f0.c b/eg/f0/f0.c
new file mode 100644
index 0000000..bbad665
--- /dev/null
+++ b/eg/f0/f0.c
@@ -0,0 +1,20 @@
+/* f0.c == f0.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires f0_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+void Exist() {printf("exist: was called.\n");}
+FCALLSCSUB0(Exist,EXIST,exist)
+
+
+ PROTOCCALLSFSUB0(FEXIST,fexist)
+#define FEXIST() CCALLSFSUB0(FEXIST,fexist)
+
+main() {FEXIST(); return EXIT_SUCCESS;}
diff --git a/eg/f0/f0_f.f b/eg/f0/f0_f.f
new file mode 100644
index 0000000..c4c386d
--- /dev/null
+++ b/eg/f0/f0_f.f
@@ -0,0 +1,11 @@
+C /* f0_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires f0.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fexist()
+ implicit none
+ print*,'FEXIST: was called'
+ call exist()
+ return
+ end
+
diff --git a/eg/f20/f20.C b/eg/f20/f20.C
new file mode 120000
index 0000000..5d3c165
--- /dev/null
+++ b/eg/f20/f20.C
@@ -0,0 +1 @@
+f20.c
\ No newline at end of file
diff --git a/eg/f20/f20.c b/eg/f20/f20.c
new file mode 100644
index 0000000..f28c31d
--- /dev/null
+++ b/eg/f20/f20.c
@@ -0,0 +1,34 @@
+/* f20.c == f20.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires f20_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Cf14( int *a, int *b, int *c, int *d, int *e, int *f, int *g, int *h, int *i, int *j, int *k, int *l, int *m, int *n)
+ { *a = 1; *b = 2; *c = 3; *d = 4; *e = 5; *f = 6; *g = 7;
+ *h = 8; *i = 9; *j = 10; *k = 11; *l = 12; *m = 13; *n = 14;
+ return;}
+FCALLSCSUB14(Cf14,CF14,cf14, PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT)
+
+
+#if MAX_PREPRO_ARGS>31
+ PROTOCCALLSFSUB20(F20,f20, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT)
+#define F20(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) \
+ CCALLSFSUB20(F20,f20, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T)
+
+main() {
+int a=0, b=0, c=0, d=0, e=0, f=0, g=0, h=0, i=0, j=0, k=0, l=0, m=0, n=0,
+ o=0, p=0, q=0, r=0, s=0, t=0;
+F20( a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t);
+printf(" F20: %3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d.\n",
+ a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t);
+return EXIT_SUCCESS;
+}
+#else
+main() {
+printf("Sorry 14 argument max. via cfortran.h on this C preprocessor.\n");
+return EXIT_SUCCESS;
+}
+#endif
diff --git a/eg/f20/f20_f.f b/eg/f20/f20_f.f
new file mode 100644
index 0000000..a1a936e
--- /dev/null
+++ b/eg/f20/f20_f.f
@@ -0,0 +1,16 @@
+C /* f20_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires f20.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine f20(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)
+ implicit none
+ integer a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t
+ call cf14(a,b,c,d,e,f,g,h,i,j,k,l,m,n)
+ o = 15
+ p = 16
+ q = 17
+ r = 18
+ s = 19
+ t = 20
+ return
+ end
diff --git a/eg/f27/f27.C b/eg/f27/f27.C
new file mode 120000
index 0000000..f3942f3
--- /dev/null
+++ b/eg/f27/f27.C
@@ -0,0 +1 @@
+f27.c
\ No newline at end of file
diff --git a/eg/f27/f27.c b/eg/f27/f27.c
new file mode 100644
index 0000000..f118894
--- /dev/null
+++ b/eg/f27/f27.c
@@ -0,0 +1,38 @@
+/* f27.c == f27.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires f27_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1998. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Cf27(int *a, int *b, int *c, int *d, int *e, int *f, int *g, int *h, int *i, int *j, int *k, int *l, int *m,
+ int *n, int *o, int *p, int *q, int *r, int *s, int *t, int *u, int *v, int *w, int *x, int *y, int *z,
+ int *aa)
+ { *a = 1; *b = 2; *c = 3; *d = 4; *e = 5; *f = 6; *g = 7;
+ *h = 8; *i = 9; *j = 10; *k = 11; *l = 12; *m = 13; *n = 14;
+ *o = 15; *p = 16; *q = 17; *r = 18; *s = 19; *t = 20; *u = 21;
+ *v = 22; *w = 23; *x = 24; *y = 25; *z = 26; *aa= 27;
+ return;}
+FCALLSCSUB27(Cf27,CF27,cf27, PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT, \
+ PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT,PINT)
+
+#if MAX_PREPRO_ARGS>31 && !defined(CFSUBASFUN)
+ PROTOCCALLSFSUB27(F27,f27, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT)
+#define F27(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA) \
+ CCALLSFSUB27(F27,f27, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, PINT, A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z, AA)
+
+main() {
+int a=0, b=0, c=0, d=0, e=0, f=0, g=0, h=0, i=0, j=0, k=0, l=0, m=0, n=0,
+ o=0, p=0, q=0, r=0, s=0, t=0, u=0, v=0, w=0, x=0, y=0, z=0, aa=0;
+F27( a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa);
+printf(" F27: %3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d%3d.\n",
+ a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa);
+return EXIT_SUCCESS;
+}
+#else
+main() {
+printf("Sorry 14 argument max. via cfortran.h for this C preprocessor or for CFSUBASFUN.\n");
+return EXIT_SUCCESS;
+}
+#endif
diff --git a/eg/f27/f27_f.f b/eg/f27/f27_f.f
new file mode 100644
index 0000000..ef82e40
--- /dev/null
+++ b/eg/f27/f27_f.f
@@ -0,0 +1,13 @@
+C /* f27_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires f27.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1998. */
+
+ subroutine f27(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t
+ + ,u,v,w,x,y,z,aa)
+ implicit none
+ integer a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t
+ + ,u,v,w,x,y,z,aa
+ call cf27(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t
+ + ,u,v,w,x,y,z,aa)
+ return
+ end
diff --git a/eg/fa/fa.C b/eg/fa/fa.C
new file mode 120000
index 0000000..4db71de
--- /dev/null
+++ b/eg/fa/fa.C
@@ -0,0 +1 @@
+fa.c
\ No newline at end of file
diff --git a/eg/fa/fa.c b/eg/fa/fa.c
new file mode 100644
index 0000000..a50dfa6
--- /dev/null
+++ b/eg/fa/fa.c
@@ -0,0 +1,23 @@
+/* fa.c == fa.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fa_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+void ca(int i) {printf("ca: had integer argument:%d.\n",i);}
+FCALLSCSUB1(ca,CFORTRANCA,cfortranca, INT)
+/* ^ ^-----------^---------FORTRAN name.
+ * |__ C name.
+ * i.e. the C routine ca is named cfortranca when called from Fortran.
+ */
+
+ PROTOCCALLSFSUB1(FA,fa, INT)
+#define FA(A1) CCALLSFSUB1(FA,fa, INT, A1)
+
+main() {FA(1234); return EXIT_SUCCESS;}
diff --git a/eg/fa/fa_f.f b/eg/fa/fa_f.f
new file mode 100644
index 0000000..adc2a5e
--- /dev/null
+++ b/eg/fa/fa_f.f
@@ -0,0 +1,11 @@
+C /* fa_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fa.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fa(i)
+ implicit none
+ integer i
+ print*,'FA: integer argument =',i
+ call cfortranca(i)
+ return
+ end
diff --git a/eg/fand/fand.C b/eg/fand/fand.C
new file mode 120000
index 0000000..ecc46ba
--- /dev/null
+++ b/eg/fand/fand.C
@@ -0,0 +1 @@
+fand.c
\ No newline at end of file
diff --git a/eg/fand/fand.c b/eg/fand/fand.c
new file mode 100644
index 0000000..91c847d
--- /dev/null
+++ b/eg/fand/fand.c
@@ -0,0 +1,17 @@
+/* fand.c == fand.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fand_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+int Cand(int a, int b) {return a && b;}
+FCALLSCFUN2(LOGICAL,Cand,CAND,cand, LOGICAL, LOGICAL)
+
+
+PROTOCCALLSFFUN2(LOGICAL,FAND,fand,LOGICAL,LOGICAL)
+#define FAND(A,B) CCALLSFFUN2(FAND,fand, LOGICAL, LOGICAL, A, B)
+
+main()
+{printf("FAND(0, 1) returns %d.\n",FAND(0, 1)); return EXIT_SUCCESS;}
diff --git a/eg/fand/fand_f.f b/eg/fand/fand_f.f
new file mode 100644
index 0000000..4d47193
--- /dev/null
+++ b/eg/fand/fand_f.f
@@ -0,0 +1,10 @@
+C /* fand_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fand.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ logical function fand(a,b)
+ implicit none
+ logical cand,a,b
+ fand = cand(a,b)
+ return
+ end
diff --git a/eg/fb/fb.C b/eg/fb/fb.C
new file mode 120000
index 0000000..feef125
--- /dev/null
+++ b/eg/fb/fb.C
@@ -0,0 +1 @@
+fb.c
\ No newline at end of file
diff --git a/eg/fb/fb.c b/eg/fb/fb.c
new file mode 100644
index 0000000..381f01f
--- /dev/null
+++ b/eg/fb/fb.c
@@ -0,0 +1,31 @@
+/* fb.c == fb.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fb_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* The next 2 lines tell cfortran.h that for the subsequent FCALLSCSUBn
+ * and FCALLSCSUBn declarations, FORTRAN entry points to C routines have the
+ * C name prefaced with the characters 'CF'.
+ */
+#undef fcallsc
+#define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN)
+
+void cb(int *i)
+{printf("cb: had pointer argument to integer:%d.\n",*i); *i*=2;}
+FCALLSCSUB1(cb,CB,cb, PINT)
+/* ^ ^--^---------FORTRAN name will be cfcb (case insensitive).
+ * |__ C name.
+ * i.e. the C routine cb is named cfcb when called from Fortran.
+ */
+
+ PROTOCCALLSFSUB1(FB,fb, PINT)
+#define FB(A1) CCALLSFSUB1(FB,fb, PINT, A1)
+
+main()
+{int i,ii; i=ii=1234;
+ FB(ii); printf("MAIN: FB(i=%d) returns with i=%d.\n",i,ii);
+ return EXIT_SUCCESS;
+}
diff --git a/eg/fb/fb_f.f b/eg/fb/fb_f.f
new file mode 100644
index 0000000..329a6f9
--- /dev/null
+++ b/eg/fb/fb_f.f
@@ -0,0 +1,12 @@
+C /* fb_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fb.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fb(i)
+ implicit none
+ integer i
+ print*,'FB: integer argument =',i
+ i = i*2
+ call cfcb(i)
+ return
+ end
diff --git a/eg/fc/fc.C b/eg/fc/fc.C
new file mode 120000
index 0000000..65a8650
--- /dev/null
+++ b/eg/fc/fc.C
@@ -0,0 +1 @@
+fc.c
\ No newline at end of file
diff --git a/eg/fc/fc.c b/eg/fc/fc.c
new file mode 100644
index 0000000..de2e628
--- /dev/null
+++ b/eg/fc/fc.c
@@ -0,0 +1,26 @@
+/* fc.c == fc.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fc_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* The next 2 lines tell cfortran.h that for the subsequent FCALLSCSUBn
+ * and FCALLSCSUBn declarations, FORTRAN entry points to C routines have the
+ * C name prefaced with the characters 'CF'.
+ */
+#undef fcallsc
+#define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN)
+
+void cc(char *s) {printf("cc: had string argument:%s.\n",s);}
+FCALLSCSUB1(cc,CC,cc, STRING)
+/* ^ ^--^---------FORTRAN name will be cfcc (case insensitive).
+ * |__ C name.
+ * i.e. the C routine cc is named cfcc when called from Fortran.
+ */
+
+ PROTOCCALLSFSUB1(FC,fc, STRING)
+#define FC(A1) CCALLSFSUB1(FC,fc, STRING, A1)
+
+main() {FC("hello"); return EXIT_SUCCESS;}
diff --git a/eg/fc/fc_f.f b/eg/fc/fc_f.f
new file mode 100644
index 0000000..b11c3f3
--- /dev/null
+++ b/eg/fc/fc_f.f
@@ -0,0 +1,11 @@
+C /* fc_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fc.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fc(b)
+ implicit none
+ character*(*) b
+ print*,'FC: string argument =',b
+ call cfcc(b)
+ return
+ end
diff --git a/eg/fcb/fcb.C b/eg/fcb/fcb.C
new file mode 120000
index 0000000..ab401a4
--- /dev/null
+++ b/eg/fcb/fcb.C
@@ -0,0 +1 @@
+fcb.c
\ No newline at end of file
diff --git a/eg/fcb/fcb.c b/eg/fcb/fcb.c
new file mode 100644
index 0000000..508c9c9
--- /dev/null
+++ b/eg/fcb/fcb.c
@@ -0,0 +1,38 @@
+/* fcb.c == fcb.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fcb_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFSUB0(FFCB,ffcb)
+#define FFCB() CCALLSFSUB0(FFCB,ffcb)
+
+typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF;
+#define Fcb COMMON_BLOCK(FCB,fcb)
+COMMON_BLOCK_DEF(FCB_DEF,Fcb);
+FCB_DEF Fcb;
+
+main() {
+char cv[14];
+static char cw[4][14] = { "C's w[0]", "C's w[1]", "C's w[2]", "C's w[3]"};
+static char cx[2][3][14] = {{"C's x[0][0]", "C's x[0][1]", "C's x[0][2]"},
+ {"C's x[1][0]", "C's x[1][1]", "C's x[1][2]"}};
+C2FCBSTR("C's V" ,Fcb.v,0);
+C2FCBSTR(cw ,Fcb.w,1);
+C2FCBSTR(cx ,Fcb.x,2);
+FFCB();
+FCB2CSTR(Fcb.v ,cv ,0);
+FCB2CSTR(Fcb.w ,cw ,1);
+FCB2CSTR(Fcb.x ,cx ,2);
+printf("FFCB returns v = %s.\n",cv);
+printf("FFCB returns w[1,2,3,4] = %s,%s,%s,%s.\n",cw[0],cw[1],cw[2],cw[3]);
+printf("FFCB returns x[0,(1,2,3)] = %s,%s,%s.\n",cx[0][0],cx[0][1],cx[0][2]);
+printf("FFCB returns x[1,(1,2,3)] = %s,%s,%s.\n",cx[1][0],cx[1][1],cx[1][2]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/fcb/fcb_f.f b/eg/fcb/fcb_f.f
new file mode 100644
index 0000000..f434920
--- /dev/null
+++ b/eg/fcb/fcb_f.f
@@ -0,0 +1,23 @@
+C /* fcb_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fcb.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine ffcb()
+ implicit none
+ common /fcb/ v,w,x
+ character *(13) v, w(4), x(3,2)
+ print*,'FFCB:v =',v,'.'
+ print*,'FFCB:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4),'.'
+ print*,'FFCB:x([1,2,3],1) =',x(1,1),',',x(2,1),',',x(3,1),'.'
+ print*,'FFCB:x([1,2,3],2) =',x(1,2),',',x(2,2),',',x(3,2),'.'
+ v = 'fcb v'
+ w(1) = 'fcb w(1)'
+ w(2) = 'fcb w(2)'
+ w(3) = 'fcb w(3)'
+ x(1,1) = 'fcb x(1,1)'
+ x(2,1) = 'fcb x(2,1)'
+ x(3,1) = 'fcb x(3,1)'
+ x(1,2) = 'fcb x(1,2)'
+ x(2,2) = 'fcb x(2,2)'
+ x(3,2) = 'fcb x(3,2)'
+ end
diff --git a/eg/fd/fd.C b/eg/fd/fd.C
new file mode 120000
index 0000000..d7bb8d6
--- /dev/null
+++ b/eg/fd/fd.C
@@ -0,0 +1 @@
+fd.c
\ No newline at end of file
diff --git a/eg/fd/fd.c b/eg/fd/fd.c
new file mode 100644
index 0000000..44a2f18
--- /dev/null
+++ b/eg/fd/fd.c
@@ -0,0 +1,32 @@
+/* fd.c == fd.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fd_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* The next 2 lines tell cfortran.h that for the subsequent FCALLSCSUBn
+ * and FCALLSCSUBn declarations, FORTRAN entry points to C routines have the
+ * C name prefaced with the characters 'CFORT'.
+ */
+#undef fcallsc
+#define fcallsc(UN,LN) append_fcallsc(CFORT,cfort,UN,LN)
+
+
+void cd(char *s)
+{printf("cd: had string argument:%s.\n",s); strcpy(s,"to you 12345678");}
+FCALLSCSUB1(cd,CD,cd, PSTRING)
+/* ^ ^--^---------FORTRAN name will be cdcfort (case insensitive).
+ * |__ C name.
+ * i.e. the C routine cd is named cdcfort when called from Fortran.
+ */
+
+ PROTOCCALLSFSUB1(FD,fd, PSTRING)
+#define FD(A1) CCALLSFSUB1(FD,fd, PSTRING, A1)
+
+main()
+{static char i[] = "happy "; static char ii[] = "happy ";
+ FD(ii); printf("MAIN: FD(i=%s) returns with i=%s.\n",i,ii);
+ return EXIT_SUCCESS;
+}
diff --git a/eg/fd/fd_f.f b/eg/fd/fd_f.f
new file mode 100644
index 0000000..82ae818
--- /dev/null
+++ b/eg/fd/fd_f.f
@@ -0,0 +1,13 @@
+C /* fd_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fd.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fd(b)
+ implicit none
+ character*(*) b
+ character*(13) a
+ data a/'birthday'/
+ b = a
+ call cdcfort(b)
+ return
+ end
diff --git a/eg/fe/fe.C b/eg/fe/fe.C
new file mode 120000
index 0000000..a5c66c5
--- /dev/null
+++ b/eg/fe/fe.C
@@ -0,0 +1 @@
+fe.c
\ No newline at end of file
diff --git a/eg/fe/fe.c b/eg/fe/fe.c
new file mode 100644
index 0000000..3a535d4
--- /dev/null
+++ b/eg/fe/fe.c
@@ -0,0 +1,19 @@
+/* fe.c == fe.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fe_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Ce(char v[][5])
+{printf("ce: had string vector argument:%s,%s,%s.\n",v[0],v[1],v[2]);}
+#define ce_STRV_A1 TERM_CHARS(' ',1)
+FCALLSCSUB1(Ce,CE,ce, STRINGV)
+
+
+ PROTOCCALLSFSUB1(FE,fe, STRINGV)
+#define FE(A1) CCALLSFSUB1(FE,fe, STRINGV, A1)
+
+main()
+{static char v[][5] = {"0000", "1", "22", ""}; FE(v); return EXIT_SUCCESS;}
diff --git a/eg/fe/fe_f.f b/eg/fe/fe_f.f
new file mode 100644
index 0000000..d64d821
--- /dev/null
+++ b/eg/fe/fe_f.f
@@ -0,0 +1,12 @@
+C /* fe_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fe.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fe(v)
+ implicit none
+ character*(*) v(4)
+ print*,'FE:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'FE:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
+ call ce(v)
+ return
+ end
diff --git a/eg/ff/ff.C b/eg/ff/ff.C
new file mode 120000
index 0000000..32d3b0c
--- /dev/null
+++ b/eg/ff/ff.C
@@ -0,0 +1 @@
+ff.c
\ No newline at end of file
diff --git a/eg/ff/ff.c b/eg/ff/ff.c
new file mode 100644
index 0000000..5c6264f
--- /dev/null
+++ b/eg/ff/ff.c
@@ -0,0 +1,25 @@
+/* ff.c == ff.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires ff_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Ccff(char v[][5], int n)
+{int i;
+printf("ccff: had %d string vector argument:",n);
+for (i=0; i<n-1; i++) printf("%s,",v[i]);
+printf("%s.\n",v[i]);
+}
+#define ccff_STRV_A1 NUM_ELEM_ARG(2)
+FCALLSCSUB2(Ccff,CCFF,ccff, STRINGV, INT)
+
+ PROTOCCALLSFSUB2(FF,ff, STRINGV, INT)
+#define FF(A1,A2) CCALLSFSUB2(FF,ff, STRINGV, INT, A1, A2)
+
+main()
+{static char v[][5] = {"0000", "1", "22", ""};
+ FF(v,sizeof(v)/sizeof v[0]);
+ return EXIT_SUCCESS;
+}
diff --git a/eg/ff/ff_f.f b/eg/ff/ff_f.f
new file mode 100644
index 0000000..707d7b7
--- /dev/null
+++ b/eg/ff/ff_f.f
@@ -0,0 +1,14 @@
+C /* ff_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires ff.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine ff(v,n)
+ implicit none
+ integer n
+ character*(*) v(4)
+ print*,'FF:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'FF:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
+ print*,'FF:n =',n
+ call ccff(v,n)
+ return
+ end
diff --git a/eg/fg/fg.C b/eg/fg/fg.C
new file mode 120000
index 0000000..6c4da67
--- /dev/null
+++ b/eg/fg/fg.C
@@ -0,0 +1 @@
+fg.c
\ No newline at end of file
diff --git a/eg/fg/fg.c b/eg/fg/fg.c
new file mode 100644
index 0000000..34dbcf5
--- /dev/null
+++ b/eg/fg/fg.c
@@ -0,0 +1,16 @@
+/* fg.c == fg.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fg_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+int Ccg() {return 111;}
+FCALLSCFUN0(INT,Ccg,CCG,ccg)
+
+PROTOCCALLSFFUN0(INT,FG,fg)
+#define FG() CCALLSFFUN0(FG,fg)
+
+main()
+{printf("FG() returns %d.\n",FG()); return EXIT_SUCCESS;}
diff --git a/eg/fg/fg_f.f b/eg/fg/fg_f.f
new file mode 100644
index 0000000..3a92821
--- /dev/null
+++ b/eg/fg/fg_f.f
@@ -0,0 +1,10 @@
+C /* fg_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fg.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ integer function fg()
+ implicit none
+ integer ccg
+ fg = ccg()
+ return
+ end
diff --git a/eg/fh/fh.C b/eg/fh/fh.C
new file mode 120000
index 0000000..edf94b4
--- /dev/null
+++ b/eg/fh/fh.C
@@ -0,0 +1 @@
+fh.c
\ No newline at end of file
diff --git a/eg/fh/fh.c b/eg/fh/fh.c
new file mode 100644
index 0000000..97578a3
--- /dev/null
+++ b/eg/fh/fh.c
@@ -0,0 +1,17 @@
+/* fh.c == fh.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fh_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+char *Cch() {return "hello";}
+FCALLSCFUN0(STRING,Cch,CCH,cch)
+
+
+PROTOCCALLSFFUN0(STRING,FH,fh)
+#define FH() CCALLSFFUN0(FH,fh)
+
+main()
+{printf("FH() returns %s.\n",FH()); return EXIT_SUCCESS;}
diff --git a/eg/fh/fh_f.f b/eg/fh/fh_f.f
new file mode 100644
index 0000000..96b7c7d
--- /dev/null
+++ b/eg/fh/fh_f.f
@@ -0,0 +1,10 @@
+C /* fh_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fh.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function fh()
+ implicit none
+ character*200 cch
+ fh = cch()
+ return
+ end
diff --git a/eg/fi/fi.C b/eg/fi/fi.C
new file mode 120000
index 0000000..b42f3e3
--- /dev/null
+++ b/eg/fi/fi.C
@@ -0,0 +1 @@
+fi.c
\ No newline at end of file
diff --git a/eg/fi/fi.c b/eg/fi/fi.c
new file mode 100644
index 0000000..5dcd480
--- /dev/null
+++ b/eg/fi/fi.c
@@ -0,0 +1,21 @@
+/* fi.c == fi.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fi_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+char *Ci(char v[][5]) {return v[3];}
+#define ci_STRV_A1 NUM_ELEMS(6)
+FCALLSCFUN1(STRING,Ci,CI,ci, STRINGV)
+
+
+PROTOCCALLSFFUN1(STRING,FI,fi,STRINGV)
+#define FI(A1) CCALLSFFUN1(FI,fi, STRINGV, A1)
+
+main()
+{static char v[][5] = {"0000", "1", "22", "333", "8", "9"};
+ printf("FI(v) returns %s.\n",FI(v));
+ return EXIT_SUCCESS;
+}
diff --git a/eg/fi/fi_f.f b/eg/fi/fi_f.f
new file mode 100644
index 0000000..b9dfdf7
--- /dev/null
+++ b/eg/fi/fi_f.f
@@ -0,0 +1,11 @@
+C /* fi_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fi.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function fi(v)
+ implicit none
+ character*(*) v(6)
+ character*200 ci
+ fi = ci(v)
+ return
+ end
diff --git a/eg/fj/fj.C b/eg/fj/fj.C
new file mode 120000
index 0000000..d93f46f
--- /dev/null
+++ b/eg/fj/fj.C
@@ -0,0 +1 @@
+fj.c
\ No newline at end of file
diff --git a/eg/fj/fj.c b/eg/fj/fj.c
new file mode 100644
index 0000000..11a8405
--- /dev/null
+++ b/eg/fj/fj.c
@@ -0,0 +1,17 @@
+/* fj.c == fj.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fj_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+char *Cj(int v) {printf("cj:v=%d\n",v);return "hello";}
+FCALLSCFUN1(STRING,Cj,CJ,cj, INT)
+
+
+PROTOCCALLSFFUN1(STRING,FJ,fj,INT)
+#define FJ(A1) CCALLSFFUN1(FJ,fj, INT, A1)
+
+main()
+{ printf("FJ(2) returns %s.\n",FJ(2)); return EXIT_SUCCESS;}
diff --git a/eg/fj/fj_f.f b/eg/fj/fj_f.f
new file mode 100644
index 0000000..8527629
--- /dev/null
+++ b/eg/fj/fj_f.f
@@ -0,0 +1,12 @@
+C /* fj_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fj.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function fj(v)
+ implicit none
+ integer v
+ character*200 cj
+ print*,'FJ:v =',v
+ fj = cj(v)
+ return
+ end
diff --git a/eg/fk/fk.C b/eg/fk/fk.C
new file mode 120000
index 0000000..5e2eede
--- /dev/null
+++ b/eg/fk/fk.C
@@ -0,0 +1 @@
+fk.c
\ No newline at end of file
diff --git a/eg/fk/fk.c b/eg/fk/fk.c
new file mode 100644
index 0000000..d376b3f
--- /dev/null
+++ b/eg/fk/fk.c
@@ -0,0 +1,19 @@
+/* fk.c == fk.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fk_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* FORTRAN_REAL, instead of float, is only required for CRAY T3E. */
+
+FORTRAN_REAL Ck() {return 111.;}
+FCALLSCFUN0(FLOAT,Ck,CK,ck)
+
+
+PROTOCCALLSFFUN0(FLOAT,FK,fk)
+#define FK() CCALLSFFUN0(FK,fk)
+
+main()
+{printf("FK() returns %f.\n",FK()); return EXIT_SUCCESS;}
diff --git a/eg/fk/fk_f.f b/eg/fk/fk_f.f
new file mode 100644
index 0000000..67c4711
--- /dev/null
+++ b/eg/fk/fk_f.f
@@ -0,0 +1,10 @@
+C /* fk_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fk.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ real function fk()
+ implicit none
+ real ck
+ fk = ck()
+ return
+ end
diff --git a/eg/fl/fl.C b/eg/fl/fl.C
new file mode 120000
index 0000000..ab4f036
--- /dev/null
+++ b/eg/fl/fl.C
@@ -0,0 +1 @@
+fl.c
\ No newline at end of file
diff --git a/eg/fl/fl.c b/eg/fl/fl.c
new file mode 100644
index 0000000..a6317f4
--- /dev/null
+++ b/eg/fl/fl.c
@@ -0,0 +1,19 @@
+/* fl.c == fl.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fl_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* DOUBLE_PRECISION, instead of double, is only required for CRAY (not T3E). */
+
+DOUBLE_PRECISION Cl() {return 111.;}
+FCALLSCFUN0(DOUBLE,Cl,CL,cl)
+
+
+PROTOCCALLSFFUN0(DOUBLE,FL,fl)
+#define FL() CCALLSFFUN0(FL,fl)
+
+main()
+{printf("FL() returns %f.\n",(double)FL()); return EXIT_SUCCESS;}
diff --git a/eg/fl/fl_f.f b/eg/fl/fl_f.f
new file mode 100644
index 0000000..fc56fc9
--- /dev/null
+++ b/eg/fl/fl_f.f
@@ -0,0 +1,10 @@
+C /* fl_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fl.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ double precision function fl()
+ implicit none
+ double precision cl
+ fl = cl()
+ return
+ end
diff --git a/eg/fm/fm.C b/eg/fm/fm.C
new file mode 120000
index 0000000..ff2112f
--- /dev/null
+++ b/eg/fm/fm.C
@@ -0,0 +1 @@
+fm.c
\ No newline at end of file
diff --git a/eg/fm/fm.c b/eg/fm/fm.c
new file mode 100644
index 0000000..98ebd0d
--- /dev/null
+++ b/eg/fm/fm.c
@@ -0,0 +1,19 @@
+/* fm.c == fm.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fm_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* FORTRAN_REAL, instead of float, is only required for CRAY T3E. */
+
+FORTRAN_REAL Cm(FORTRAN_REAL a) {return a;}
+FCALLSCFUN1(FLOAT,Cm,CM,cm, FLOAT)
+
+
+PROTOCCALLSFFUN1(FLOAT,FM,fm,FLOAT)
+#define FM(A) CCALLSFFUN1(FM,fm, FLOAT, A)
+
+main()
+{printf("FM(111.) returns %f.\n",FM(111.)); return EXIT_SUCCESS;}
diff --git a/eg/fm/fm_f.f b/eg/fm/fm_f.f
new file mode 100644
index 0000000..835d4b2
--- /dev/null
+++ b/eg/fm/fm_f.f
@@ -0,0 +1,11 @@
+C /* fm_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fm.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ real function fm(r)
+ implicit none
+ external cm
+ real cm,r
+ fm = cm(r)
+ return
+ end
diff --git a/eg/fn/fn.C b/eg/fn/fn.C
new file mode 120000
index 0000000..721d8df
--- /dev/null
+++ b/eg/fn/fn.C
@@ -0,0 +1 @@
+fn.c
\ No newline at end of file
diff --git a/eg/fn/fn.c b/eg/fn/fn.c
new file mode 100644
index 0000000..d5feb73
--- /dev/null
+++ b/eg/fn/fn.c
@@ -0,0 +1,21 @@
+/* fn.c == fn.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fn_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* DOUBLE_PRECISION, instead of double, is only required for CRAY (not T3E). */
+
+DOUBLE_PRECISION Cn(DOUBLE_PRECISION a, DOUBLE_PRECISION b) {return a+b;}
+FCALLSCFUN2(DOUBLE,Cn,CN,cn, DOUBLE, DOUBLE)
+
+
+PROTOCCALLSFFUN2(DOUBLE,FN,fn,DOUBLE,DOUBLE)
+#define FN(A,B) CCALLSFFUN2(FN,fn, DOUBLE, DOUBLE, A, B)
+
+main()
+{printf("FN(1./3, 2./3) returns %f.\n",(double)FN(1./3, 2./3));
+ return EXIT_SUCCESS;
+}
diff --git a/eg/fn/fn_f.f b/eg/fn/fn_f.f
new file mode 100644
index 0000000..71b5d84
--- /dev/null
+++ b/eg/fn/fn_f.f
@@ -0,0 +1,10 @@
+C /* fn_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fn.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ double precision function fn(a,b)
+ implicit none
+ double precision cn,a,b
+ fn = cn(a,b)
+ return
+ end
diff --git a/eg/forr/forr.C b/eg/forr/forr.C
new file mode 120000
index 0000000..40b40f2
--- /dev/null
+++ b/eg/forr/forr.C
@@ -0,0 +1 @@
+forr.c
\ No newline at end of file
diff --git a/eg/forr/forr.c b/eg/forr/forr.c
new file mode 100644
index 0000000..795a6e9
--- /dev/null
+++ b/eg/forr/forr.c
@@ -0,0 +1,21 @@
+/* forr.c == forr.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires forr_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+int Cor(int *a, int *b) {int t; t= *a;*a= *b;*b=t; return *a || *b;}
+FCALLSCFUN2(LOGICAL,Cor,COR,cor, PLOGICAL, PLOGICAL)
+
+
+PROTOCCALLSFFUN2(LOGICAL,FORR,forr,PLOGICAL,PLOGICAL)
+#define FORR(A,B) CCALLSFFUN2(FORR,forr, PLOGICAL, PLOGICAL, A, B)
+
+main()
+{int a=2, b=0; printf("Calling FORR(a=%d, b=%d).\n", a,b);
+ printf("FORR() returned %d.\n", FORR(a, b));
+ printf("With a=%d, b=%d.\n", a,b);
+ return EXIT_SUCCESS;
+}
diff --git a/eg/forr/forr_f.f b/eg/forr/forr_f.f
new file mode 100644
index 0000000..468ab76
--- /dev/null
+++ b/eg/forr/forr_f.f
@@ -0,0 +1,65 @@
+C /* forr_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires forr.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ logical function forr(a,b)
+ implicit none
+ logical cor,a,b
+
+ print *, 'FORTRAN thinks you called forr(a=',a,',b=',b,').'
+ forr = cor(a,b)
+ print *, 'FORTRAN thinks cor(a,b) returned with a=',a,',b=',b,').'
+
+ if (a.eqv..true.)then
+ print *,'Double check: a is true:',a
+ endif
+ if (a.eqv..false.)then
+ print *,'Double check: a is false:',a
+ endif
+ if (.not.((a.eqv..false.) .or. (a.eqv..true.))) then
+ print *,'Double check: ERROR: a is neither true nor false:',a
+ print *,' Please contact burow at desy.de'
+ endif
+
+ if (b.eqv..true.)then
+ print *,'Double check: b is true:',b
+ endif
+ if (b.eqv..false.)then
+ print *,'Double check: b is false:',b
+ endif
+ if (.not.((b.eqv..false.) .or. (b.eqv..true.))) then
+ print *,'Double check: ERROR: b is neither true nor false:',b
+ print *,' Please contact burow at desy.de'
+ endif
+
+C print *, ' '
+C print *, ' Testing non-FORTRAN/77 (b .eq. .true.) which'
+C print *, ' will not compile on NAG f90 or Apollo or IBM RS/6000.'
+C print *, ' Compile cfortest.c with LOGICAL_STRICT defined'
+C print *, ' if you wish this test to work as expected.'
+C print *, ' This test requires a and b to match the internal '
+C print *, ' representation of .TRUE. and .FALSE. exactly.'
+C if (a.eq..true.)then
+C print *,'Representation check: a matches .true.'
+C endif
+C if (a.eq..false.)then
+C print *,'Representation check: a matches .false.'
+C endif
+C if (.not.(a.eq..false. .or. a.eq..true.)) then
+C print *,'Representation check: '
+C print *,' a matches neither .true. nor .false.'
+C endif
+C if (b.eq..true.)then
+C print *,'Representation check: b matches .true.'
+C endif
+C if (b.eq..false.)then
+C print *,'Representation check: b matches .false.'
+C endif
+C if (.not.(b.eq..false. .or. b.eq..true.)) then
+C print *,'Representation check: '
+C print *,' b matches neither .true. nor .false.'
+C endif
+C print *,' '
+
+ return
+ end
diff --git a/eg/fstr/fstr.C b/eg/fstr/fstr.C
new file mode 120000
index 0000000..5771277
--- /dev/null
+++ b/eg/fstr/fstr.C
@@ -0,0 +1 @@
+fstr.c
\ No newline at end of file
diff --git a/eg/fstr/fstr.c b/eg/fstr/fstr.c
new file mode 100644
index 0000000..2b3e107
--- /dev/null
+++ b/eg/fstr/fstr.c
@@ -0,0 +1,38 @@
+/* fstr.c == fstr.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fstr_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+void Pstru(char *s) { strcpy(s,"new pstring"); return;}
+FCALLSCSUB1(Pstru,PSTRU,pstru, PSTRING)
+
+void Pstr(char *s)
+{
+static char *save=NULL;
+char *temp;
+int ls, lsave;
+/* If required, reset, or prepare to reset the saved location. */
+if (!s || !save) { save=s; return; }
+ls = strlen(s );
+lsave = strlen(save);
+temp = (char *)malloc(ls>lsave?ls:lsave);
+/* Switch contents of argument with contents of saved string. */
+strcpy(temp,save);
+strcpy(save,s );
+strcpy(s ,temp);
+free(temp);
+return;
+}
+/* Provide 3 interfaces using the the 3 types of PSTRING. */
+FCALLSCSUB1(Pstr,PSTR,pstr, PSTRING)
+FCALLSCSUB1(Pstr,PNSTR,pnstr, PNSTRING)
+FCALLSCSUB1(Pstr,PPSTR,ppstr, PPSTRING)
+
+
+ PROTOCCALLSFSUB0(FSTR,fstr)
+#define FSTR() CCALLSFSUB0(FSTR,fstr)
+
+main() { FSTR(); return EXIT_SUCCESS;}
diff --git a/eg/fstr/fstr_f.f b/eg/fstr/fstr_f.f
new file mode 100644
index 0000000..ad4ef79
--- /dev/null
+++ b/eg/fstr/fstr_f.f
@@ -0,0 +1,59 @@
+C /* fstr_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fstr.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fstr()
+ implicit none
+ character*(4) a,b,c
+ character*(1) d(5)
+ character*(5) dd
+ equivalence (d,dd)
+ character*(16) n
+
+ call pstru(n)
+ print *,n,'<-'
+
+ a = '1'
+ a(2:2) = CHAR(0)
+ call ppstr(a)
+
+ b = '22'
+ call pstr(b)
+ print *,b,'<-'
+ call pstr(b)
+ print *,b,'<-'
+
+ c(1:1) = CHAR(0)
+ c(2:2) = CHAR(0)
+ c(3:3) = CHAR(0)
+ c(4:4) = CHAR(0)
+ call pnstr(c)
+ c = '333'
+ c(4:4) = CHAR(0)
+ call pnstr(c)
+
+ call pnstr(b)
+ print *,b,'<-'
+ call pnstr(b)
+ print *,b,'<-'
+
+ c(1:1) = CHAR(0)
+ c(2:2) = CHAR(0)
+ c(3:3) = CHAR(0)
+ c(4:4) = CHAR(0)
+ call pnstr(c)
+ d(1) = '1'
+ d(2) = '2'
+ d(3) = '3'
+ d(4) = '4'
+ d(5) = CHAR(0)
+C Need to use equivalenced dd because using d causes f90 to complain:
+C Error: Inconsistent structure for arg 1 in call to PPSTR at line 533
+ call ppstr(dd)
+ call pstr(b)
+ print *,b,'<-'
+ call pstr(b)
+ print *,b,'<-'
+
+ return
+ end
diff --git a/eg/ft/ft.C b/eg/ft/ft.C
new file mode 120000
index 0000000..62d1da0
--- /dev/null
+++ b/eg/ft/ft.C
@@ -0,0 +1 @@
+ft.c
\ No newline at end of file
diff --git a/eg/ft/ft.c b/eg/ft/ft.c
new file mode 100644
index 0000000..8af2cb3
--- /dev/null
+++ b/eg/ft/ft.c
@@ -0,0 +1,27 @@
+/* ft.c == ft.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires ft_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+/* FORTRAN_REAL, instead of float, is only required for CRAY T3E. */
+
+PROTOCCALLSFFUN3(STRING,FT,ft, PSTRINGV, STRINGV, FLOAT)
+#define FT(A,B,C) CCALLSFFUN3(FT,ft, PSTRINGV, STRINGV, FLOAT, A, B, C)
+
+main() {
+static char v[][5] = {"000 ", "1", "22", " "};
+static char w[][9] = {" ", "bb","ccc ","dddd"};
+FORTRAN_REAL a = 10.0;
+printf("FT(v, w, a); returns:%s.\n",FT(v, w, a));
+printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
+ v[0],v[1],v[2],v[3]);
+printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
+ ,w[0],w[1],w[2],w[3]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/ft/ft_f.f b/eg/ft/ft_f.f
new file mode 100644
index 0000000..e4f764c
--- /dev/null
+++ b/eg/ft/ft_f.f
@@ -0,0 +1,16 @@
+C /* ft_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires sz.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function ft(v, w, a)
+ implicit none
+ character *(*) v(4), w(4)
+ real a
+ print*,'FT:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'FT:len(w(1 or 2 or 3)) =',len(w(1))
+ print*,'FT:a = ',a
+ print*,'FT:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
+ print*,'FT:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
+ ft = v(1)
+ return
+ end
diff --git a/eg/fun/fun.C b/eg/fun/fun.C
new file mode 120000
index 0000000..455e16d
--- /dev/null
+++ b/eg/fun/fun.C
@@ -0,0 +1 @@
+fun.c
\ No newline at end of file
diff --git a/eg/fun/fun.c b/eg/fun/fun.c
new file mode 100644
index 0000000..401aaac
--- /dev/null
+++ b/eg/fun/fun.c
@@ -0,0 +1,25 @@
+/* fun.c == fun.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fun_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+PROTOCCALLSFFUN3(INT,FUNADD,funadd,ROUTINE,INT,INT)
+#define FUNADD(F,A,B) CCALLSFFUN3(FUNADD,funadd, ROUTINE, INT, INT, F, A, B)
+
+int Cadd(int a, int b) {return a+b;}
+FCALLSCFUN2(INT,Cadd,CADD,cadd, INT, INT)
+
+/* Want fadd to be prototyped, though don't need the wrapper that is created. */
+PROTOCCALLSFFUN2(INT,FADD,fadd,INT,INT)
+
+main() {
+
+printf("\nFUNADD(CADD,1,2) returns %d\n",
+ FUNADD( C_FUNCTION(CADD,cadd),1,2) );
+printf("\nFUNADD(FADD,3,4) returns %d\n",
+ FUNADD(FORTRAN_FUNCTION(FADD,fadd),3,4) );
+return EXIT_SUCCESS;
+}
diff --git a/eg/fun/fun_f.f b/eg/fun/fun_f.f
new file mode 100644
index 0000000..97f72ac
--- /dev/null
+++ b/eg/fun/fun_f.f
@@ -0,0 +1,27 @@
+C /* fun_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fun.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ integer function fadd(a,b)
+ implicit none
+ integer a,b
+ fadd = a + b
+ return
+ end
+
+ integer function funadd(fun,a,b)
+ implicit none
+ external fun
+ integer a,b,fun
+C WARNING FOR Alpha/OSF!
+C The DEC Fortran and the DEC C compilers of DEC OSF/1 [RT] V1.2 (Rev. 10)
+C will crash on this example as it stands.
+C See cfortran.doc for a cleaner example of this misbehavior.
+C Note that the routine funarg below, whose argument f is also an integer
+C function, does not have this problem.
+C This example will work if an extra argument is given to function 'fun'.
+C i.e. For Alpha/OSF replace the following line with the kludge:
+C funadd = fun(a,b,1)
+ funadd = fun(a,b)
+ return
+ end
diff --git a/eg/fz/fz.C b/eg/fz/fz.C
new file mode 120000
index 0000000..1fb9d7d
--- /dev/null
+++ b/eg/fz/fz.C
@@ -0,0 +1 @@
+fz.c
\ No newline at end of file
diff --git a/eg/fz/fz.c b/eg/fz/fz.c
new file mode 100644
index 0000000..15e7dfc
--- /dev/null
+++ b/eg/fz/fz.c
@@ -0,0 +1,29 @@
+/* fz.c == fz.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fz_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+#define fz_ELEMS_1 ZTRINGV_ARGF(3)
+#define fz_ELEMLEN_1 ZTRINGV_NUM(6)
+#define fz_ELEMS_2 ZTRINGV_NUM(4)
+#define fz_ELEMLEN_2 ZTRINGV_NUM(8)
+PROTOCCALLSFFUN3(STRING,FZ,fz, PZTRINGV, ZTRINGV, INT)
+#define FZ(A,B,C) CCALLSFFUN3(FZ,fz, PZTRINGV, ZTRINGV, INT, A, B, C)
+
+main() {
+static char v[][7] = {"000 ", "1", "22", " "};
+static char w[][9] = {" ", "bb","ccc ","dddd"};
+printf("FZ(v, w, a); returns:%s.\n",FZ(v, w, 4));
+printf("main:v=%s,%s,%s,%s. PZTRINGV => Has had trailing blanks stripped.\n",
+ v[0],v[1],v[2],v[3]);
+printf("main:w=%s,%s,%s,%s. ZTRINGV => malloc'd copy for FORTRAN=> C intact.\n"
+ ,w[0],w[1],w[2],w[3]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/fz/fz_f.f b/eg/fz/fz_f.f
new file mode 100644
index 0000000..af0c7e1
--- /dev/null
+++ b/eg/fz/fz_f.f
@@ -0,0 +1,16 @@
+C /* fz_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires fz.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function fz(v, w, i)
+ implicit none
+ integer i,j
+ character *(*) v(i), w(i)
+ print*,'FZ:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'FZ:len(w(1 or 2 or 3)) =',len(w(1))
+ do 100 j = 1,i
+ print*,'FZ:v(',j,') =',v(j),' w(',j,') =',w(j)
+100 continue
+ fz = v(1)
+ return
+ end
diff --git a/eg/pz/pz.C b/eg/pz/pz.C
new file mode 120000
index 0000000..786f807
--- /dev/null
+++ b/eg/pz/pz.C
@@ -0,0 +1 @@
+../eg/pz/pz.c
\ No newline at end of file
diff --git a/eg/pz/pz.c b/eg/pz/pz.c
new file mode 100644
index 0000000..6dd749d
--- /dev/null
+++ b/eg/pz/pz.c
@@ -0,0 +1,33 @@
+/* pz.c == pz.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires pz_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+#define pz_ELEMS_3 ZTRINGV_ARGS(4)
+#define pz_ELEMLEN_3 ZTRINGV_NUM(8)
+ PROTOCCALLSFSUB4(PZ,pz, PSTRINGV,INT, PZTRINGV,INT)
+#define PZ(S,IS,Z,IZ) CCALLSFSUB4(PZ,pz, PSTRINGV,INT, PZTRINGV,INT, S,IS,Z,IZ)
+
+int main() {
+char *p;
+static char s[][7]={"000 ", " "} , as[] ="hihi";
+static char z[][9]={" ", "bb","ccc "}, az[99]="hoho";
+
+/*
+ - z[][9] must match ZTRINGV_NUM(8), while az[99] can match or be bigger,
+ since 8 character will be copied back.
+ - Comments in SZ1 example above for Z|STRINGV, also apply for PZ|STRINGV.
+ */
+
+p = (char *)z;
+PZ(s,2,p,3);
+PZ(s[1],1,z[2],1);
+
+PZ(as,1,az,1);
+PZ(as,1,az,1);
+
+return EXIT_SUCCESS;
+}
diff --git a/eg/pz/pz_f.f b/eg/pz/pz_f.f
new file mode 100644
index 0000000..80ac054
--- /dev/null
+++ b/eg/pz/pz_f.f
@@ -0,0 +1,19 @@
+C /* pz_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires pz.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine pz(s, is, z, iz)
+ implicit none
+ integer is,iz,j
+ character *(*) s(is),z(iz)
+ print*,'PZ:len(s(1)) =',len(s(1)), ' len(z(1)) =',len(z(1))
+ do 100 j = 1,is
+ print*,'PZ:s(',j,') =',s(j),'.'
+ s(j) = '12345678'
+100 continue
+ do 200 j = 1,iz
+ print*,'PZ:z(',j,') =',z(j),'.'
+ z(j) = '12345678'
+200 continue
+ return
+ end
diff --git a/eg/q/q.C b/eg/q/q.C
new file mode 120000
index 0000000..944c55a
--- /dev/null
+++ b/eg/q/q.C
@@ -0,0 +1 @@
+q.c
\ No newline at end of file
diff --git a/eg/q/q.c b/eg/q/q.c
new file mode 100644
index 0000000..c296af7
--- /dev/null
+++ b/eg/q/q.c
@@ -0,0 +1,44 @@
+/* q.c == q.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires q_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+#undef ROUTINE_4
+#if defined(__cplusplus)
+#define ROUTINE_4 (int (*)(const void *,const void *))
+#else
+#define ROUTINE_4 (int (*)())
+#endif
+FCALLSCSUB4(qsort,FQSORT,fqsort, PVOID, INT, INT, ROUTINE)
+/* Note that we've assumed in the above that size_t == int */
+
+
+ PROTOCCALLSFSUB1(FQSORTEX,fqsortex, INT)
+#define FQSORTEX(SIZEOF_INT) CCALLSFSUB1(FQSORTEX,fqsortex, INT, SIZEOF_INT)
+
+main() {
+#ifdef PowerStationFortran
+printf("\n\
+ Apologies. As described in cfortran.doc, MSPS Fortran provides no\n\
+ easy way to pass a Fortran routine as an argument to a C routine,\n\
+ so this qsort() example crashes for MSPS Fortran.\n\
+ \n\
+ As a kludge, the example works on MSPS Fortran by either\n\
+ - using MSPS Fortran language extensions\n\
+ or\n\
+ - by removing the 'integer function cmp(a,b)' routine from cfortex.f\n\
+ and instead using the following C routine.\n\
+ int CMP( int *a, int *b) { return *a-*b ; }\n\
+ \n\
+ It remains a mystery why the SUB_SELECT example works\n\
+ for MSPS Fortran, since it should crash due to the same problem.\n\
+ Presumably the faulty stack clearing is not fatal for SUB_SELECT.\n\
+ \n");
+#else
+FQSORTEX(sizeof(int));
+#endif
+return EXIT_SUCCESS;
+}
diff --git a/eg/q/q_f.f b/eg/q/q_f.f
new file mode 100644
index 0000000..73ac1fc
--- /dev/null
+++ b/eg/q/q_f.f
@@ -0,0 +1,23 @@
+C /* q_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires q.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fqsortex(size)
+ implicit none
+C Because it's convinient here, we let C tell us the size of INTEGER.
+ integer size
+
+ integer base(10),cmp,i
+ external cmp
+ data base /1,10,2,9,3,8,4,7,5,6/
+ call fqsort(base,10,size,cmp)
+ print '(10I3)', (base(i), i=1,10)
+ return
+ end
+
+ integer function cmp(a,b)
+ implicit none
+ integer a,b
+ cmp = a-b
+ return
+ end
diff --git a/eg/rev/rev.C b/eg/rev/rev.C
new file mode 120000
index 0000000..da77f9a
--- /dev/null
+++ b/eg/rev/rev.C
@@ -0,0 +1 @@
+rev.c
\ No newline at end of file
diff --git a/eg/rev/rev.c b/eg/rev/rev.c
new file mode 100644
index 0000000..ebec5f1
--- /dev/null
+++ b/eg/rev/rev.c
@@ -0,0 +1,25 @@
+/* rev.c == rev.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires rev_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFFUN1(INT,FREV,frev, INTV)
+#define FREV(A1) CCALLSFFUN1( FREV,frev, INTV, A1)
+ PROTOCCALLSFSUB1(REV,rev, INTV)
+#define REV(A1) CCALLSFSUB1(REV,rev, INTV, A1)
+
+main() {
+static int a[] = {1,2};
+printf("REV(a[0,1]=%d,%d) receives:",a[0],a[1]);
+REV(a); printf("a[0,1]=%d,%d\n",a[0],a[1]);
+printf("FREV(a[0,1]=%d,%d) receives:",a[0],a[1]);
+printf("%d",FREV(a)); printf(" with a[0,1]=%d,%d\n",a[0],a[1]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/rev/rev_f.f b/eg/rev/rev_f.f
new file mode 100644
index 0000000..13ce970
--- /dev/null
+++ b/eg/rev/rev_f.f
@@ -0,0 +1,21 @@
+C /* rev_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires rev.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine rev(a)
+ implicit none
+ integer a(2),t
+ t = a(1)
+ a(1) = a(2)
+ a(2) = t
+ return
+ end
+
+ integer function frev(a)
+ implicit none
+ integer a(2)
+ frev = a(1)
+ a(1) = a(2)
+ a(2) = frev
+ return
+ end
diff --git a/eg/rr/rr.C b/eg/rr/rr.C
new file mode 120000
index 0000000..325695f
--- /dev/null
+++ b/eg/rr/rr.C
@@ -0,0 +1 @@
+rr.c
\ No newline at end of file
diff --git a/eg/rr/rr.c b/eg/rr/rr.c
new file mode 100644
index 0000000..0f1c8dc
--- /dev/null
+++ b/eg/rr/rr.c
@@ -0,0 +1,27 @@
+/* rr.c == rr.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires rr_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+PROTOCCALLSFFUN1(FLOAT,RR,rr,INT)
+#define RR(A1) CCALLSFFUN1(RR,rr, INT, A1)
+PROTOCCALLSFFUN0(STRING,FORSTR2,forstr2)
+#define FORSTR2() CCALLSFFUN0(FORSTR2,forstr2)
+PROTOCCALLSFFUN1(STRING,FORSTR,forstr,STRING)
+#define FORSTR(A1) CCALLSFFUN1(FORSTR,forstr, STRING, A1)
+
+main() {
+static char aa[] = "one";
+int rrr = 333;
+printf("RR(rrr=%d) returns int arg. as float:%f\n",rrr,RR(rrr));
+printf("FORSTR(aa=%s) returns the string arg. as:%s<-end here\n",aa,FORSTR(aa));
+printf("FORSTR2() returns the string constant:%s<-end here\n",FORSTR2());
+return EXIT_SUCCESS;
+}
diff --git a/eg/rr/rr_f.f b/eg/rr/rr_f.f
new file mode 100644
index 0000000..2012859
--- /dev/null
+++ b/eg/rr/rr_f.f
@@ -0,0 +1,26 @@
+C /* rr_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires rr.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ character*(*) function forstr(a)
+ implicit none
+ character*(*) a
+ forstr = a
+ return
+ end
+
+ real function rr(i)
+ implicit none
+ integer i
+ rr = i
+ return
+ end
+
+ character*(*) function forstr2()
+ implicit none
+C character*(13) a VAX/Ultrix complains about these ().
+ character*13 a
+ data a/'first'/
+ forstr2 = a
+ return
+ end
diff --git a/eg/ss1/ss1.C b/eg/ss1/ss1.C
new file mode 120000
index 0000000..ef712fb
--- /dev/null
+++ b/eg/ss1/ss1.C
@@ -0,0 +1 @@
+ss1.c
\ No newline at end of file
diff --git a/eg/ss1/ss1.c b/eg/ss1/ss1.c
new file mode 100644
index 0000000..98f57af
--- /dev/null
+++ b/eg/ss1/ss1.c
@@ -0,0 +1,23 @@
+/* ss1.c == ss1.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires ss1_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFSUB1(SS1,ss1, PSTRING)
+#define SS1(A1) CCALLSFSUB1(SS1,ss1, PSTRING, A1)
+ PROTOCCALLSFSUB1(FORSTR1,forstr1, PSTRING)
+#define FORSTR1(A1) CCALLSFSUB1(FORSTR1,forstr1, PSTRING, A1)
+
+main() {
+static char b[] = "abcdefghij", forb[13] = "abcdefghijkl";
+SS1(b); FORSTR1(forb);
+printf("SS1(b) returns b = %s; FORSTR1(forb) = returns forb = %s;\n", b, forb);
+return EXIT_SUCCESS;
+}
diff --git a/eg/ss1/ss1_f.f b/eg/ss1/ss1_f.f
new file mode 100644
index 0000000..c4c0294
--- /dev/null
+++ b/eg/ss1/ss1_f.f
@@ -0,0 +1,29 @@
+C /* ss1_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires ss1.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine ss1(b)
+ implicit none
+ character*(*) b
+ character*(13) a
+ data a/'first'/
+ b = a
+ return
+ end
+
+ subroutine forstr1(b)
+ implicit none
+ character*(*) b
+ character*(13) a
+ character*(13) forstr
+ data a/'firs'/
+ b = forstr(a)
+ return
+ end
+
+ character*(*) function forstr(a)
+ implicit none
+ character*(*) a
+ forstr = a
+ return
+ end
diff --git a/eg/strtok/strtok.C b/eg/strtok/strtok.C
new file mode 120000
index 0000000..8c0f0f3
--- /dev/null
+++ b/eg/strtok/strtok.C
@@ -0,0 +1 @@
+strtok.c
\ No newline at end of file
diff --git a/eg/strtok/strtok.c b/eg/strtok/strtok.c
new file mode 100644
index 0000000..0983e10
--- /dev/null
+++ b/eg/strtok/strtok.c
@@ -0,0 +1,17 @@
+/* fstrtok.c == fstrtok.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires fstrtok_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+
+
+#include <string.h>
+FCALLSCFUN2(STRING,strtok,CSTRTOK,cstrtok, STRING, STRING)
+
+ PROTOCCALLSFSUB0(FSTRTOK,fstrtok)
+#define FSTRTOK() CCALLSFSUB0(FSTRTOK,fstrtok)
+
+main() {FSTRTOK(); return EXIT_SUCCESS;}
diff --git a/eg/strtok/strtok_f.f b/eg/strtok/strtok_f.f
new file mode 100644
index 0000000..c44c664
--- /dev/null
+++ b/eg/strtok/strtok_f.f
@@ -0,0 +1,41 @@
+C /* fstrtok_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Uses fstrtok.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine fstrtok()
+ implicit none
+ character*70 cstrtok, a
+
+C Setting up NULL as the NULL pointer for cfortran.h using 4 NUL bytes.
+ character NULL*4, NUL(4)
+ equivalence (NULL,NUL)
+
+C HP-UX Fortran requires DATA statements to not follow executable statements.
+ DATA a/'first+second-third+forth-fifth-sixth seventh'/
+
+CSUNBUG Have to use an equivalenced NUL array to fill NULL with 4 NUL bytes
+CSUNBUG since Sun's 'Sep 8 1987 /usr/bin/f77' has a bug which didn't set NULL
+CSUNBUG to 4 NUL bytes in the following.
+CSUNBUG NULL = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0)
+ NUL(1) = CHAR(0)
+ NUL(2) = CHAR(0)
+ NUL(3) = CHAR(0)
+ NUL(4) = CHAR(0)
+
+C NUL character in a will force cfortran.h to pass address of a,
+C not of a copy as it usually does.
+ a(70:) = NULL
+
+C String until the first '-', then until the first '+'.
+ print *,cstrtok(a, '-')
+ print *,cstrtok(NULL, '+')
+
+C Flush the rest of the string.
+C Recall cfortran.h kills all trailing blanks. i.e. FORTRAN ' ' -> C "".
+ print *,cstrtok(NULL, ' ')
+
+C Further calls return nothing.
+ print *,cstrtok(NULL, ' ')
+
+ return
+ end
diff --git a/eg/sub/sub.C b/eg/sub/sub.C
new file mode 120000
index 0000000..035e8f4
--- /dev/null
+++ b/eg/sub/sub.C
@@ -0,0 +1 @@
+sub.c
\ No newline at end of file
diff --git a/eg/sub/sub.c b/eg/sub/sub.c
new file mode 100644
index 0000000..084dd91
--- /dev/null
+++ b/eg/sub/sub.c
@@ -0,0 +1,29 @@
+/* sub.c == sub.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires sub_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+ PROTOCCALLSFSUB4(FUNARG,funarg, ROUTINE, INT, INT, PINT)
+#define FUNARG(F,A,B,C) \
+ CCALLSFSUB4(FUNARG,funarg, ROUTINE, INT, INT, PINT, F, A, B, C)
+
+#ifdef __cplusplus
+#define Ellipsis ...
+#else
+#define Ellipsis
+#endif
+
+int Cfun(int (*f)(Ellipsis), int a, int b) {int c; f(&a,&b,&c); return c;}
+#undef ROUTINE_1
+#define ROUTINE_1 (int (*)(Ellipsis))
+FCALLSCFUN3(INT,Cfun,CFUN,cfun, ROUTINE, INT, INT)
+
+main() {
+int c;
+FUNARG(C_FUNCTION(CFUN,cfun),1,2,c);
+printf("\nFUNARG(CFUN,1,2,c) returns with c=%d\n",c);
+return EXIT_SUCCESS;
+}
diff --git a/eg/sub/sub_f.f b/eg/sub/sub_f.f
new file mode 100644
index 0000000..93f72ae
--- /dev/null
+++ b/eg/sub/sub_f.f
@@ -0,0 +1,18 @@
+C /* sub_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires sub.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine funarg(f,a,b,c)
+ implicit none
+ external fadd3,f
+ integer a,b,c,f
+ c = f(fadd3,a,b)
+ return
+ end
+
+ subroutine fadd3(a,b,c)
+ implicit none
+ integer a,b,c
+ c = a + b
+ return
+ end
diff --git a/eg/subt/subt.C b/eg/subt/subt.C
new file mode 120000
index 0000000..d3aade7
--- /dev/null
+++ b/eg/subt/subt.C
@@ -0,0 +1 @@
+subt.c
\ No newline at end of file
diff --git a/eg/subt/subt.c b/eg/subt/subt.c
new file mode 100644
index 0000000..581713f
--- /dev/null
+++ b/eg/subt/subt.c
@@ -0,0 +1,25 @@
+/* subt.c */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires subt_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+ PROTOCCALLSFSUB3(SUBT,subt, PSTRINGV, STRINGV, FLOAT)
+#define SUBT(A,B,C) CCALLSFSUB3(SUBT,subt, PSTRINGV, STRINGV, FLOAT, A, B, C)
+
+int main() {
+static char v[][5] = {"000 ", "1", "22", " "};
+static char w[][9] = {" ", "bb","ccc ","dddd"};
+SUBT(v, w, 10.);
+printf("main:v=%s,%s,%s,%s. PSTRINGV => Has had trailing blanks stripped.\n",
+ v[0],v[1],v[2],v[3]);
+printf("main:w=%s,%s,%s,%s. STRINGV => malloc'd copy for FORTRAN=> C intact.\n"
+ ,w[0],w[1],w[2],w[3]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/subt/subt_f.f b/eg/subt/subt_f.f
new file mode 100644
index 0000000..2077228
--- /dev/null
+++ b/eg/subt/subt_f.f
@@ -0,0 +1,15 @@
+C /* subt_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires subt.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine subt(v, w, a)
+ implicit none
+ character *(*) v(4), w(4)
+ real a
+ print*,'SUBT:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'SUBT:len(w(1 or 2 or 3)) =',len(w(1))
+ print*,'SUBT:a = ',a
+ print*,'SUBT:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
+ print*,'SUBT:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
+ return
+ end
diff --git a/eg/sz/sz.C b/eg/sz/sz.C
new file mode 120000
index 0000000..637681f
--- /dev/null
+++ b/eg/sz/sz.C
@@ -0,0 +1 @@
+sz.c
\ No newline at end of file
diff --git a/eg/sz/sz.c b/eg/sz/sz.c
new file mode 100644
index 0000000..93148eb
--- /dev/null
+++ b/eg/sz/sz.c
@@ -0,0 +1,29 @@
+/* sz.c == sz.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires sz_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#include "cfortran.h"
+
+
+#define sz_ELEMS_1 ZTRINGV_ARGS(3)
+#define sz_ELEMLEN_1 ZTRINGV_NUM(6)
+#define sz_ELEMS_2 ZTRINGV_NUM(4)
+#define sz_ELEMLEN_2 ZTRINGV_NUM(8)
+ PROTOCCALLSFSUB3(SZ,sz, PZTRINGV, ZTRINGV, INT)
+#define SZ(A,B,C) CCALLSFSUB3(SZ,sz, PZTRINGV, ZTRINGV, INT, A, B, C)
+
+int main() {
+static char v[][7] = {"000 ", "1", "22", " "};
+static char w[][9] = {" ", "bb","ccc ","dddd"};
+SZ(v, w, 4);
+printf("main:v=%s,%s,%s,%s. PZTRINGV => Has had trailing blanks stripped.\n",
+ v[0],v[1],v[2],v[3]);
+printf("main:w=%s,%s,%s,%s. ZTRINGV => malloc'd copy for FORTRAN=> C intact.\n"
+ ,w[0],w[1],w[2],w[3]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/sz/sz_f.f b/eg/sz/sz_f.f
new file mode 100644
index 0000000..e752e20
--- /dev/null
+++ b/eg/sz/sz_f.f
@@ -0,0 +1,15 @@
+C /* sz_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires sz.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine sz(v, w, i)
+ implicit none
+ integer i,j
+ character *(*) v(i), w(i)
+ print*,'SZ:len(v(1 or 2 or 3 or 4)) =',len(v(1))
+ print*,'SZ:len(w(1 or 2 or 3)) =',len(w(1))
+ do 100 j = 1,i
+ print*,'SZ:v(',j,') =',v(j),' w(',j,') =',w(j)
+100 continue
+ return
+ end
diff --git a/eg/sz1/sz1.C b/eg/sz1/sz1.C
new file mode 120000
index 0000000..c733f71
--- /dev/null
+++ b/eg/sz1/sz1.C
@@ -0,0 +1 @@
+../eg/sz1/sz1.c
\ No newline at end of file
diff --git a/eg/sz1/sz1.c b/eg/sz1/sz1.c
new file mode 100644
index 0000000..a45b9f8
--- /dev/null
+++ b/eg/sz1/sz1.c
@@ -0,0 +1,36 @@
+/* sz1.c == sz1.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires sz1_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+#define sz1_ELEMS_3 ZTRINGV_ARGS(4)
+#define sz1_ELEMLEN_3 ZTRINGV_NUM(8)
+ PROTOCCALLSFSUB4(SZ1,sz1, STRINGV,INT,ZTRINGV,INT)
+#define SZ1(S,IS,Z,IZ) CCALLSFSUB4(SZ1,sz1, STRINGV,INT,ZTRINGV,INT, S,IS,Z,IZ)
+
+int main() {
+char *p;
+static char s[][7]={"000 ", " "} , os[][3]={"s"}, as[ ]="one element";
+static char z[][9]={" ", "bb","ccc "}, oz[][9]={"z"}, az[6]="1234";
+
+/*
+ - z[][9] must match ZTRINGV_NUM(8), while az[6] does not have to
+ since a single element argument may have the wrong length.
+ - For arrays of strings, can pass a pointer for ZTRINGV, but not for STRINGV.
+ i.e. Can't determine sizes for STRINGV, that's why we have ZTRINGV.
+ - NEITHER STRINGV nor ZTRINGV can accept an array of pointers, e.g.
+ NO: { char *p[3]; p[0]=z[0]; p[1]=z[1]; p[2]=z[2]; SZ1(s, 2, p, 3); }
+ */
+
+p = (char *)z;
+SZ1(s , 2, p , 3);
+SZ1(s[1], 1, z[1] , 1);
+SZ1(os , 1, oz , 1);
+SZ1(as , 1, az , 1);
+SZ1("hi", 1, "hoho", 1);
+
+return EXIT_SUCCESS;
+}
diff --git a/eg/sz1/sz1_f.f b/eg/sz1/sz1_f.f
new file mode 100644
index 0000000..b109abc
--- /dev/null
+++ b/eg/sz1/sz1_f.f
@@ -0,0 +1,17 @@
+C /* sz1_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires sz1.c */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine sz1(s, is, z, iz)
+ implicit none
+ integer is,iz,j
+ character *(*) s(is), z(iz)
+ print*,'SZ1:len(s(1)) =',len(s(1)), ' len(z(1)) =',len(z(1))
+ do 100 j = 1,is
+ print*,'SZ1:s(',j,') =',s(j),'.'
+100 continue
+ do 200 j = 1,iz
+ print*,'SZ1:z(',j,') =',z(j),'.'
+200 continue
+ return
+ end
diff --git a/eg/user/user.C b/eg/user/user.C
new file mode 120000
index 0000000..7f428b5
--- /dev/null
+++ b/eg/user/user.C
@@ -0,0 +1 @@
+user.c
\ No newline at end of file
diff --git a/eg/user/user.c b/eg/user/user.c
new file mode 100644
index 0000000..d09347f
--- /dev/null
+++ b/eg/user/user.c
@@ -0,0 +1,39 @@
+/* user.c == user.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires user_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* We define a new type USERINT. [Same functionality as PINT actually.] */
+
+#ifdef OLD_VAXC /* To avoid %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#define USERINT_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F)
+#define USERINT_cfSEP(T, B) SIMPLE_cfSEP(T,B)
+#define USERINT_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z)
+#define USERINT_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E)
+#define USERINT_cfCC( T,A,B) SIMPLE_cfCC(T,A,B)
+#define USERINT_cfAA( T,A,B) USERINT_cfB(T,A)
+#define USERINT_cfU( T,A) USERINT_cfN(T,A)
+
+#define USERINT_cfN( T,A) int *A
+#define USERINT_cfB( T,A) &(A)
+
+#ifdef OLD_VAXC /* Have avoided %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+ PROTOCCALLSFSUB2(EASY,easy, USERINT, INT)
+#define EASY(A,B) CCALLSFSUB2(EASY,easy, USERINT, INT, A, B)
+
+main() {
+int a;
+printf("\nUsing user defined USERINT argument type.\n");
+EASY(a,7);
+printf("The FORTRAN routine EASY(a,7) returns a = %d\n", a);
+return EXIT_SUCCESS;
+}
diff --git a/eg/user/user_f.f b/eg/user/user_f.f
new file mode 120000
index 0000000..f7b58bb
--- /dev/null
+++ b/eg/user/user_f.f
@@ -0,0 +1 @@
+../easy/easy_f.f
\ No newline at end of file
diff --git a/eg/v7/v7.C b/eg/v7/v7.C
new file mode 120000
index 0000000..265b28f
--- /dev/null
+++ b/eg/v7/v7.C
@@ -0,0 +1 @@
+v7.c
\ No newline at end of file
diff --git a/eg/v7/v7.c b/eg/v7/v7.c
new file mode 100644
index 0000000..ba575a5
--- /dev/null
+++ b/eg/v7/v7.c
@@ -0,0 +1,52 @@
+/* v7.c == v7.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires v7_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* DOUBLE_PRECISION, instead of double, is only required for CRAY (not T3E). */
+
+DOUBLE_PRECISION Cv7(DOUBLE_PRECISION d[2][3][5][7][11][13][1])
+{
+DOUBLE_PRECISION t=0;
+int i,j,k,l,m,n,o;
+for ( i=0; i< 2; i++)
+ for ( j=0; j< 3; j++)
+ for ( k=0; k< 5; k++)
+ for ( l=0; l< 7; l++)
+ for ( m=0; m<11; m++)
+ for ( n=0; n<13; n++)
+ for (o=0; o< 1; o++) t += d[i][j][k][l][m][n][o];
+return t;
+}
+FCALLSCFUN1(DOUBLE,Cv7,CV7,cv7, DOUBLEVVVVVVV)
+
+
+PROTOCCALLSFFUN1(DOUBLE,V7,v7,DOUBLEVVVVVVV)
+#define V7(D) CCALLSFFUN1(V7,v7, DOUBLEVVVVVVV, D)
+
+main()
+{
+/* Original d[2][3][5][7][11][13][17] died a SEGV on DECstation MIPS cc 2.10,
+ just like e.g. main() {double d[2][3][5][7][11][13][17], t=0;} */
+
+DOUBLE_PRECISION d[2][3][5][7][11][13][1], t=0, r=1, tf;
+int i,j,k,l,m,n,o;
+for ( i=0; i< 2; i++)
+ for ( j=0; j< 3; j++)
+ for ( k=0; k< 5; k++)
+ for ( l=0; l< 7; l++)
+ for ( m=0; m<11; m++)
+ for ( n=0; n<13; n++)
+ for (o=0; o< 1; o++) {
+ r /= 2;
+ t += r;
+ d[i][j][k][l][m][n][o] = r;
+ }
+tf=V7(d);
+printf("main() filled array d with a total: %10.9f\n", (double)t );
+printf("V7() returned the value: %10.9f\n", (double)tf);
+return EXIT_SUCCESS;
+} /* cast req.d for CRAY -^ */
diff --git a/eg/v7/v7_f.f b/eg/v7/v7_f.f
new file mode 100644
index 0000000..d371d53
--- /dev/null
+++ b/eg/v7/v7_f.f
@@ -0,0 +1,22 @@
+C /* v7_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires v7.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ double precision function v7(d)
+ implicit none
+ external cv7
+ double precision d(1,13,11,7,5,3,2), cv7
+ integer i,j,k,l,m,n,o
+ print *, 'function cv7 returns the value ', cv7(d)
+ v7 = 0
+ do 1 i=1, 2
+ do 1 j=1, 3
+ do 1 k=1, 5
+ do 1 l=1, 7
+ do 1 m=1, 11
+ do 1 n=1, 13
+ do 1 o=1, 1
+ v7 = v7 + d(o,n,m,l,k,j,i)
+1 continue
+ return
+ end
diff --git a/eg/vv/vv.C b/eg/vv/vv.C
new file mode 120000
index 0000000..d44a6f8
--- /dev/null
+++ b/eg/vv/vv.C
@@ -0,0 +1 @@
+vv.c
\ No newline at end of file
diff --git a/eg/vv/vv.c b/eg/vv/vv.c
new file mode 100644
index 0000000..a06d233
--- /dev/null
+++ b/eg/vv/vv.c
@@ -0,0 +1,47 @@
+/* vv.c == vv.C */ /* anonymous ftp at zebra.desy.de */
+/* An example from cfortran.h package. Requires vv_f.f */
+/* Burkhard Burow burow at desy.de 1990 - 1997. */
+
+#include <stdio.h>
+#include <stdlib.h> /* EXIT_SUCCESS */
+#include "cfortran.h"
+
+/* FORTRAN_REAL, instead of float, is only required for CRAY T3E. */
+/* DOUBLE_PRECISION, instead of double, is only required for CRAY (not T3E). */
+
+void Cvv(DOUBLE_PRECISION d[2][2], FORTRAN_REAL f[2][2], int i[2][2])
+{
+int j,k; double t[2][2];
+for (j=0; j<2; j++) for (k=0; k<2; k++) {
+ t[j][k] = d[j][k];
+ d[j][k] = f[j][k];
+ f[j][k] = i[j][k];
+ i[j][k] = t[j][k];
+}
+return;
+}
+FCALLSCSUB3(Cvv,CVV,cvv, DOUBLEVV, FLOATVV, INTVV)
+
+
+ PROTOCCALLSFSUB3(VV,vv, DOUBLEVV, FLOATVV, INTVV)
+#define VV(D,F,I) CCALLSFSUB3(VV,vv, DOUBLEVV, FLOATVV, INTVV, D, F, I)
+
+main()
+{
+DOUBLE_PRECISION d[2][2];
+FORTRAN_REAL f[2][2];
+int i[2][2];
+int j,k;
+for (j=0; j<2; j++) for (k=0; k<2; k++) {
+ d[j][k] = 100+10*j+k;
+ f[j][k] = 200+10*j+k;
+ i[j][k] = 300+10*j+k;
+}
+VV(d,f,i);
+ /* \/- cast req.d for CRAY. */
+printf("%4.0f%4.0f%4.0f%4.0f\n",(double)d[0][0],(double)d[0][1],
+ (double)d[1][0],(double)d[1][1]);
+printf("%4.0f%4.0f%4.0f%4.0f\n",f[0][0],f[0][1],f[1][0],f[1][1]);
+printf("%4d%4d%4d%4d\n" ,i[0][0],i[0][1],i[1][0],i[1][1]);
+return EXIT_SUCCESS;
+}
diff --git a/eg/vv/vv_f.f b/eg/vv/vv_f.f
new file mode 100644
index 0000000..70551e4
--- /dev/null
+++ b/eg/vv/vv_f.f
@@ -0,0 +1,12 @@
+C /* vv_f.f */ /* anonymous ftp at zebra.desy.de */
+C /* An example from cfortran.h package. Requires vv.c or .C */
+C /* Burkhard Burow burow at desy.de 1990 - 1996. */
+
+ subroutine vv(d,f,i)
+ implicit none
+ double precision d(2,2)
+ real f(2,2)
+ integer i(2,2)
+ call cvv(d,f,i)
+ return
+ end
--
UNNAMED PROJECT
More information about the debian-science-commits
mailing list