NCL Home > Documentation > Tools

WRAPIT


Introduction to WRAPIT

If you have a Fortran function or procedure that you'd like to call from NCL, you can do it by "wrapping" this function using the WRAPIT script. WRAPIT works on many UNIX systems including Sun, Linux, AIX, and MacOSX. It does not currently work under Cygwin/Windows. This document does not cover how to wrap C code. For details on this, see the "Extending the NCL function and procedure set" section in the NCL Reference Manual.

In order to use WRAPIT, you must have a C compiler and a Fortran 77 or 90 compiler. WRAPIT will look for these compilers on your system and exit if it can't find them.

In version 5.1.1, on Linux, MacOS, and FreeBSD systems, it will try to use the "gfortran" compiler by default. Before this version, "g77" was the default. You can use the new "-g77" option if you need to use "g77".
When you run WRAPIT on the Fortran code you want to call from NCL, it creates a special C wrapper file, compiles it and the Fortran file, and then generates a *.so file that you can then load into NCL using the "external" statement.

Steps for using WRAPIT

To use WRAPIT, you must follow these three steps:

  • Step 1 - Write special wrapper text
  • Step 2 - Run WRAPIT
  • Step 3 - Load the shared object and call the routine

Step 1

Fortran 77 - Add special wrapper text to Fortran 77 code:

If you have a Fortran 77 routine, use the special interface delimiters "C NCLFORTSTART" and "C NCLEND" to bracket the argument declarations right within the Fortran code. There shouldn't be any extra lines between "C NCLFORTSTART" and the subroutine line.

For example, assume you have a Fortran code called "ex01.f":

C NCLFORTSTART
      subroutine cquad (a, b, c, nq, x, quad)
      real x(nq), quad(nq)
C NCLEND
C
C  Calculate quadratic polynomial values.
C
      do 10 i=1,nq
        quad(i) = a*x(i)**2 + b*x(i) + c
   10 continue

      return
      end

C NCLFORTSTART
      function arcln (numpnt, pointx, pointy)
      dimension pointx(numpnt),pointy(numpnt)
C NCLEND

C
C  Calculate arc lengths.
C
      if (numpnt .lt. 2) then
        print *, 'arcln: number of points must be at least 2'
        stop
      endif
      arcln = 0.
      do 10 i=2,numpnt
        pdist = sqrt((pointx(i)-pointx(i-1))**2 + 
     +                        (pointy(i)-pointy(i-1))**2)
        arcln = arcln + pdist
   10 continue

      return
      end

Only the argument variables should be included between the delimiters. If a particular variable is not typed, then the usual Fortran rules will apply for typing. Additionally, only the Fortran subroutine(s) actually called from NCL require the interface delimiters. The rest of the Fortran code may include other subroutines without delimiters.

Fortran 90 - Write special wrapper text as separate file:

If you have a Fortran 90 file, then you need to create a separate "stub" file that contains the "C NCLFORTSTART" and "C NCLEND" delimiters. For example, assume the above "cquad" routine was in a Fortran 90 file called "cquad.f90":

subroutine cquad(a,b,c,nq,x,quad)
  implicit none
  integer, intent(in)  ::nq
  real,    intent(in)  ::a,b,c,x(nq)
  real,    intent(out) ::quad(nq)
  integer              ::i

  quad = a*x**2+b*x+c
  return
end subroutine cquad

Create a separate file, called something like "cquad90.stub" that contains nothing more than the following lines:

C NCLFORTSTART
      subroutine cquad(a,b,c,nq,x,quad)
      real a,b,c
      integer nq
      dimension x(nq),quad(nq)
C NCLEND

Commercial library routine - Write special wrapper text as separate file:

If there's a commercial library routine you want to call from NCL, use the same method as with the Fortran 90 routine to create a separate "stub" file.

For example, assume you want to call the IMSL routine "rline" to fit a line to a set of data points via least-squares. The "rline" arguments are rline(nobs,x,y,b0,b1,stat) where "nobs" is the number of observations, "x" and "y" are the data vectors, "b0" and "b1" are the intercept and slope, and "stat" is a vector of length 12 containing assorted statistics. The Fortran stub file you create (call it "rline.stub") would look like:

C NCLFORTSTART
      subroutine rline (n,x,y,b0,b1,stat)
      integer n                                ! explicit typing NOT required
      real    x(n), y(n), b0, b1, stat(12)
C NCLEND

Step 2 - Run WRAPIT

Fortran 77 - Run WRAPIT to compile the external code(s):

Run WRAPIT on your code to generate a shared object. It will have the same name as your Fortran file, except with ".so" appended instead of ".f" or ".f90". For the Fortran 77 example:

   WRAPIT ex01.f

This should create a file called "ex01.so".

