home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / ftn_only_osf1.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  5.8 KB  |  219 lines
  1. C
  2. C
  3. C NAME:
  4. C     ftn_only_osf1.f
  5. C
  6. C PURPOSE:
  7. C    This Fortran function is used to demonstrate how IDL can
  8. C    pass variables to a Fortran routine and then recieve these
  9. C    variables once they are modified. 
  10. C
  11. C CATEGORY:
  12. C    Dynamic Link
  13. C
  14. C CALLING SEQUENCE:
  15. C      This function is called in IDL by using the following command
  16. C      Access to this function is achived via a C 'wrapper' function.
  17. C    
  18. C      IDL> result = CALL_EXTERNAL('ftn_only.so', 'ftn_only',    $
  19. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar,  $
  20. C      IDL>      floatarr, n_elments(floatarr) ) 
  21. C
  22. C INPUTS:
  23. C      Byte_var:       A scalar byte variable
  24. C
  25. C      Short_var:      A scalar short integer variable
  26. C
  27. C      Long_var:       A scalar long integer variable
  28. C
  29. C      Float_var:      A scalar float variable
  30. C
  31. C      Double_var:     A scalar float variable
  32. C
  33. C      floatarr:       A floating point array
  34. C      
  35. C      cnt:           Number of elements in the array.
  36. C
  37. C OUTPUTS:
  38. C    The value of each variable is squared and the sum of the 
  39. C    array is returned as the value of the function. 
  40. C
  41. C SIDE EFFECTS:
  42. C    The values of the passed in variables are written to stdout.
  43. C
  44. C RESTRICTIONS:
  45. C    This example is setup to run using the OSF1 operating system. 
  46. C
  47. C EXAMPLE:
  48. C-----------------------------------------------------------------------------
  49. C;; The following are the commands that would be used to call this
  50. C;; routine in IDL. This calls the C function that calls this FORTRAN
  51. C;; Subprogram.
  52. C;;
  53. C        byte_var        = 1b
  54. C        short_var       = 2
  55. C        long_var        = 3l
  56. C        float_var       = 4.0
  57. C        double_var      = 5d0
  58. C     floatarr     = findgen(30)*!pi
  59. C
  60. C        result = CALL_EXTERNAL('ftn_only.so', 'ftn_only',     $
  61. C                        byte_var, short_var, long_var, float_var,      $
  62. C                        double_var, floatarr, n_elments(floatarr) )
  63. C
  64. C-----------------------------------------------------------------------------
  65. C
  66. C MODIFICATION HISTORY:
  67. C    Copied from HP version, July, 1995        ACY
  68. C
  69. C     Declare the Fortran function that is called by IDL via the 
  70. C    CALL_EXTERNAL Function.
  71. C
  72. C=============================================================================
  73. C$Function FTN_ONLY
  74.  
  75.         REAL*4 FUNCTION FTN_ONLY(ARGC, ARGV)
  76.  
  77. C PURPOSE:
  78. C
  79. C       Example Fortran function that is called directly from IDL via
  80. C       the CALL_EXTERNAL function.
  81. C
  82. C       Declare the passed in variables
  83.  
  84.         INTEGER*8               ARGC    !Argument count
  85.         INTEGER*8               ARGV(*) !Vector of pointers to argments
  86.  
  87. C       Declare the function that will be called so that we can convert the
  88. C       IDL passed variables (ARGV) to Fortran varialbes via the parameter
  89. C       passing function %VAL().
  90.  
  91.         REAL*4                  FTN_ONLY1
  92.  
  93. C       Local variables
  94.  
  95.         INTEGER                 ARG_CNT
  96.  
  97. C       The argument count is passed in by value. Get the location of
  98. C       this value in memory (a pointer) and convert it into an
  99. C       Fortran integer.
  100.  
  101.     ARG_CNT = LOC(ARGC)
  102.  
  103. C    Insure that we got the correct number of arguments
  104.  
  105.     IF(ARG_CNT .ne. 7)THEN
  106.  
  107.        WRITE(*,*)'ftn_only: Incorrect number of arguments'
  108.        FTN_ONLY = -1.0
  109.        RETURN
  110.  
  111.     ENDIF
  112.  
  113. C       To convert the pointers to the IDL variables contained in ARGV
  114. C       we must use the Fortran function %VAL. This funcion is used
  115. C       in the argument list of a Fortran sub-program. Call the Fortran
  116. C       subroutine that will actually perform the desired operations.
  117. C       Set the return value to the value of this function.
  118.  
  119.         FTN_ONLY = FTN_ONLY1( %val(ARGV(1)), %val(ARGV(2)),
  120.      &                        %val(ARGV(3)), %val(ARGV(4)),
  121.      &                        %val(ARGV(5)), %val(ARGV(6)),
  122.      &                   %val(ARGV(7)) )
  123.  
  124. C       Thats all, return to IDL.
  125.  
  126.         RETURN
  127.  
  128.         END
  129.  
  130. C=============================================================================
  131. C$Function FTN_ONLY1
  132.  
  133.           REAL*4 FUNCTION FTN_ONLY1(BYTEVAR, SHORTVAR, LONGVAR,
  134.      &        FLOATVAR, DOUBLEVAR, FLOATARR, N)
  135.  
  136.         LOGICAL*1               BYTEVAR         !IDL byte
  137.  
  138.         INTEGER*2               SHORTVAR        !IDL integer
  139.  
  140.         INTEGER*4               LONGVAR         !IDL long integer
  141.     INTEGER*4        N        !Size of array
  142.  
  143.         REAL*4                  FLOATVAR        !IDL float
  144.     REAL*4            FLOATARR(N)    !IDL float array
  145.     
  146.         DOUBLE PRECISION        DOUBLEVAR       !IDL double
  147.  
  148.     INTEGER            I        !Counter
  149.     
  150.     REAL*4            SUM        
  151. C
  152. C       Write the values of the variables that were passed in to
  153. C       Fortran from IDL.
  154.  
  155.         WRITE(*,10)
  156.  10     FORMAT(1X,/,52('-') )
  157.  
  158.         WRITE(*,20)
  159.  20     FORMAT(1X,'Inside Fortran function ftn_only1 ',
  160.      &            '(Called from ftn_only)',/)
  161.  
  162.         WRITE(*,30)
  163.  30     FORMAT(1X,'Scalar Values Passed in From IDL:')
  164.  
  165.         WRITE(*,100)BYTEVAR
  166.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  167.  
  168.         WRITE(*,110)SHORTVAR
  169.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  170.  
  171.         WRITE(*,120)LONGVAR
  172.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  173.  
  174.         WRITE(*,130)FLOATVAR
  175.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  176.  
  177.         WRITE(*,140)DOUBLEVAR
  178.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  179.  
  180.      WRITE(*,160)
  181.  160    FORMAT(10X,'Float Array:')
  182.  
  183.     WRITE(*,170)(I, FLOATARR(I), I=1, N)
  184.  170    FORMAT(15X,'Element ',I3,', Value: ',T47, F7.2)
  185.  
  186.     WRITE(*,10)     !Prints a line across the page
  187.  
  188. C       Perform a simple operation on each varable (square them).
  189.  
  190.         BYTEVAR   = BYTEVAR   * BYTEVAR
  191.         SHORTVAR  = SHORTVAR  * SHORTVAR
  192.         LONGVAR   = LONGVAR   * LONGVAR
  193.         FLOATVAR  = FLOATVAR  * FLOATVAR
  194.         DOUBLEVAR = DOUBLEVAR * DOUBLEVAR
  195.  
  196. C     Now sum the array
  197.  
  198.     SUM = 0.0
  199.  
  200.     DO I = 1, N 
  201.  
  202.        SUM = SUM + FLOATARR(I)
  203.  
  204.     ENDDO    
  205.  
  206. C    Set the function equal to the sum
  207.  
  208.         FTN_ONLY1 = SUM 
  209.  
  210. C       Thats it, return to the calling routine
  211.  
  212.         RETURN
  213.  
  214.         END
  215.  
  216. C==========================================================================
  217.  
  218.  
  219.