home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / ftn_only_hp.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  8.0 KB  |  322 lines
  1. C
  2. C    $Id: ftn_only_hp.f,v 1.1 1993/11/16 23:36:16 idl Exp $
  3. C
  4. C NAME:
  5. C     ftn_only_hp.f
  6. C
  7. C PURPOSE:
  8. C    This Fortran function is used to demonstrate how IDL can
  9. C    pass variables to a Fortran routine and then recieve these
  10. C    variables once they are modified. 
  11. C
  12. C CATEGORY:
  13. C    Dynamic Link
  14. C
  15. C CALLING SEQUENCE:
  16. C      This function is called in IDL by using the following command
  17. C      Access to this function is achived via a C 'wrapper' function.
  18. C    
  19. C      IDL> result = CALL_EXTERNAL('ftn_only.so', '_ftn_only_',    $
  20. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar,  $
  21. C      IDL>      strvar, floatarr, n_elments(floatarr) ) 
  22. C
  23. C INPUTS:
  24. C      Byte_var:       A scalar byte variable
  25. C
  26. C      Short_var:      A scalar short integer variable
  27. C
  28. C      Long_var:       A scalar long integer variable
  29. C
  30. C      Float_var:      A scalar float variable
  31. C
  32. C      Double_var:     A scalar float variable
  33. C
  34. C      strvar:           A IDL scalar string
  35. C
  36. C      floatarr:       A floating point array
  37. C      
  38. C      cnt:           Number of elements in the array.
  39. C
  40. C OUTPUTS:
  41. C    The value of each variable is squared and the sum of the 
  42. C    array is returned as the value of the function. 
  43. C
  44. C SIDE EFFECTS:
  45. C    The values of the passed in variables are written to stdout.
  46. C
  47. C RESTRICTIONS:
  48. C    This example is setup to run using the HP operating system. 
  49. C
  50. C EXAMPLE:
  51. C-----------------------------------------------------------------------------
  52. C;; The following are the commands that would be used to call this
  53. C;; routine in IDL. This calls the C function that calls this FORTRAN
  54. C;; Subprogram.
  55. C;;
  56. C        byte_var        = 1b
  57. C        short_var       = 2
  58. C        long_var        = 3l
  59. C        float_var       = 4.0
  60. C        double_var      = 5d0
  61. C     floatarr     = findgen(30)*!pi
  62. C
  63. C        result = CALL_EXTERNAL('ftn_only.so', 'ftn_only',     $
  64. C                        byte_var, short_var, long_var, float_var,      $
  65. C                        double_var, strvar, floatarr, n_elments(floatarr) )
  66. C
  67. C-----------------------------------------------------------------------------
  68. C
  69. C MODIFICATION HISTORY:
  70. C    Written October, 1993        KDB
  71. C
  72. C     Declare the Fortran function that is called by IDL via the 
  73. C    CALL_EXTERNAL Function.
  74. C
  75. C=============================================================================
  76. C$Function FTN_ONLY
  77.  
  78.         REAL*8 FUNCTION FTN_ONLY(ARGC, ARGV)
  79.  
  80. C PURPOSE:
  81. C
  82. C       Example Fortran function that is called directly from IDL via
  83. C       the CALL_EXTERNAL function.
  84. C
  85. C       Declare the passed in variables
  86.  
  87.         INTEGER*4               ARGC    !Argument count
  88.         INTEGER*4               ARGV(*) !Vector of pointers to argments
  89.  
  90. C       Declare the function that will be called so that we can convert the
  91. C       IDL passed variables (ARGV) to Fortran varialbes via the parameter
  92. C       passing function %VAL().
  93.  
  94.         REAL*4                  FTN_ONLY1
  95.  
  96. C       Local variables
  97.  
  98.         INTEGER                 ARG_CNT
  99.  
  100. C       The argument count is passed in by value. Get the location of
  101. C       this value in memory (a pointer) and convert it into an
  102. C       Fortran integer.
  103.  
  104.         ARG_CNT = LOC(ARGC)
  105.  
  106. C    Insure that we got the correct number of arguments
  107.  
  108.     IF(ARG_CNT .ne. 9)THEN
  109.  
  110.        WRITE(*,*)'ftn_only: Incorrect number of arguments'
  111.        FTN_ONLY = -1.0
  112.        RETURN
  113.  
  114.     ENDIF
  115.  
  116. C       To convert the pointers to the IDL variables contained in ARGV
  117. C       we must use the Fortran function %VAL. This funcion is used
  118. C       in the argument list of a Fortran sub-program. Call the Fortran
  119. C       subroutine that will actually perform the desired operations.
  120. C       Set the return value to the value of this function.
  121.  
  122.         FTN_ONLY = FTN_ONLY1( %val(ARGV(1)), %val(ARGV(2)),
  123.      &                        %val(ARGV(3)), %val(ARGV(4)),
  124.      &                        %val(ARGV(5)), %val(ARGV(6)),
  125.      &                   %val(ARGV(7)), %val(ARGV(8)),  
  126.      &                   %val(ARGV(9)) )
  127.  
  128. C       Thats all, return to IDL.
  129.  
  130.         RETURN
  131.  
  132.         END
  133.  
  134. C=============================================================================
  135. C$Function FTN_ONLY1
  136.  
  137.           REAL*4 FUNCTION FTN_ONLY1(BYTEVAR, SHORTVAR, LONGVAR,
  138.      &        FLOATVAR, DOUBLEVAR, STRVAR,  STRLEN, FLOATARR, N)
  139.  
  140. C    Declare a parameter that contains the temp. string length
  141.     
  142.     INTEGER         CHAR_SIZE
  143.     PARAMETER    (    CHAR_SIZE      =     100    )
  144.     
  145. C       Declare the IDL string data structure
  146.  
  147.     STRUCTURE /STRING/
  148.         INTEGER*2 SLEN
  149.         INTEGER*2 STYPE
  150.         INTEGER      S
  151.     END STRUCTURE
  152.  
  153.         LOGICAL*1               BYTEVAR         !IDL byte
  154.  
  155.         INTEGER*2               SHORTVAR        !IDL integer
  156.  
  157.         INTEGER*4               LONGVAR         !IDL long integer
  158.     INTEGER*4        N        !Size of array
  159.     INTEGER*4        STRLEN
  160.  
  161.         REAL*4                  FLOATVAR        !IDL float
  162.     REAL*4            FLOATARR(N)    !IDL float array
  163.     
  164.         DOUBLE PRECISION        DOUBLEVAR       !IDL double
  165.  
  166.         RECORD /STRING/        STRVAR
  167.  
  168.     INTEGER            I        !Counter
  169.     
  170.     REAL*4            SUM        
  171.  
  172.     CHARACTER*(CHAR_SIZE)    TMPSTR
  173.  
  174. C       Convert the IDL string to a Fortran string
  175.  
  176.     CALL IDL_2_FORT(%VAL(STRVAR.S), STRVAR.SLEN, TMPSTR, CHAR_SIZE)
  177.  
  178. C    Now TMPSTR contains the IDL string in Fortran format
  179. C
  180. C       Write the values of the variables that were passed in to
  181. C       Fortran from IDL.
  182.  
  183.         WRITE(*,10)
  184.  10     FORMAT(1X,/,52('-') )
  185.  
  186.         WRITE(*,20)
  187.  20     FORMAT(1X,'Inside Fortran function ftn_only ',
  188.      &            '(Called from IDL using CALL_EXTERNAL)',/)
  189.  
  190.         WRITE(*,30)
  191.  30     FORMAT(1X,'Scalar Values Passed in From IDL:')
  192.  
  193.         WRITE(*,100)BYTEVAR
  194.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  195.  
  196.         WRITE(*,110)SHORTVAR
  197.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  198.  
  199.         WRITE(*,120)LONGVAR
  200.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  201.  
  202.         WRITE(*,130)FLOATVAR
  203.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  204.  
  205.         WRITE(*,140)DOUBLEVAR
  206.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  207.  
  208.     WRITE(*,150)TMPSTR(1:STRVAR.SLEN)
  209.  150    FORMAT(10X,'String Parameter:',T50,A)
  210.  
  211.      WRITE(*,160)
  212.  160    FORMAT(10X,'Float Array:')
  213.  
  214.     WRITE(*,170)(I, FLOATARR(I), I=1, N)
  215.  170    FORMAT(15X,'Element ',I3,', Value: ',T47, F7.2)
  216.  
  217.     WRITE(*,10)     !Prints a line across the page
  218.  
  219. C       Perform a simple operation on each varable (square them).
  220.  
  221.         BYTEVAR   = BYTEVAR   * BYTEVAR
  222.         SHORTVAR  = SHORTVAR  * SHORTVAR
  223.         LONGVAR   = LONGVAR   * LONGVAR
  224.         FLOATVAR  = FLOATVAR  * FLOATVAR
  225.         DOUBLEVAR = DOUBLEVAR * DOUBLEVAR
  226.  
  227. C    Now "square" the IDL string
  228.  
  229.     TMPSTR(1:STRVAR.SLEN) = TMPSTR(1:STRVAR.SLEN/2)//
  230.      &               TMPSTR(1:STRVAR.SLEN/2)
  231.  
  232. C    Copy the string over to the IDL string
  233.  
  234.     CALL FORT_2_IDL(TMPSTR, %val(STRVAR.S), STRVAR.SLEN, CHAR_SIZE)
  235.  
  236. C     Now sum the array
  237.  
  238.     SUM = 0.0
  239.  
  240.     DO I = 1, N 
  241.  
  242.        SUM = SUM + FLOATARR(I)
  243.  
  244.     ENDDO    
  245.  
  246. C    Set the function equal to the sum
  247.  
  248.         FTN_ONLY1 = SUM 
  249.  
  250. C       Thats it, return to the calling routine
  251.  
  252.         RETURN
  253.  
  254.         END
  255.  
  256. C==========================================================================
  257. C$Subroutine IDL_2_FORT
  258.  
  259.     SUBROUTINE IDL_2_FORT(IDLSTR, STRLEN, FORTSTR, F_LEN)
  260.     
  261. C PURPOSE:
  262. C       Copies an IDL string to a Fortran character string.
  263.  
  264.     INTEGER*2        STRLEN
  265.     CHARACTER*(*)        IDLSTR
  266.     
  267.     CHARACTER*(*)        FORTSTR
  268.  
  269.         INTEGER                 F_LEN
  270.  
  271. C       If the IDL string is smaller then copy the entire string into
  272. C       the Fortran string, otherwise truncate it.
  273.  
  274. C        F_LEN=100
  275.  
  276.         IF(STRLEN .le. F_LEN )THEN
  277.             FORTSTR(1:STRLEN)=IDLSTR(1:STRLEN)
  278.         ELSE
  279.             FORTSTR(1:F_LEN)=IDLSTR(1:F_LEN)
  280.         ENDIF
  281.  
  282. C    Thats it
  283.  
  284.     RETURN
  285.  
  286.     END
  287.  
  288. C=========================================================================
  289. C$Subroutine FORT_2_IDL
  290.  
  291.     SUBROUTINE FORT_2_IDL(FORTSTR, IDLSTR, STRLEN, F_LEN )
  292.  
  293. C PURPOSE:
  294. C       Copies a Fortran string to an IDL string
  295.  
  296.     CHARACTER*(*)    FORTSTR
  297.     CHARACTER*(*)    IDLSTR
  298.  
  299.     INTEGER*2    STRLEN
  300.  
  301.         INTEGER         F_LEN
  302.  
  303. C       If the Fortran string is smaller then copy the entire Fortran
  304. C       string into the IDL string, otherwise truncate it.
  305.  
  306. C        F_LEN =100 
  307.  
  308.         IF(STRLEN .gt. F_LEN )THEN
  309.           IDLSTR(1:F_LEN) = FORTSTR(1:F_LEN)
  310.         ELSE
  311.           IDLSTR(1:STRLEN) = FORTSTR(1:STRLEN)
  312.         ENDIF
  313.  
  314. C    Thats it
  315.  
  316.     RETURN
  317.  
  318.     END
  319.     
  320.  
  321.  
  322.