Merge pull request #6 from gha3mi/dev

Added Support for OpenMP and do concurrent

CHANGELOG.md

@@ -12,6 +12,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
 - Added `CONTRIBUTING.md` file.
 - Add NURBS surface to PPM conversion examples.
 - Utilized ForUnitTest for testing.
+- Added Support for `OpenMP` and `do concurrent`.
 
 ### Changed
 

README.md

@@ -7,12 +7,13 @@
 
 ![](logo/logo.png)
 
-**ForCAD**: A Fortran library for Geometric Modeling using NURBS (Non-Uniform Rational B-Splines).
+**ForCAD**: A Parallel Fortran library for Geometric Modeling using NURBS (Non-Uniform Rational B-Splines).
 
 ForCAD supports **B-Spline**, **NURBS**, **Bezier**, and **Rational Bezier** curves, surfaces, and volumes.
 
 ## Main Features
 
+- Parallelized using `OpenMP` and `do concurrent`.
 - Create NURBS objects by specifying control points, weights and knots.
 - Refine NURBS objects by inserting or removing knots and elevating degree.
 - Compute basis functions and derivatives of NURBS objects.

example/example_ppm1.f90

@@ -35,7 +35,7 @@ program example_ppm1
     call t%timer_start()
     call background_color%set('white', use_library=.true.)
 
-    do concurrent (i = 1: width)
+    do i = 1, width
         px(:, 3*(i-1)+1) = background_color%get_r()
         px(:, 3*(i-1)+2) = background_color%get_g()
         px(:, 3*(i-1)+3) = background_color%get_b()
@@ -84,7 +84,7 @@ program example_ppm1
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -140,7 +140,7 @@ program example_ppm1
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -201,7 +201,7 @@ program example_ppm1
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -261,7 +261,7 @@ program example_ppm1
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -324,7 +324,7 @@ program example_ppm1
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
         px(idx(i,2), 3*(idx(i,1)-1)+3) = blue

example/example_ppm2.f90

@@ -35,7 +35,7 @@ program example_ppm2
     call t%timer_start()
     call background_color%set('white', use_library=.true.)
 
-    do concurrent (i = 1: width)
+    do i = 1, width
         px(:, 3*(i-1)+1) = background_color%get_r()
         px(:, 3*(i-1)+2) = background_color%get_g()
         px(:, 3*(i-1)+3) = background_color%get_b()
@@ -83,7 +83,7 @@ program example_ppm2
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -141,7 +141,7 @@ program example_ppm2
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -205,7 +205,7 @@ program example_ppm2
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -267,7 +267,7 @@ program example_ppm2
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -332,7 +332,7 @@ program example_ppm2
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
         px(idx(i,2), 3*(idx(i,1)-1)+3) = blue

example/example_ppm3.f90

@@ -35,7 +35,7 @@ program example_ppm3
     call t%timer_start()
     call background_color%set('white', use_library=.true.)
 
-    do concurrent (i = 1: width)
+    do i = 1, width
         px(:, 3*(i-1)+1) = background_color%get_r()
         px(:, 3*(i-1)+2) = background_color%get_g()
         px(:, 3*(i-1)+3) = background_color%get_b()
@@ -84,7 +84,7 @@ program example_ppm3
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -136,7 +136,7 @@ program example_ppm3
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -195,7 +195,7 @@ program example_ppm3
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -253,7 +253,7 @@ program example_ppm3
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         call cmap%compute_RGB(z_values(i), red, green, blue)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
@@ -316,7 +316,7 @@ program example_ppm3
     allocate(idx(ng(1)*ng(2),2))
     idx(:,1) = min(max(1, int(Xg(:,1) * width ) + 1), width )
     idx(:,2) = min(max(1, int(Xg(:,2) * height) + 1), height)
-    do concurrent (i = 1: ng(1)*ng(2))
+    do i = 1, ng(1)*ng(2)
         px(idx(i,2), 3*(idx(i,1)-1)+1) = red
         px(idx(i,2), 3*(idx(i,1)-1)+2) = green
         px(idx(i,2), 3*(idx(i,1)-1)+3) = blue

example/shape_tetragon.f90

@@ -5,8 +5,6 @@ program shape_tetragon
     implicit none
 
     type(nurbs_surface) :: shape                !! Declare a NURBS surface object
-    real(rk), allocatable :: Xc(:,:), Wc(:)     !! Arrays for control points and weights
-    real(rk), allocatable :: knot1(:), knot2(:) !! Arrays for knot vectors in both dimensions
 
     !-----------------------------------------------------------------------------
     ! Setting up the NURBS tetrangon

fpm.toml

@@ -25,6 +25,7 @@ source-form       = "free"
 forimage    = {git="https://github.com/gha3mi/forimage.git"}
 forcolormap = {git="https://github.com/vmagnin/forcolormap.git"}
 fortime     = {git="https://github.com/gha3mi/fortime.git"}
+openmp      = "*"
 
 [dev-dependencies]
 forunittest = {git="https://github.com/gha3mi/forunittest"}