Fortran 90 - Run WRAPIT to compile the external code(s) and the separate wrapper text:

Using the "cquad90.stub" file you created in the previous step, and assuming "cquad.f90" is the Fortran 90 file that contains the "cquad" subroutine, then you would run WRAPIT as follows:

   WRAPIT cquad90.stub cquad.f90

This should create a file called "cquad90.so".

Commercial library routine - Run WRAPIT to compile the separate wrapper text and link in the commercial library:

To build a shared object that includes a call to one or more commercial library routines, you must include the list of commercial libraries on WRAPIT command line so the shared object will be properly linked:

   WRAPIT -l imsl_mp rline.stub

This should create a file called "rline.so". Note that if WRAPIT gives you an error about being unable to find the commercial library, then you may need to include the "-L" option along with the path to the library:

   WRAPIT -L /opt/lib -l imsl_mp rline.stub

Note for all types of routines:

If WRAPIT does not appear to work, then you can modify the WRAPIT script directly ($NCARG_ROOT/bin/WRAPIT) and change the paths to your appropriate local compilers. WRAPIT does not contain paths to any libraries, so they may have to be added depending upon your system.

Step 3 - Call the shared object from an NCL script

Before you can call external subroutines from your NCL script, you need to load the shared object you created in Step 2. There are two ways to load a shared object:

  1. Use the external statement
  2. Use the NCL_DEF_LIB_DIR environment variable
Loading the shared object using external:

At the top of your NCL script and before the "begin" statement, add an "external" statement to load the shared object, followed by a name you want to give the shared object, followed by the path to the shared object in double quotes.

The name of the shared object is arbitrary, but by convention, is capitalized. If the shared object is in a different directory, be sure to include the path to it (you can use relative or absolute paths). If the shared object is in the same directory as your script, be sure to put a "./" in front of it.

Now, to call any one of your functions or procedures from your NCL script, precede it with two colons ("::") and the name you gave the shared object. The example below is from the Fortran 77 example, and assumes the shared object "ex01.so" is in the same directory as your script:

external EX01 "./ex01.so"
 
begin
;
; Calculate three values of a quadratic equation
;
   nump = 3
   x    = (/ -1., 0.0, 1.0 /)
   qval = new(nump,float)              
   EX01::cquad(-1., 2., 3., nump, x, qval) ; Call the NCL version of
                                           ; your Fortran subroutine.
   print("Polynomial value = " + qval)     ; Should be (/0,3,4/)
 
;
; Calculate an arc length.
;
   xc = (/ 0., 1., 2. /)
   yc = (/ 0., 1., 0. /)
   arclen = EX01::arcln(nump,xc,yc)     ; Call the NCL version of
                                        ; your Fortran function.
   print("Arc length = " + arclen)      ;  should be 2.82843
end

Loading the shared object using an environment variable:

Create a directory on the machine you wish to run NCL, and put your shared object(s) in this directory. Set the environment variable NCL_DEF_LIB_DIR to this path. For example:

setenv NCL_DEF_LIB_DIR /home/haley/shared_objects

NCL will recognize the path given by the NCL_DEF_LIB_DIR environment variable as another place to look for shared objects. You can include multiple directory paths by separating them with colons:

setenv NCL_DEF_LIB_DIR /home/shea/shared_objects/:/home/haley/shared_objects

Now you can call the shared object just like a built-in NCL function:

begin
;
; Calculate three values of a quadratic equation
;
   nump = 3
   x    = (/ -1., 0.0, 1.0 /)
   qval = new(nump,float)              
   cquad(-1., 2., 3., nump, x, qval)       ; Call the NCL version of
                                           ; your Fortran subroutine.
   print("Polynomial value = " + qval)     ; Should be (/0,3,4/)
 
;
; Calculate an arc length.
;
   xc = (/ 0., 1., 2. /)
   yc = (/ 0., 1., 0. /)
   arclen = arcln(nump,xc,yc)           ; Call the NCL version of
                                        ; your Fortran function.
   print("Arc length = " + arclen)      ;  should be 2.82843
end

Be sure to see the section on special considerations for trouble shooting.

Examples

This section contains examples illustrating how to incorporate sample Fortran codes into NCL.

  • Example 1 -- Fortran subroutine and function
  • Example 2 -- Fortran embedded wrapit interface blocks
  • Example 3 -- Fortran subroutine from a commercial library
  • Example 4 -- Fortran subroutine with CHARACTER input and output arguments
  • Example 5 -- Fortran subroutine with a 2-dimensional array; printing
  • Example 6 -- C subroutine and function

Example 1 -- Fortran subroutine and function

Files required: ex01.f / ex01.stub / ex01.ncl

