new fortran C mixed programing examples added and binary files removed

Author: Foadsf

A_fortran/readme.txt

@@ -5,17 +5,15 @@ mixed language programing
 call fortran functions/subroutines
 interface the function calls
 
-source:
-1. http://www.yolinux.com/TUTORIALS/LinuxTutorialMixingFortranAndC.html
 
 
 sources to be looked at:
-1. https://msdn.microsoft.com/en-us/library/aa293328(v=vs.60).aspx
-2. http://docs.cray.com/books/S-2179-52/html-S-2179-52/ppgzmrwh.html
-3. http://arnholm.org/software/cppf77/cppf77.htm
+1.
+2.
+3. http://arnholm.org/software/cppf77/cppf77.htm --> test35
 4. http://www.nag.com/lapack-ex/node1.html#sec:Introduction
 5. http://physics.oregonstate.edu/~landaur/nacphy/lapack/fortran.html
-6. http://www.fortran.com/the-fortran-company-homepage/fortran-tools-libraries-and-application-software/
+6. http://www.fortran.com/the-fortran-company-homepage/fortran-tools-libraries-and-application-software/ --> Fortran Tools, Libraries, and Application Software
 7. iso_c_binding
 8. https://docs.oracle.com/cd/E19059-01/stud.9/817-6694/11_cfort.html
 9. https://www.math.utah.edu/software/c-with-fortran.html
@@ -27,6 +25,7 @@ sources to be looked at:
 15. http://www.unidata.ucar.edu/software/netcdf/examples/programs/
 16. http://people.sc.fsu.edu/~jburkardt/c_src/mixed/mixed.html
 17. https://docs.oracle.com/cd/E19422-01/819-3685/11_cfort.html
+18. cfortran--> http://www-zeus.desy.de/~burow/cfortran/
 
 
 points:
@@ -38,3 +37,5 @@ issues:
 1. test22 result not correct
 2. test19 does not compile
 3. test24 not compiling
+4. test4 not compiling
+5. test34 not compiling

A_fortran/test23/tstfunc1.f

@@ -4,7 +4,7 @@ subroutine tstfunc()
           common /test/ delta
           integer i,j
           do i = 1, 5
-              do j = 1, 5
+             do j = 1, 5
                 if (i.ne.j) then
                   delta(i,j)=0
                 else

A_fortran/test25/Makefile

@@ -0,0 +1,11 @@
+/*  File CSUBS.C  */
+
+#include <math.h>
+
+int Fact(int n) {
+  if (n > 1)
+    return (n * Fact(n - 1));
+  return 1;
+}
+
+void Pythagoras(float a, float b, float *c) { *c = sqrt(a * a + b * b); }

A_fortran/test25/readme.txt

@@ -0,0 +1,18 @@
+C   File FORMAIN.FOR
+C
+      INTERFACE TO INTEGER*4 FUNCTION Fact [C,ALIAS:'_Fact'] (n)
+      INTEGER*4 n [VALUE]
+      END
+
+      INTERFACE TO SUBROUTINE Pythagoras [C,ALIAS:'_Pythagoras'] (a,b,c)
+      REAL*4 a [VALUE]
+      REAL*4 b [VALUE]
+      REAL*4 c [REFERENCE]
+      END
+
+      INTEGER*4 Fact
+      REAL*4 c
+      WRITE (*,*) 'Factorial of 7 is ', Fact (7)
+      CALL Pythagoras (30, 40, c)
+      WRITE (*,*) 'Hypotenuse if sides 30, 40 is ', c
+      END

A_fortran/test26/readme.txt

@@ -0,0 +1,9 @@
+all:
+	gfortran -c FORMAIN.FOR
+	gcc -c CSUBS.C
+	gfortran -o result.out FORMAIN.o CSUBS.o  
+	rm -rf *.o
+
+
+clean :
+	rm -rf *.out *~ *.bak *.o

A_fortran/test27/readme.txt

@@ -0,0 +1,16 @@
+source: https://msdn.microsoft.com/en-us/library/aa279034(v=vs.60).aspx
+
+isues:
+not compiling:
+
+
+FORMAIN.FOR:3:26:
+
+     INTERFACE TO INTEGER*4 FUNCTION Fact [C,ALIAS:'_Fact'] (n)
+                        1
+Error: Syntax error: Trailing garbage in INTERFACE statement at (1)
+FORMAIN.FOR:4:19:
+
+     INTEGER*4 n [VALUE]
+                 1
+Fatal Error: Coarrays disabled at (1), use '-fcoarray=' to enable

A_fortran/test28/readme.txt

@@ -1,12 +1,15 @@
 #include <cstring>
 #include <iostream>
+
 using namespace std;
