Andrew Cooke | Contents | Latest | RSS | Previous | Next

C[omp]ute

Welcome to my blog, which was once a mailing list of the same name and is still generated by mail. Please reply via the "comment" links.

Always interested in offers/projects/new ideas. Eclectic experience in fields like: numerical computing; Python web; Java enterprise; functional languages; GPGPU; SQL databases; etc. Based in Santiago, Chile; telecommute worldwide. CV; email.

Personal Projects

Choochoo Training Diary

Last 100 entries

[Computing] Okular and Postscript in OpenSuse; There's a fix!; [Computing] Fail2Ban on OpenSuse Leap 15.3 (NFTables); [Cycling, Computing] Power Calculation and Brakes; [Hardware, Computing] Amazing Pockit Computer; Bullying; How I Am - 3 Years Post Accident, 8+ Years With MS; Collaboration request; [USA Politics] In America's Uncivil War Republicans Are The Aggressors; [Programming] Selenium and Python; Better Walking Data; [Bike] How Fast Before Walking More Efficient Than Cycling?; [COVID] Coronavirus And Cycling; [Programming] Docker on OpenSuse; Cadence v Speed; [Bike] Gearing For Real Cyclists; [Programming] React plotting - visx; [Programming] React Leaflet; AliExpress Independent Sellers; Applebaum - Twilight of Democracy; [Politics] Back + US Elections; [Programming,Exercise] Simple Timer Script; [News] 2019: The year revolt went global; [Politics] The world's most-surveilled cities; [Bike] Hope Freehub; [Restaurant] Mama Chau's (Chinese, Providencia); [Politics] Brexit Podcast; [Diary] Pneumonia; [Politics] Britain's Reichstag Fire moment; install cairo; [Programming] GCC Sanitizer Flags; [GPU, Programming] Per-Thread Program Counters; My Bike Accident - Looking Back One Year; [Python] Geographic heights are incredibly easy!; [Cooking] Cookie Recipe; Efficient, Simple, Directed Maximisation of Noisy Function; And for argparse; Bash Completion in Python; [Computing] Configuring Github Jekyll Locally; [Maths, Link] The Napkin Project; You can Masquerade in Firewalld; [Bike] Servicing Budget (Spring) Forks; [Crypto] CIA Internet Comms Failure; [Python] Cute Rate Limiting API; [Causality] Judea Pearl Lecture; [Security, Computing] Chinese Hardware Hack Of Supermicro Boards; SQLAlchemy Joined Table Inheritance and Delete Cascade; [Translation] The Club; [Computing] Super Potato Bruh; [Computing] Extending Jupyter; Further HRM Details; [Computing, Bike] Activities in ch2; [Books, Link] Modern Japanese Lit; What ended up there; [Link, Book] Logic Book; Update - Garmin Express / Connect; Garmin Forerunner 35 v 230; [Link, Politics, Internet] Government Trolls; [Link, Politics] Why identity politics benefits the right more than the left; SSH Forwarding; A Specification For Repeating Events; A Fight for the Soul of Science; [Science, Book, Link] Lost In Math; OpenSuse Leap 15 Network Fixes; Update; [Book] Galileo's Middle Finger; [Bike] Chinese Carbon Rims; [Bike] Servicing Shimano XT Front Hub HB-M8010; [Bike] Aliexpress Cycling Tops; [Computing] Change to ssh handling of multiple identities?; [Bike] Endura Hummvee Lite II; [Computing] Marble Based Logic; [Link, Politics] Sanity Check For Nuclear Launch; [Link, Science] Entropy and Life; [Link, Bike] Cheap Cycling Jerseys; [Link, Music] Music To Steal 2017; [Link, Future] Simulated Brain Drives Robot; [Link, Computing] Learned Index Structures; Solo Air Equalization; Update: Higher Pressures; Psychology; [Bike] Exercise And Fuel; Continental Race King 2.2; Removing Lowers; Mnesiacs; [Maths, Link] Dividing By Zero; [Book, Review] Ray Monk - Ludwig Wittgenstein: The Duty Of Genius; [Link, Bike, Computing] Evolving Lacing Patterns; [Jam] Strawberry and Orange Jam; [Chile, Privacy] Biometric Check During Mail Delivery; [Link, Chile, Spanish] Article on the Chilean Drought; [Bike] Extended Gear Ratios, Shimano XT M8000 (24/36 Chainring); [Link, Politics, USA] The Future Of American Democracy; Mass Hysteria; [Review, Books, Links] Kazuo Ishiguro - Never Let Me Go; [Link, Books] David Mitchell's Favourite Japanese Fiction; [Link, Bike] Rear Suspension Geometry; [Link, Cycling, Art] Strava Artwork; [Link, Computing] Useful gcc flags; [Link] Voynich Manuscript Decoded; [Bike] Notes on Servicing Suspension Forks