Begin with the Fortran source (in file ex01.f):

      SUBROUTINE CQUAD (A, B, C, NQ, X, QUAD)
      REAL X(NQ),QUAD(NQ)
C
C  Calculate quadratic polynomial values.
C
      DO 10 I=1,NQ
        QUAD(I) = A*X(I)**2 + B*X(I) + C
   10 CONTINUE
C
      RETURN
      END
      FUNCTION ARCLN (NUMPNT, POINTX, POINTY)
      DIMENSION POINTX(NUMPNT),POINTY(NUMPNT)
C
C  Calculate arc lengths.
C
      IF (NUMPNT .LT. 2) THEN
        PRINT *, 'ARCLN: Number of points must be at least 2'
        STOP
      ENDIF
      ARCLN = 0.
      DO 10 I=2,NUMPNT
        PDIST = SQRT((POINTX(I)-POINTX(I-1))**2 + 
     +                        (POINTY(I)-POINTY(I-1))**2)
        ARCLN = ARCLN + PDIST
   10 CONTINUE
C
      RETURN
      END

This first example follows in detail the three step process described above.

Step 1 - define the wrapit interface block.

Create a file ex01.stub that contains the following two wrapit interface blocks:

C NCLFORTSTART
      SUBROUTINE CQUAD (A,B,C,NQ,X,QUAD)
      REAL X(NQ),QUAD(NQ)
C NCLEND
 
C NCLFORTSTART
      FUNCTION ARCLN (NUMPNT,POINTX,POINTY)
      DIMENSION POINTX(NUMPNT),POINTY(NUMPNT)
C NCLEND

Step 2 - run WRAPIT

  WRAPIT ex01.stub ex01.f

Step 3 - tell NCL where your shared object is.

The external statement in the following ex01.ncl example script tells NCL where to look for the dynamic shared object you just created.

external EX01 "./ex01.so"
 
begin
;
; calculate three values of a quadratic equation
;
   nump = 3
   x = (/ -1., 0.0, 1.0 /)
   qval = new(nump,float)              
   EX01::cquad(-1, 2, 3, nump, x, qval) ; call the new NCL version of
                                        ; your original Fortran subroutine
   print("Polynomial value = " + qval)
 
;
; calculate an arc length.
;
   xc = (/ 0., 1., 2. /)
   yc = (/ 0., 1., 0. /)
   arclen = EX01::arcln(nump,xc,yc)     ; call the new NCL version of
                                        ; your original Fortran function
   print("Arc length = " + arclen)
 
end

If you submit the above script to the NCL interpreter, it produces the output:

opening: ./ex01.so
(0)     Polynomial value = 0
(1)     Polynomial value = 3
(2)     Polynomial value = 4
(0)     Arc length = 2.82843

The numbers in parentheses at the left in the above printout are an artifact of how the NCL print function works and are of no relevance in this example.

Example 2 -- Fortran embedded wrapit interface blocks

Files required: ex02.f / ex02.ncl

Instead of using a separate stub file as in example 1 above, you could have used the following code (in file ex02.f) as input to WRAPIT:

C NCLFORTSTART
      SUBROUTINE CQUAD (A,B,C,NQ,X,QUAD)
      REAL X(NQ),QUAD(NQ)
C NCLEND
C
C  Calculate quadratic polynomial values.
C
      DO 10 I=1,NQ
        QUAD(I) = A*X(I)**2 + B*X(I) + C
   10 CONTINUE
C
      RETURN
      END

C NCLFORTSTART
      FUNCTION ARCLN (NUMPNT, POINTX, POINTY)
      DIMENSION POINTX(NUMPNT),POINTY(NUMPNT)
C NCLEND
C
C  Calculate arc lengths.
C
      IF (NUMPNT .LT. 2) THEN
        PRINT *, 'ARCLN: Number of points must be at least 2'
        STOP
      ENDIF
      ARCLN = 0.
      DO 10 I=2,NUMPNT
        PDIST = SQRT((POINTX(I)-POINTX(I-1))**2 +
     +                        (POINTY(I)-POINTY(I-1))**2)
        ARCLN = ARCLN + PDIST
   10 CONTINUE
C
      RETURN
      END

In this example, the wrapit interface blocks are embedded directly into the Fortran code, thus avoiding the need to create a separate stub file containing them. All that WRAPIT is looking for in its input is blocks delimited by comment lines containing NCLFORTSTART and NCLEND.

Now execute:

WRAPIT ex02.f

and proceed with step 3 above.

Example 3 -- Fortran subroutine from a commercial library

Suppose you are calling:

      SUBROUTINE LIBSUB(IARG1,RARG)

from a commercial library named libcommercial.a. Using the following wrapit interface block (in file libsub.stub):

C NCLFORTSTART
      SUBROUTINE LIBSUB(IARG,RARG)
      INTEGER IARG
      REAL RARG