+
 extern "C" {
 extern struct {
   double x;
   int a, b, c;
   char s10[10];
 } abc_;
+
 void cpps_() {
   cout << "cpps1: begin" << endl;
   abc_.x = 90023.876;

A_fortran/test29/readme.txt

@@ -1 +1,4 @@
 http://www.dtic.mil/dtic/tr/fulltext/u2/a567758.pdf
+
+
+the fortran code calls a C++ function which changes some variables

A_fortran/test3/CSUBS.C

@@ -0,0 +1,28 @@
+C                  Fortran subprogram (ftnfctn.f):
+
+
+      FUNCTION FTNFCTN(STR, LOG)
+
+      REAL FTNFCTN
+      CHARACTER*(*) STR
+      LOGICAL LOG
+
+      COMMON /FLOAT1/FLOAT1
+      COMMON /FLOAT2/FLOAT2
+      REAL FLOAT1, FLOAT2
+      DATA FLOAT2/2.4/          ! FLOAT1 INITIALIZED IN MAIN
+
+C      PRINT CURRENT STATE OF VARIABLES
+       PRINT*, '     IN FTNFCTN: FLOAT1 = ', FLOAT1,
+      1                          ';FLOAT2 = ', FLOAT2
+       PRINT*, '     ARGUMENTS:    STR = "', STR, '"; LOG = ', LOG
+
+C      CHANGE THE VALUES FOR STR(ING) AND LOG(ICAL)
+       STR = 'New Fortran String'
+       LOG = .FALSE.
+
+       FTNFCTN = 123.4
+       PRINT*, '    RETURNING FROM FTNFCTN WITH ', FTNFCTN
+       PRINT*
+       RETURN
+       END

A_fortran/test3/FORMAIN.FOR

@@ -0,0 +1,39 @@
+/*                 C program (main.c):                   */
+
+// #include <fortran.h>
+#include <stdio.h>
+#include <string.h>
+
+/* Declare prototype of the Fortran function. Note the last */
+/* argument passes the length of the first argument. */
+double FTNFCTN_(char *, int *, int);
+
+double FLOAT1 = 1.6;
+double FLOAT2; /* Initialized in FTNFCTN */
+
+int main() {
+  int clogical, ftnlogical, cstringlen;
+  double rtnval;
+  char *cstring = "C Character String";
+
+  /* Convert clogical to its Fortran equivalent */
+  clogical = 1;
+  ftnlogical = _btol(clogical);
+
+  /* Print values of variables before call to Fortran function */
+  printf(" In main: FLOAT1 = %g; FLOAT2 = %g\n", FLOAT1, FLOAT2);
+  printf(" Calling FTNFCTN with arguments:\n");
+  printf(" string = \"%s\"; logical = %d\n\n", cstring, clogical);
+  cstringlen = strlen(cstring);
+  rtnval = FTNFCTN_(cstring, &ftnlogical, cstringlen);
+
+  /* Convert ftnlogical to its C equivalent */
+  clogical = _ltob(&ftnlogical);
+
+  /* Print values of variables after call to Fortran function */
+  printf(" Back in main: FTNFCTN returned %g\n", rtnval);
+  printf(" and changed the two arguments:\n");
+  printf(" string = \"%.*s\"; logical = %d\n", cstringlen, cstring, clogical);
+
+  return 0;
+}

A_fortran/test3/Makefile

@@ -0,0 +1 @@
+source: http://docs.cray.com/books/S-2179-52/html-S-2179-52/ppgzmrwh.html

A_fortran/test3/readme.txt

@@ -0,0 +1,105 @@
+#include <string.h>
+
+/*
+  class CHARACTER
+  ===============
+  A minimal class used when passing string arguments from C++
+  to FORTRAN 77 (received as FORTRAN 77 CHARACTER strings), and
+  subsequently returned back to C++ as properly zero terminated
+  strings.
+
+  Method used for zero-termination:
+  =================================
+  When the CHARACTER destructor is activated the zero-termination
+  of the c-string is automatically managed. Zero termination is
+  also done each time a string array is subscripted using
+  CHARACTER::operator()(size_t index)
+
+  FORTRAN Assumptions:
+  ====================
+  (1) F77 truncates strings when CHARACTER variable is short
+  (2) F77 pads variable with blanks when assigned string is short
+  (3) F77 represents a string as a pointer followed by a length
+  (4) A string array is stored in contiguous memory
+
+  Author: Carsten A. Arnholm, 20-AUG-1995
+
+  Updates:
+      04-MAR-1996 Added features for handling arrays of strings
+      16-MAR-1996 Tested array features, explicit padding included
+      29-JUL-1996 Tested portability to SGI/Unix, moved decl. of destructor
+      04-APR-1997 Using strncpy instead of strcpy in operator=(char* str);
+*/
+
+class CHARACTER {
+public:
+  CHARACTER(char *cstring);
+  CHARACTER(char *cstring, const size_t lstr);
+  ~CHARACTER();
+  CHARACTER operator()(size_t index);
+  void pad(size_t first, size_t howmany = 1);
+  void operator=(char *str);
+  operator char *();
+
+public:
+  char *rep;  // Actual string
+  size_t len; // String length
+};
+
+inline CHARACTER::CHARACTER(char *cstring)
+    : rep(cstring), len(strlen(cstring)){};
+
+inline CHARACTER::CHARACTER(char *cstring, const size_t lstr)
+    : rep(cstring), len(lstr) {
+  // find position from where to start padding
+  size_t slen = strlen(rep);                 // upper limit
+  size_t actual = (slen < len) ? slen : len; // actual <= len.
+  for (size_t i = actual; i < len; i++)
+    rep[i] = ' '; // Do the padding.
+}
+
+inline CHARACTER::~CHARACTER() {
+  if (rep[len] == '\0')
+    return; // catches string constants
+
+  for (int i = len - 1; i >= 0; i--) {
+    if (rep[i] == '\0')
+      break; // already zero terminated
+
+    if (rep[i] != ' ') { // non-blank discovered, so
+      rep[i + 1] = '\0'; // zero-terminate and jump out
+      break;
+    }
+  }
+}
+
+inline CHARACTER CHARACTER::operator()(size_t index) {
+  // Construct a temporary CHARACTER object for the array element
+  // identified by "index" in order to zero-terminate that element
+  size_t pos = index * len;          // start pos of array element
+  CHARACTER element(rep + pos, len); // construct new CHARACTER.
+  return element;                    // destructor called here.
+}
+
+inline void CHARACTER::pad(size_t first, size_t howmany) {
+
+  size_t pos = 0, i = 0, stop = first + howmany - 1;
+  for (size_t index = first; index <= stop; index++) {
+    pos = index * len;
+    size_t slen = strlen(rep + pos); // upper limit
+    size_t actual = (slen < len) ? slen : len;
+    for (i = pos + actual; i < pos + len; i++)
+      rep[i] = ' '; // Do the padding.
+  }
+}
+
+inline void CHARACTER::operator=(char *str) {
+  strncpy(rep, str, len);    // this will copy a zero if str < rep
+  rep[len - 1] = '\0';       // zero terminate in case strncpy did not
+  size_t slen = strlen(rep); // upper limit
+  size_t actual = (slen < len) ? slen : len; // actual <= len.
+  for (size_t i = actual; i < len; i++)
+    rep[i] = ' '; // Do the padding.
+}
+
+inline CHARACTER::operator char *() { return rep; }

A_fortran/test30/readme.txt

@@ -0,0 +1,61 @@
+/*
+  class COMPLEX
+  =============
+  A minimal class used when passing complex arithmetic variables
+  from C++ to FORTRAN 77.
+
+  The template parameter is used for specification of precision:
+
+  COMPLEX<float>  is equivalent to F77 COMPLEX
+  COMPLEX<double> is equivalent to F77 DOUBLE COMPLEX
+
+  Author: Carsten A. Arnholm,
+  Updates:
+      04-MAR-1996 initial, non-template version
+      14-MAY-1996 Template version
+      29-JUL-1996 Tested portability to SGI/Unix,
+                  corrected operator=(const COMPLEX<T>& )
+*/
+
+#ifdef real
+// some people define real as a macro
+#undef real
+#pragma message(__FILE__ " : warning: 'real' macro definition cancelled")
+#endif
+
+template <class T> class COMPLEX {
+public:
+  COMPLEX();
+  COMPLEX(const COMPLEX<T> &);
+  COMPLEX(const T &re, const T &im);
+  COMPLEX<T> &operator=(const COMPLEX<T> &);
+  ~COMPLEX();
+  const T &real();
+  const T &imag();
+
+private:
+  T m_re;
+  T m_im;
+};
+
+template <class T> inline COMPLEX<T>::COMPLEX() : m_re(T()), m_im(T()) {}
+
+template <class T>
+inline COMPLEX<T>::COMPLEX(const COMPLEX<T> &copy)
+    : m_re(copy.m_re), m_im(copy.m_im) {}
+
+template <class T>
+inline COMPLEX<T>::COMPLEX(const T &re, const T &im) : m_re(re), m_im(im) {}
+
+template <class T>
+inline COMPLEX<T> &COMPLEX<T>::operator=(const COMPLEX<T> &copy) {
+  m_re = copy.m_re;
+  m_im = copy.m_im;
+  return *this;
+}
+
+template <class T> inline COMPLEX<T>::~COMPLEX() {}
+
+template <class T> inline const T &COMPLEX<T>::real() { return m_re; }
+
+template <class T> inline const T &COMPLEX<T>::imag() { return m_im; }