SHARE
TWEET

typebound test

starm100 Jun 2nd, 2019 90 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module creative
  2. implicit none
  3. type,public::vector
  4.     private
  5.     real,allocatable::coord(:)
  6.     integer::dim
  7. contains
  8.     procedure,public::construct_vector, print_vector
  9.     procedure,private::add_vector, invert_vector, substract_vector, dot_prod, nullify_vector
  10.     generic,public::operator(+)=>add_vector
  11.     generic,public::operator(-)=>invert_vector, substract_vector
  12.     generic,public::operator(*)=>dot_prod
  13.     generic,public::operator(.nul.)=>nullify_vector
  14. end type vector
  15.  
  16.     contains
  17.    
  18. subroutine construct_vector(a,coord_input)
  19. real::coord_input(1:)
  20. class(vector),intent(inout)::a
  21. a%coord=coord_input
  22. a%dim=size(coord_input)
  23. end subroutine construct_vector
  24.  
  25. subroutine print_vector(a)
  26. class(vector),intent(in)::a
  27. print*, '(',a%coord,')','Dim=',a%dim
  28. end subroutine print_vector
  29.    
  30. function add_vector(a,b) result(c)
  31. class(vector),intent(in)::a,b
  32. class(vector),allocatable::c
  33. integer::i
  34. if (a%dim >= b%dim) then
  35.     allocate(c,source=a)
  36.     do i=1,b%dim
  37.         c%coord(i)=c%coord(i)+b%coord(i)
  38.     enddo
  39. else
  40.     allocate(c,source=b)
  41.     do i=1,a%dim
  42.        c%coord(i)=c%coord(i)+a%coord(i)
  43.     enddo
  44. endif
  45. end function add_vector
  46.  
  47. function invert_vector(a) result (b)
  48. class(vector),intent(in)::a
  49. class(vector),allocatable::b
  50. allocate(b,source=a)
  51. b%coord=-b%coord
  52. end function invert_vector
  53.  
  54. function substract_vector(a,b) result(c)
  55. class(vector),intent(in)::a,b
  56. class(vector),allocatable::c
  57. c=a+(-b)
  58. end function substract_vector
  59.  
  60. function dot_prod(a,b) result(c)
  61. class(vector),intent(in)::a,b
  62. integer::i
  63. real::c
  64. c=0
  65. if (a%dim /= b%dim) then
  66.     print*, "Error:Dimensions don't match, dot product invalid"
  67.     return
  68. endif
  69. do i=1,a%dim
  70.     c=c+a%coord(i)*b%coord(i)
  71. enddo
  72. end function dot_prod
  73.  
  74. function nullify_vector(a) result(b)
  75. class(vector),intent(in)::a
  76. class(vector),allocatable::b
  77. allocate(b,source=a)
  78. b%coord=0
  79. end function nullify_vector
  80.  
  81. end module creative
  82.  
  83. !!! Main program !!!
  84.  
  85. program object
  86. use creative
  87. implicit none
  88. real::c
  89. type(vector)::a,b
  90. call construct_vector(a,(/1.2,4.1,5.9/))
  91. call construct_vector(b,(/1.0,4.0/))
  92. a=a-b
  93. call print_vector(a)
  94. c=a*b
  95. print*, 'Dot product =', c
  96. call print_vector(.nul.a)
  97. pause
  98. end program object
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top