C NCLEND

To create a dynamic shared object named libsub.so, use WRAPIT:

  WRAPIT libsub.stub -l commercial

Example 4 -- Fortran subroutine with CHARACTER input and output arguments

Files required: ex04.f / ex04.stub / ex04.ncl

Start with a Fortran subroutine ex04.f that takes an input string and returns a number of letters based on the length of the input string:

      SUBROUTINE EX04 (STRIN,STROUT)
      CHARACTER*(*) STRIN
      CHARACTER*26  STROUT
      CHARACTER*26  ABET
      DATA ABET/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
C
      IMX = MIN(LEN(STRIN),26)
      STROUT = ABET(1:IMX)
C
      RETURN
      END

You could use embedded wrapit interface blocks, as in example 2 above, or use the following ex04.stub wrapit interface block:

C NCLFORTSTART
      SUBROUTINE EX04 (STRIN,STROUT)
      CHARACTER*(*) STRIN
      CHARACTER*26  STROUT
C NCLEND

to create the NCL wrapper and dynamic shared object (named ex04.so). Passing the following ex04.ncl NCL script to the NCL interpreter:

external EXAMPLE04_SO "./ex04.so"
 
begin
 
 cstr = new(26,character)        ;  create a character array of length 26
 EXAMPLE04_SO::ex04("fifteen letters",cstr)
 str = chartostring(cstr)
 print(str)
 
end

produces the output:

opening: ./ex04.so
 
 
Variable: str
Type: string
Total Size: 4 bytes
            1 values
Number of Dimensions: 1
Dimensions and sizes:   [1]
Coordinates: 
(0)     ABCDEFGHIJKLMNO

Example 5 -- subroutine with a 2-dimensional array; printing

Files required: ex05.f / ex05.stub / ex05.ncl

Start with one subroutine ex05.f that calculates a function of two variables and stores the results in a 2-dimensional array, and another subroutine that prints 2-dimensional arrays by rows.

      SUBROUTINE EX05(M,N,X,Y,FXY)
      REAL X(M),Y(N),FXY(M,N)
C
C  Calculate FXY(I,J) = 2*I+J
C
      DO 10 J=1,N
        DO 20 I=1,M
          FXY(I,J) = 2.*REAL(I) + REAL(J)
   20   CONTINUE
   10 CONTINUE
C
      RETURN
      END
      SUBROUTINE PRT2D(M,N,A)
      REAL A(M,N)
C
C  Print the array A by rows using an F6.1 format with
C  7 values per line.
C
      DO 10 J=1,N
        PRINT *,'Row',J,':'
        DO 20 I=1,M/7
          WRITE(6,500) (A(LL,J),LL=(I-1)*7+1,I*7)
  500     FORMAT(7F6.1)
   20   CONTINUE
        IF (MOD(M,7) .NE. 0) WRITE(6,500) (A(LL,J),LL=(M/7)*7+1,M)
        PRINT *,' '
   10 CONTINUE
C
      RETURN
      END

Use the following ex05.stub wrapit interface block:

C NCLFORTSTART
      SUBROUTINE EX05(M,N,X,Y,FXY)
      REAL X(M),Y(N),FXY(M,N)
C NCLEND
C NCLFORTSTART
      SUBROUTINE PRT2D(M,N,A)
      REAL A(M,N)
C NCLEND

to create the NCL wrapper function and the dynamic shared object (named ex05.so). Then the following ex05.ncl NCL script:

external EX05 "./ex05.so"
 
begin
;
; calculate three values of a quadratic equation
;
   m = 11
   n = 3
   x = new(m,float)
   y = new(n,float)
   fxy = new((/n,m/),float)
   EX05::ex05(m,n,x,y,fxy)
   EX05::prt2d(m,n,fxy)
end

will create the 2-dimensional array fxy in a manner compatible with other NCL procedures. Passing the above NCL script to the NCL interpreter produces the output:

opening: ./ex05.so
 Row  1:
     3.0   5.0   7.0   9.0  11.0  13.0  15.0
    17.0  19.0  21.0  23.0
  
 Row  2:
     4.0   6.0   8.0  10.0  12.0  14.0  16.0
    18.0  20.0  22.0  24.0
  
 Row  3:
     5.0   7.0   9.0  11.0  13.0  15.0  17.0
    19.0  21.0  23.0  25.0

Example 6 -- C subroutine and function

This example uses the same NCL code as examples 1 and 2, except this time, "cquad" and "arcln" are implemented in C. This example assumes that you know something about coding in C.

Files required: ex01c.c / ex01W.c / ex01.stub / ex01.ncl

#include <stdio.h>
#include <stdlib.h>
#include <math.h>

