home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / simple_c2f1_ibm.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  3.8 KB  |  158 lines
  1. C
  2. C    $Id: simple_c2f1_ibm.f,v 1.1 1993/11/16 23:36:16 idl Exp $
  3. C
  4. C NAME:
  5. C     simple_c2f1
  6. C
  7. C PURPOSE:
  8. C
  9. C    This Fortran function is used to demonstrate how to pass all IDL
  10. C    simple varable types to a FORTRAN routine via a C wrapper function.
  11. C    Each variable is squared and returned to the calling C function.
  12. C
  13. C CATEGORY:
  14. C    Dynamic Link
  15. C
  16. C CALLING SEQUENCE:
  17. C      This function is called in IDL by using the following command
  18. C      Access to this function is achived via a C 'wrapper' function.
  19. C    
  20. C      IDL> result = CALL_EXTERNAL('simple_c2f.so', '_simple_c2f',    $
  21. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar, stringvar) 
  22. C
  23. C INPUTS:
  24. C
  25. C      Byte_var:       A scalar byte variable
  26. C
  27. C      Short_var:      A scalar short integer variable
  28. C
  29. C      Long_var:       A scalar long integer variable
  30. C
  31. C      Float_var:      A scalar float variable
  32. C
  33. C      Double_var:     A scalar float variable
  34. C
  35. C      String_var:     A scalar string value 
  36. C
  37. C OUTPUTS:
  38. C    The value of each variable is squared. Since you should not 
  39. C    change the value of an IDL string. A new string is created,
  40. C    two copies of the original string placed in it and the 
  41. C    string is returned as the value of this function.
  42. C
  43. C SIDE EFFECTS:
  44. C    None.
  45. C
  46. C RESTRICTIONS:
  47. C       None.
  48. C
  49. C EXAMPLE:
  50. C-----------------------------------------------------------------------------
  51. C;; The following are the commands that would be used to call this
  52. C;; routine in IDL. This calls the C function that calls this FORTRAN
  53. C;; Subprogram.
  54. C;;
  55. C        byte_var        = 1b
  56. C        short_var       = 2
  57. C        long_var        = 3l
  58. C        float_var       = 4.0
  59. C        double_var      = 5d0
  60. C        string_var      = "SIX"
  61. C
  62. C        result = CALL_EXTERNAL('simple_c2f.so', '_simple_c2f',     $
  63. C                        byte_var, short_var, long_var, float_var,            $
  64. C                        double_var, string_var )
  65. C
  66. C-----------------------------------------------------------------------------
  67. C
  68. C MODIFICATION HISTORY:
  69. C    Written October, 1993        KDB
  70.  
  71.     SUBROUTINE SIMPLE_C2F1(BYTE_VAR, SHORT_VAR, LONG_VAR,
  72.      &         FLOAT_VAR, DOUBLE_VAR, STRING_VAR, RTR_STR, RTR_LEN )
  73.  
  74. C    Declare subroutine passed in variables 
  75.  
  76.     BYTE            BYTE_VAR      !IDL byte variable
  77.  
  78.     INTEGER*2        SHORT_VAR    !IDL integer variable 
  79.     INTEGER*4        LONG_VAR    !IDL long integer
  80.     INTEGER*4            RTR_LEN
  81.  
  82.     REAL            FLOAT_VAR    !IDL float variable
  83.  
  84.     DOUBLE PRECISION    DOUBLE_VAR    !IDL double variable
  85.  
  86.     CHARACTER*(*)        STRING_VAR    !IDL string variable
  87.  
  88.     CHARACTER*(*)        RTR_STR
  89.  
  90. C    Declare local variables
  91.  
  92.     INTEGER            LN          !Length of input string
  93.     INTEGER              LEFT, EN
  94.     
  95. C       Print out each variable that was passed in.
  96.  
  97.         WRITE(*,10)
  98.  10     FORMAT(1X,/,52('-') )
  99.  
  100.         WRITE(*,20)
  101.  20     FORMAT(1X,'Inside Fortran function simple_c2f1 ',/
  102.      &     '(Called from IDL using CALL_EXTERNAL via A C function)',/)
  103.  
  104.         WRITE(*,30)
  105.  30     FORMAT(1X,'Scalar Values Passed in From IDL via a C function:')
  106.  
  107.         WRITE(*,100)BYTE_VAR
  108.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  109.  
  110.         WRITE(*,110)SHORT_VAR
  111.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  112.  
  113.         WRITE(*,120)LONG_VAR
  114.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  115.  
  116.         WRITE(*,130)FLOAT_VAR
  117.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  118.  
  119.         WRITE(*,140)DOUBLE_VAR
  120.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  121.  
  122.         WRITE(*,150)STRING_VAR
  123.  150    FORMAT(10X,'String Parameter:',T50,A)
  124.  
  125.         WRITE(*,10)
  126.  
  127. C    Square each variable
  128.  
  129.     BYTE_VAR    = BYTE_VAR**2
  130.     SHORT_VAR    = SHORT_VAR**2
  131.     LONG_VAR    = LONG_VAR**2
  132.     FLOAT_VAR    = FLOAT_VAR**2
  133.     DOUBLE_VAR    = DOUBLE_VAR**2
  134.  
  135. C    Now to duplicate the string
  136.  
  137.     RTR_STR = STRING_VAR
  138.  
  139.     LN = len(STRING_VAR)
  140.  
  141.     LEFT = RTR_LEN - LN    
  142.     IF( LEFT .gt. LN) LEFT = LN
  143.     
  144.     EN = LN*2
  145.     IF(EN .gt. RTR_LEN)  EN = RTR_LEN 
  146.  
  147.     RTR_STR(LN+1:EN) = STRING_VAR(1:LEFT)
  148.  
  149. C    That is all that this subroutine does. Return to the 
  150. C    calling C function.
  151.  
  152.     RETURN
  153.  
  154.     END
  155.  
  156.  
  157.  
  158.