initial

2025-05-06 22:04:43 +03:00
commit 784a8f2ec7
29 changed files with 5922 additions and 0 deletions
--- a/compute_errors_bt.for
+++ b/compute_errors_bt.for
@@ -0,0 +1,122 @@
+
+! *** generated by SAPFOR with version 2412 and build date: Apr 29 2025 22:44:14
+! *** Enabled options ***:
+! *** maximum shadow width is 50 percent
+! *** generated by SAPFOR
+
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+!     this function computes the norm of the difference between the
+!     computed solution and the exact solution
+!---------------------------------------------------------------------
+      subroutine error_norm_bt (rms)
+
+      include 'header3d_bt.h'
+      integer ::  i,j,k,m,d
+      double precision ::  xi,eta,zeta,u_exact(5),rms(5),add
+      double precision ::  r1,r2,r3,r4,r5
+      do  m = 1,5
+         rms(m) = 0.0d0
+      enddo  
+      r1 = 0.0d0
+      r2 = 0.0d0
+      r3 = 0.0d0
+      r4 = 0.0d0
+      r5 = 0.0d0
+
+! DVM$ PARALLEL (K,J,I) ON U(*,I,J,K), REDUCTION (SUM(R1),SUM(R2),SUM(R3)
+! DVM$&,SUM(R4),SUM(R5)),PRIVATE (U_EXACT,XI,ETA,ZETA,M,ADD)
+! DVM$ REGION 
+      do  k = 0,problem_size - 1
+         do  j = 0,problem_size - 1
+            do  i = 0,problem_size - 1
+               zeta = dble (k) * dnzm1
+               eta = dble (j) * dnym1
+               xi = dble (i) * dnxm1
+
+!               call exact_solution_bt(xi, eta, zeta, u_exact)
+               do  m = 1,5
+                  u_exact(m) = ce(m,1) + xi * (ce(m,2) + xi * (ce(m,5) +
+     & xi * (ce(m,8) + xi * ce(m,11)))) + eta * (ce(m,3) + eta * (ce(m,6
+     &) + eta * (ce(m,9) + eta * ce(m,12)))) + zeta * (ce(m,4) + zeta * 
+     &(ce(m,7) + zeta * (ce(m,10) + zeta * ce(m,13))))
+               enddo  
+               add = u(1,i,j,k) - u_exact(1)
+               r1 = r1 + add * add
+               add = u(2,i,j,k) - u_exact(2)
+               r2 = r2 + add * add
+               add = u(3,i,j,k) - u_exact(3)
+               r3 = r3 + add * add
+               add = u(4,i,j,k) - u_exact(4)
+               r4 = r4 + add * add
+               add = u(5,i,j,k) - u_exact(5)
+               r5 = r5 + add * add
+            enddo  
+         enddo  
+      enddo  
+
+! DVM$ END REGION
+      rms(1) = r1
+      rms(2) = r2
+      rms(3) = r3
+      rms(4) = r4
+      rms(5) = r5
+      do  m = 1,5
+         do  d = 1,3
+            rms(m) = rms(m) / dble (grid_points(d) - 2)
+         enddo  
+         rms(m) = dsqrt (rms(m))
+      enddo  
+      return 
+      end
+
+
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+      subroutine rhs_norm_bt (rms)
+
+      include 'header3d_bt.h'
+      integer ::  i,j,k,d,m
+      double precision ::  rms(5),add,r1,r2,r3,r4,r5
+      r1 = 0.0d0
+      r2 = 0.0d0
+      r3 = 0.0d0
+      r4 = 0.0d0
+      r5 = 0.0d0
+
+! DVM$ PARALLEL (K,J,I) ON RHS(*,I,J,K), REDUCTION (SUM(R1),SUM(R2),SUM(R
+! DVM$&3),SUM(R4),SUM(R5)),PRIVATE (ADD)
+! DVM$ REGION 
+      do  k = 1,problem_size - 2
+         do  j = 1,problem_size - 2
+            do  i = 1,problem_size - 2
+               add = rhs(1,i,j,k)
+               r1 = r1 + add * add
+               add = rhs(2,i,j,k)
+               r2 = r2 + add * add
+               add = rhs(3,i,j,k)
+               r3 = r3 + add * add
+               add = rhs(4,i,j,k)
+               r4 = r4 + add * add
+               add = rhs(5,i,j,k)
+               r5 = r5 + add * add
+            enddo  
+         enddo  
+      enddo  
+
+! DVM$ END REGION
+      rms(1) = r1
+      rms(2) = r2
+      rms(3) = r3
+      rms(4) = r4
+      rms(5) = r5
+      do  m = 1,5
+         do  d = 1,3
+            rms(m) = rms(m) / dble (grid_points(d) - 2)
+         enddo  
+         rms(m) = dsqrt (rms(m))
+      enddo  
+      return 
+      end
+