void *cquad(float a, float b, float c,int nq, float *x, float *quad)
{
  int i;
/*
 *  Calculate quadratic polynomial values.
 */
  for(i = 0; i < nq; i++ ) quad[i] = a*pow(x[i],2) + b*x[i] + c;
  }
}

float arcln(int numpnt, float *pointx, float *pointy)
{
  int i;
  float pdist, a;
/*
 *  Calculate arc lengths.
 */

  if(numpnt < 2) {
    printf("arcln: number of points must be at least 2\n");
    return;
  }
  a = 0.;
  for( i=1; i < numpnt; i++ ) {
    pdist = sqrt(pow(pointx[i]-pointx[i-1],2) + pow(pointy[i]-pointy[i-1],2));
    a += pdist;
  }
  return(a);
}

WRAPIT will not work on C code directly, but you can still wrap the C code using a Fortran stub and some modifications. Here are the five steps:

  1. Create a Fortran stub that contains the same calling sequence and types for the C subroutines and functions.

    ex01.stub:

    C NCLFORTSTART
          subroutine cquad (a, b, c, nq, x, quad)
          real a, b, c
          real x(nq), quad(nq)
    C NCLEND
    C NCLFORTSTART
          function arcln (numpnt, pointx, pointy)
          integer numpnt
          real pointx(numpnt),pointy(numpnt)
    C NCLEND
    
  2. Run "wrapit77" on the Fortran stub to create the C wrapper.

      wrapit77 < ex01.stub > ex01W.c
    
  3. Modify "ex01W.c" created by the previous command to make a few changes.

    The ex01W.c will contain lines with "NGCALLF". These are the lines you need to modify, as these lines are assuming you are calling a Fortran routine. For example, using, "ex01W.c" above, you would modify these three lines:

            NGCALLF(cquad,CQUAD)(a,b,c,nq,x,quad);
    
    extern float NGCALLF(arcln,ARCLN)();
    
            arcln_ret = NGCALLF(arcln,ARCLN)(numpnt,pointx,pointy);
    
    to be:
            (void)cquad(*a,*b,*c,*nq,x,quad);
    
    extern float arcln(int numpnt, float *pointx, float *pointy);
    
            arcln_ret = arcln(*numpnt,pointx,pointy);
    
    You also need to add an "extern" statement for "cquad" before the "NhlErrorTypes cquad_W( void ){" line:

    extern void *cquad(float a, float b, float c,int nq, float *x, float *quad);
    NhlErrorTypes cquad_W( void ) {
    
  4. Run WRAPIT with the "-d" option on the "ex01.stub" file and examine its output:

      WRAPIT -d ex01.stub
    
    to see what the the individual steps are for creating the "ex01.so" file. You will see a compilation line for a file called "WRAPIT.c". Use this compilation line on both the "ex01W.c" and "ex01c.c" files. (See next step.)

  5. Compile "ex01W.c", "ex01c.c", and create the "ex01.so" file.

    If "WRAPIT -d " echoed this for WRAPIT.c:

      gcc -m64 -c -I/usr/local/include WRAPIT.c
    
    then use these two lines to compile the two C files:

      gcc -m64 -c -I/usr/local/include ex01W.c
      gcc -m64 -c -I/usr/local/include ex01c.c
    
    Finally, look at the end of the WRAPIT output to see how "ex01.so" is created, but substitute ex01W.o and ex01c.o for WRAPIT.o:

    For example, if WRAPIT echoed this:

      gcc -m64 -bundle -flat_namespace -undefined suppress WRAPIT.o -o ex01.so -lgfortran
    
    Then use this instead:

      gcc -m64 -bundle -flat_namespace -undefined suppress ex01W.o ex01c.o -o ex01.so -lgfortran
    
    You can create a Makefile with all the necessary compilations, so you don't have to do it by hand every time:

    ex01.so: ex01W.o ex01c.o
    	gcc -m64 -bundle -flat_namespace -undefined suppress ex01W.o ex01c.o -o ex01.so -lgfortran
    
    ex01c.o: ex01c.c
    	gcc -m64 -c -I{$NCARG_ROOT}/include ex01W.c
    
    ex01W.o: ex01W.c
    	gcc -m64 -c -I{$NCARG_ROOT}/include ex01c.c
    

WRAPIT options

There are some command line options you can use with WRAPIT that are useful for debugging. These options must appear on the WRAPIT command line before the Fortran file names:

-d
Turns on array bounds, turns off optimization, displays some debug information, and prevents file clean up.

-g95
Use the g95 compiler.
-gf
Use the gfortran compiler.

-g77
Use the g77 compiler.

-h or -help
Gives you LOTS of information about WRAPIT, including information about other options.

-in
Use the Intel compiler.

-l <libname>
Passes a library name to the linker.

-L <libpath>
Passes a directory path to the linker. This may be useful if WRAPIT can't find the "gfortran" library.

-lf
Use the Lahey compiler.

-n <so name>
Assigns a name to the created shared object.

-pg
Use the Portland compiler.

-q32
Specifies 32-bit IRIX or AIX bit precision (the default is to use 64-bit precision, if available).

-m32
Specifies 32-bit precision for LINUX or MacOS systems. This only works on 32-bit LINUX or MacOS systems.

-m64
Specifies 64-bit precision for LINUX or MacOS systems. This only works on 64-bit LINUX systems or MacOS 10.6 or higher systems.

-r8
Promotes Fortran floats of real*4 to real*8 (if available).

Special considerations

This section contains several things that you should know to avoid common problems.

  • Unique subroutine names

    You need to make sure that the name of your subroutine doesn't have the same name as a subroutine name used internally by the "ncl" executable. If it does, then your wrapped subroutine may not work properly, and you won't get any helpful error messages about it.

    It's a good idea, then, to stay away from common names like "average" or "gamma".

    To check that your subroutine name is not already part of internal NCL code, use the UNIX "nm" command on the "ncl" executable and search for your routine name.

    For example, say you want to use "gamma" as your subroutine name. To check if "gamma" is already used by NCL:

        nm $NCARG_ROOT/bin/ncl | grep -i gamma
    

    You will see some output like:

        0000000100283a28 T _dgammaslatec_
        00000001002b30df T _dsgamma_
        0000000100272ed2 T _gamma_
        0000000100dd1db3 t _gammafn
        000000010014f5e1 T _gammainc_W
        00000001001a3ed3 T _random_gamma_W
                         U _tgamma
    

    The "T" before the name means there's a routine with that name in the ncl executable. (The underscores should be ignored, as they are added internally by the compilers.) From this list, then, you can see there's a routine called "_gamma_". Hence "gamma" is already a used name, and you need to use a different name, like "mygamma" or "gamma2".

  • Variable names

    Due to a bug in the parser, no variable between the NCLFORTSTART and NCLEND delimiters can be named "data".

  • Array dimensions

    • You can't have dimension subscripts with arithmetic operators:

      C NCLFORTSTART
            subroutine subby (X,Y,Z,N1,N2)
            integer N1,N2
            real X(N1),Y(N2),Z(N1+N2)
      C NCLEND
      
      To fix this, have the calling routine pass in an additional variable that is equal to "N1+N2", and use this instead:
      C NCLFORTSTART
            subroutine subby (X,Y,Z,N1,N2,N1N2)
            integer N1,N2
            real X(N1),Y(N2),Z(N1N2)
      C NCLEND
      
    • You can't have the array dimensions and types on two separate lines:

      C NCLFORTSTART
            subroutine testit (X,N1)
            integer N1
            real X
            dimension X(N1)
      C NCLEND
      
      Put them on the same line instead:

      C NCLFORTSTART
            subroutine testit (X,N1)
            integer N1
            real X(N1)
      C NCLEND
      
    • If you have a multi-dimensional array, you can't wrap a Fortran routine that uses the old-style method of setting the rightmost dimension to 1:

            subroutine subby (X,Y,N)
            real X(N,1), Y(N,1)
      

      To fix this, you can either modify "subby" directly to add an "M" dimension to the input list, or you can create a "driver" subroutine that calls "subby", and then wrap this instead:

      C NCLFORTSTART
            subroutine subbydriver (X,Y,N,M)
            real X(N,M), Y(N,M)
      C NCLEND
            call subby(X,Y,N)
            return
            end
            subroutine subby (X,Y,N)
            real X(N,1), Y(N,1)
      . . .
      
  • Array indexing

    You can't wrap code that has array indexing in the variable declaration:
    C NCLFORTSTART
          subroutine subbee (X,Y,N)
          integer N
          real X(0:N),Y(0:N)
    C NCLEND
          ...
    
    To fix this, you can create a driver program with the same name (rename the original routine to something else):
    C NCLFORTSTART
          subroutine subbee (X,Y,N1)
          integer N1
          real X(N1),Y(N1)
    C NCLEND
          call subbee1(X,Y,N1-1)
          END
    
          subroutine subbee1 (X,Y,N)
          integer N
          real X(0:N),Y(0:N)
          ...
    
  • Array dimensioning

    For NCL arrays, the fastest-varying dimension is the rightmost, while for Fortran it is the leftmost dimension. Therefore, if XA is a Fortran array dimensioned idim x jdim, this array will be dimensioned jdim x idim in NCL. Also, Fortran array subscripts start at 1, whereas NCL array subscripts start at 0. Example 5 in this section illustrates these concepts.

  • Function types

    If you need to wrap a Fortran function that needs to be explicitly typed, then declare the type of the function on the FUNCTION line itself and not on a separate line.

    For example, while the following stub code is perfectly valid Fortran code, it will not work with WRAPIT:

    C NCLFORTSTART
          FUNCTION ARCLN (NUMPNT, POINTX, POINTY)
          DOUBLE PRECISION POINTX(NUMPNT),POINTY(NUMPNT)
          DOUBLE PRECISION ARCLN
    C NCLEND
    

    Use this type of code instead:

    C NCLFORTSTART
          DOUBLE PRECISION FUNCTION ARCLN (NUMPNT, POINTX, POINTY)
          DOUBLE PRECISION POINTX(NUMPNT),POINTY(NUMPNT)
    C NCLEND
    

  • Parameter statements

    WRAPIT can't deal with parameter statements. For example, WRAPIT will not be able to properly handle the following code:

    C NCLFORTSTART
          subroutine expansion(inp, outp, ntime)
          integer ntime,nlon,nlat
          parameter (nlon=144,nlat=60)
          real inp(nlon,nlat,ntime,3), outp(6,nlon,nlat,ntime,3)
    C NCLEND
    

    To fix this, you either need to hard-code the values for nlon and nlat, or pass them in to "expansion".

    First option:

    C NCLFORTSTART
          subroutine expansion(inp, outp, ntime)
          integer ntime
          real inp(144,60,ntime,3), outp(6,144,60,ntime,3)
    C NCLEND
    

    Second option:

    C NCLFORTSTART
          subroutine expansion(inp, outp, ntime, nlat, nlon)
          integer ntime,nlon,nlat
          real inp(nlon,nlat,ntime,3), outp(6,nlon,nlat,ntime,3)
    C NCLEND
    

  • Arrays of character strings

    Currently, the wrapper code used by WRAPIT honors only non-dimensioned Fortran type CHARACTER variables. You cannot pass arrays of NCL strings to Fortran, nor can you pass Fortran CHARACTER arrays from Fortran back to NCL.

  • Passing strings from NCL to Fortran

    If you want to pass an NCL variable of type string to a Fortran procedure, then the argument to the Fortran procedure must be declared as CHARACTER*(*). See example 4 in this section.

  • Passing Fortran CHARACTER variables to NCL

    If you want to pass a Fortran CHARACTER variable back to NCL, then the Fortran argument must be a variable of type CHARACTER of fixed length, and the corresponding NCL variable must be a character array of the same length.

    Note that a declaration like "CHARACTER(LEN=40)" will not work. You must use "CHARACTER*40".

    If you want to use the NCL character array as an NCL string, you will need to use the NCL conversion function chartostring. See example 4 in this section.

  • Complex numbers

    NCL does not have a complex data type. If you want to bring complex numbers into NCL, you will have to do it by bringing in the real and imaginary parts as separate arrays. This will most likely require that you write an interface subroutine to your Fortran code that splits up the Fortran COMPLEX numbers into real and imaginary parts. Although you will not be able to do arithmetic on the complex numbers in NCL, you can still do analysis on the real and imaginary parts separately.

  • Procedure name conflicts

    If the procedure that you are incorporating into NCL has the same name as a currently existing built-in NCL procedure, NCL will choose its built-in and not your procedure. However, most UNIX ld commands recognize the -B symbolic flag, and using it when you create your dynamic shared object will force NCL to load your procedure in preference to its own built-ins. The -B symbolic can cause ld to report missing entries that in fact are ultimately not missing. It is probably best just to be careful to avoid defining a procedure with the same name as an NCL built-in.

  • NCL termination

    If a Fortran procedure that you have incorporated into NCL executes a STOP statement, or if a C function executes an exit statement, then the NCL interpreter will abort.

  • Unsupported Fortran 77 syntax in wrapit interface blocks

    • Fortran COMMON blocks
      Fortran COMMON blocks are not allowed in a wrapit interface block. This would preclude your having adjustable arrays whose dimensions are passed in a COMMON block, or using COMMON to pass values for variables.

    • Fortran ENTRY statements
      There is no way to accommodate an ENTRY statement in a Fortran procedure.

    • Alternate return arguments
      Subroutines with alternate return arguments are not allowed.

Fixing common problems

  • "A syntax error occurred while parsing"

    Sometimes you'll get the above error and it will look like there's absolutely nothing wrong with the Fortran file or stub that you're trying to wrap. The above error can occur if you have \r or ^M type characters at the end of each line (which are generally invisible in a UNIX editor). You can see these characters by typing "od -c" on your file or "cat -v":

      od -c yourfile.f
      cat -v yourfile.f
    

    You'll see lines like:

    0000000    C       N   C   L   F   O   R   T   S   T   A   R   T  \r  \n
    0000020                            s   u   b   r   o   u   t   i   n   e
    0000040        t   e   s   t   i   t   (   x   ,   y   ,   z   ,   n   l
    0000060    a   t   ,   n   l   o   n   )  \r  \n                        
    0000100    r   e   a   l       x   (   n   l   a   t   ,   n   l   o   n
    0000120    )  \r  \n                           r   e   a   l       y   (
    0000140    n   l   a   t   ,   n   l   o   n   )  \r  \n                
    0000160            r   e   a   l       z   (   n   l   a   t   ,   n   l
    0000200    o   n   )  \r  \n                           i   n   t   e   g
    0000220    e   r       n   t   i   m   ,   n   l   a   t  \r  \n   C    
    0000240    N   C   L   E   N   D  \r  \n                                
    0000250
    

    Note the "\r" at the end of the lines. These will cause a problem for wrapit77.

    To fix these, try running dos2unix or using the UNIX tr command on the file to clean it up:

      dos2unix yourfile.f
    
      tr -d '\r' < yourfile.f > yourfile_fix.f
    

    Note that "dos2unix" can operate on the file and return the results in the same file. With the "tr" command, you need to redirect it to a new file and then run WRAPIT on the new file.

  • "/usr/bin/ld: cannot find -lgfortran"

    On some systems, WRAPIT uses the gfortran compiler by default. The gfortran library (libgfortran.a) may be installed in a location that can't be automatically "seen" by WRAPIT. You can use the UNIX "locate" command to find the gfortran library, and the the "-L" option with WRAPIT to indicate where it is.

    For example, if:

       locate libgfortran.a
    
    returns:

       /usr/lib/gcc/x86_64-redhat-linux/4.1.1/libgfortran.a
    
    then your WRAPIT command will look like this:

       WRAPIT -L /usr/lib/gcc/x86_64-redhat-linux/4.1.1 yourfile.f
    

  • Getting an "undefined symbol" when you try to use WRAPIT. For example:

       ncl myscript.ncl
    
       warning:An error occurred loading the external file ./besi0.so, file not loaded
      ./besi0.so: undefined symbol: xermsg_
    
    This can possibly mean one of two things:
    1. The Fortran routine you are trying to wrap has a direct call to "xermsg" (or "XERMSG") in it, but WRAPIT can't find the file or the library where this subroutine is defined.

    2. This subroutine is being called internally by your compiler, and WRAPIT needs some help in finding the library that this symbol is defined in.

    If your situation is the first case, and your Fortran routine is calling this routine, then you may need to include an additional Fortran routine that has this symbol in it, or else link to a library that has this symbol.

    To link to a Fortran routine with this symbol, include the *.f file on the WRAPIT line after the *.f file you are wrapping:

      WRAPIT myfile.f myotherfile.f
    

    To link to a library that has this symbol defined, you will need to use the "-l" option, and possibly the "-L" option to tell WRAPIT where the library is located. For example, if the symbol is in the library "libfoo.a", and "libfoo.a" is in "/home/foo/lib", then include the following at the end of your WRAPIT command line:

      WRAPIT myfile.f -L /home/foo/lib -l foo
    

    If your situation fits the second case, you will need to find out which system library contains this symbol, and use the information in the previous step about using "-L" and "-l" to link in an additional library.

    To find out what system library a symbol resides in is not always trivial. You can try the "locate" command which may not be available on all systems:

        locate symbol_name
    

    If you don't have the "locate" command, then you can try googling the symbol, or using a combination of "nm" and "grep" to look for the symbol. If you have a system administrator to ask about this, I highly recommend doing this first. Otherwise, you will need to search for the "lib*.a" files on your system, and then run "nm" and "grep":

      nm libxxxx.a | grep symbol_name
    

    If the symbol exists in your library, the "nm" command will produce output that looks like one of these lines (note: the output is different for different types of systems):

       00000000 T symbol_name
    
        [5]     |         0|       8|FUNC |GLOB |0    |2      |symbol_name
    

Troubleshooting WRAPIT

To troubleshoot WRAPIT, try this simple test:

  1. Download ex.f and ex.ncl.

  2. Type:

    WRAPIT ex.f
    ncl ex.ncl
    
    If there were other options you were including on the WRAPIT command line, go ahead and include these.

    This test should produce the following output:

    (0)     before i = 5
    (0)     before x = 1.3
    (0)     after i = 10
    (0)     after x = -11.045
    

  3. If you don't get this output then there may be something wrong with your version of WRAPIT or ncl. Please email ncl-talk@ucar.edu (you must subscribe first) and send all the output from running the above commands, along with what "uname -a" reports on your system.

  4. If the output from the above test looks good. then please review the "Fixing common problems" section to see what might be wrong with using WRAPIT on your own Fortran file.