© 2006-2017 Andrew Cooke (site) / post authors (content).

Calling C From Fortran 95

From: andrew cooke <andrew@...>

Date: Fri, 22 May 2015 16:36:53 -0300

I am stumbling around in the dark here, and there's minimal help and examples
on the neet, so the following may be help to someone.

This C routine:

  int evresp_1(char *sta, char *cha, char *net, char *locid, char *datime,
        char *units, char *file, double *freqs, int nfreqs, double *resp,
        char *rtype, char *verbose, int start_stage, int stop_stage,
        int stdio_flag, int useTotalSensitivityFlag, double x_for_b62,
        int xml_flag);

Can be called by this Fortran code:

      program evtest

      implicit none

      call wresp()

      end program evtest


      subroutine wresp()

      use iso_c_binding, only: c_loc, c_int, c_double
      implicit none

      interface
         integer(kind=c_int) function evresp(
     &        sta, cha, net, loc, datime, units, file,
     &        freq, npts, resp, rtype, vbs,
     &        start_stage, stop_stage, stdio_flag, sens_flag,
     &        b62_x, xml_flag) bind(C, name="evresp_1")
         use iso_c_binding, only: c_char, c_double, c_int, c_ptr
         character(kind=c_char) :: 
     &        sta(*), cha(*), net(*), loc(*),
     &        datime(*), units(*), file(*), rtype(*), vbs(*)
         integer(kind=c_int), value :: 
     &        npts, start_stage, stop_stage, stdio_flag, sens_flag,
     &        xml_flag
         type(c_ptr), value :: freq, resp
         real(kind=c_double), value :: b62_x
         end function evresp
      end interface

      character*1 :: sta = "*", net = "*", loc = "*"
      character*3 :: cha = "VMZ"
      character*8 :: datime = "2010,260"
      character*3 :: units = "VEL"
      character*21 :: file = "../data/station-1.xml"
      integer(kind=c_int), parameter :: npts = 100
      real(kind=c_double), target :: freq(npts), resp(2*npts)
      character*2 :: rtype = "CS"
      character*2 :: vbs = "-v"
      integer(kind=c_int) :: 
     &     start_stage = 1, stop_stage = 1, stdio_flag = 0, 
     &     sens_flag = 0, xml_flag = 1, iflag
      real(kind=c_double) :: b62_x = 3

      real(8), parameter :: flow = 0.0001, fhigh = 100
      real(8), parameter :: df = (log10(fhigh) - log10(flow)) / (npts-1)
      integer :: i
      real(8) :: rl, im, amp, phase, pi = 3.14159265358979

      do i = 1, npts
         freq(i) = 10**(log10(flow) + (i-1) * df)
      end do

      iflag = evresp(
     &     sta//char(0), cha//char(0), net//char(0), loc//char(0),
     &     datime//char(0), units//char(0), file//char(0), 
     &     c_loc(freq(1)), npts, c_loc(resp(1)), rtype//char(0), 
     &     vbs//char(0), start_stage, stop_stage, stdio_flag, sens_flag,
     &     b62_x, xml_flag)

      print *, "return value", iflag
      if (iflag .eq. 0) then
      
         open(1, file="evtest.out")
         do i = 1, npts
            rl = resp(2*i-1)
            im = resp(2*i)
            amp = sqrt(rl**2 + im**2)
            phase = atan2(im, rl) * 180. / pi
            write(1,'(3e15.6)') freq(i), amp, phase
         end do
         close(1)

      end if

      end subroutine wresp

That may not seem very impressive, but note that everything is using C's
calling conventions.  There are no extra lengths for strings, and arrays of
doubles are passed as pointers.

Andrew

Comment on this post