Обновление прав.Разработчики могут произвольно работать с багами

v++
This commit is contained in:
2025-02-01 22:24:15 +03:00
parent ef5089443a
commit 6911bc6cdb
154 changed files with 229 additions and 61934 deletions

170
.idea/workspace.xml generated
View File

@@ -8,25 +8,159 @@
<component name="ChangeListManager">
<list default="true" id="e42177c3-2328-4b27-8a01-35779b2beb99" name="Default Changelist" comment="">
<change beforePath="$PROJECT_DIR$/.idea/workspace.xml" beforeDir="false" afterPath="$PROJECT_DIR$/.idea/workspace.xml" afterDir="false" />
<change beforePath="$PROJECT_DIR$/properties" beforeDir="false" afterPath="$PROJECT_DIR$/properties" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Global.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Global.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AddBugReport.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AddBugReport.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/CopyProject.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/CopyProject.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/CreateEmptyProject.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/CreateEmptyProject.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DownloadProject.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DownloadProject.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DownloadTest.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DownloadTest.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/GetOldBugReports.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/GetOldBugReports.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/OpenBugReportTestProject.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/OpenBugReportTestProject.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishComponentsServer.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishComponentsServer.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishTestingServer.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishTestingServer.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/SaveGraph.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/SaveGraph.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/Sapfor/OpenSapforVersionPass.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/Sapfor/OpenSapforVersionPass.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/236/domain.f" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/236/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/592/distrindirect3.f90" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/592/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/m1/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/m2/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/m3/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/m4/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/m5/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/p1/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/p1/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/p2/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/p2/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v1/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v1/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v2/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/m1/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/acrred21.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/attachments/Sapfor_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/attachments/Server_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/attachments/VisualDVM_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/attachments/Visualizer_2_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/p1/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/v3/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1733152707/acrred21/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m1/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m1/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m1/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m2/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m2/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m2/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m3/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m3/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m3/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m4/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m4/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m4/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m5/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m5/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m5/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/m5/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p1/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p1/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p1/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p1/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Sapfor_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Server_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/VisualDVM_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/attachments/Visualizer_2_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p10/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Sapfor_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Server_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/VisualDVM_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/attachments/Visualizer_2_log.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p2/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p3/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p3/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p3/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p3/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p4/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p4/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p4/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p4/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p5/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p5/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p5/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p5/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p6/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p6/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p6/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p6/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p7/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p7/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p7/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p7/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p8/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p8/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p8/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p8/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p9/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p9/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p9/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/p9/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v1/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v1/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v1/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v1/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v2/call.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v2/contains31.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v2/sol.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/v2/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/bugreport_1737466258/test_routine_4/visualiser_data/spf.proj" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/sh11_fr.f" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/sh11_fr.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/sh11_fr.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/p1/sh11_fr.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/p1/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/p2/sh11_fr.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/p2/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/sh11_fr.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/summa.for" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/create_variants.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/parse.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/parse_err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/v1/visualiser_data/parse_out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/parse.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/parse_err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/parse_out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/v1/visualiser_data/transformation.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/parse.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/parse_err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/parse_out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/properties" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/v1/visualiser_data/transformation.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/parse.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/parse_err.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/parse_out.txt" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/Downloads/test_routine_1_1737640388/test_routine_1/visualiser_data/transformation.sh" beforeDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/GlobalData/Account/Account.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/GlobalData/Account/Account.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AppendBugReportComment.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AppendBugReportComment.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AppendBugReportField.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/AppendBugReportField.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DeleteBugReport.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/DeleteBugReport.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishBugReport.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/PublishBugReport.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/UpdateBugReportField.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/UpdateBugReportField.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/UpdateBugReportProgress.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Passes/All/UpdateBugReportProgress.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Repository/BugReport/BugReport.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Repository/BugReport/BugReport.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/ComponentsSet.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/ComponentsSet.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/Sapfor/Sapfor.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/Sapfor/Sapfor.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/Visualiser.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/Repository/Component/Visualiser.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/Common/Test/Test.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/Common/Test/Test.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/Common/TestingServer.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/Common/TestingServer.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/DVM/DVMConfiguration/UI/DVMConfigurationsForm.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/DVM/DVMConfiguration/UI/DVMConfigurationsForm.java" afterDir="false" />
<change beforePath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/DVM/DVMSettings/UI/DVMSettingsForm.java" beforeDir="false" afterPath="$PROJECT_DIR$/src/_VisualDVM/TestingSystem/DVM/DVMSettings/UI/DVMSettingsForm.java" afterDir="false" />
</list>
<option name="SHOW_DIALOG" value="false" />
<option name="HIGHLIGHT_CONFLICTS" value="true" />
@@ -77,7 +211,7 @@
<option name="stateVersion" value="1" />
</component>
<component name="ProblemsViewState">
<option name="selectedTabId" value="CurrentFile" />
<option name="selectedTabId" value="ProjectErrors" />
</component>
<component name="ProjectId" id="1UqWSAGBQQNofrCLxSPPtOZrGP7" />
<component name="ProjectLevelVcsManager" settingsEditedManually="true">

View File

@@ -1,142 +0,0 @@
program domain
dimension u(9,9),f(9,9)
! $SPF ANALYSIS (PRIVATE(gran1))
dimension u1(0:10,0:10),f1(9,9),gran1(9)
! $SPF ANALYSIS (PRIVATE(gran2))
dimension u2(0:10,0:10),f2(9,9),gran2(9)
! $SPF ANALYSIS (PRIVATE(g))
dimension a(9,9),g(9)
net = 10
ntime = 2
n = net - 1
m = net / 2
h = 1. / net
r = 0.125
tau = r * (h * h)
r1 = 1 - 4 * r
rr = 1 + 2 * r
r2 = 1 - 2 * r
! $SPF TRANSFORM(UNROLL)
do i = 1,n
x = i * h
s = x * (1 - x)
do j = 1,n
y = j * h
q = y * (1 - y)
u(i,j) = 16 * s * q
10 f(i,j) = (s + q) * 32
enddo
enddo
!$SPF TRANSFORM(FISSION(j))
do j = 1,n
gran1(j) = u(m,j)
gran2(j) = u(m + 1,j)
enddo
!$SPF TRANSFORM(FISSION(i))
do i = 0,m
u1(i,0) = 0
u1(i,n + 1) = 0
enddo
!$SPF TRANSFORM(FISSION(i))
do i = 1,m
u2(i,0) = 0
u2(i,n + 1) = 0
enddo
!$SPF TRANSFORM(FISSION(j))
do j = 1,n
u1(0,j) = 0
u1(m + 1,j) = gran2(j)
u2(0,j) = gran1(j)
u2(m,j) = 0
enddo
!$SPF TRANSFORM(FISSION(i,j))
do i = 1,m
do j = 1,n
u1(i,j) = u(i,j)
60 f1(i,j) = f(i,j)
enddo
enddo
do i = 1,m - 1
do j = 1,n
u2(i,j) = u(i + m,j)
70 f2(i,j) = f(i + m,j)
enddo
enddo
do ktau = 1,ntime
do i = 1,m - 1
do j = 1,n
w = u1(i - 1,j) + u1(i + 1,j) + u1(i,j - 1) + u1(i,j + 1)
80 a(i,j) = r * w + r1 * u1(i,j) + tau * f1(i,j)
enddo
enddo
do j = 1,n
w = u1(m - 1,j) + gran2(j) + u1(m,j - 1) + u1(m,j + 1)
a(m,j) = r * w + r1 * u1(m,j) + tau * f1(m,j)
enddo
do i = 1,m
do j = 1,n
100 u1(i,j) = a(i,j)
enddo
enddo
do j = 1,n
g(j) = r * gran1(j) + r2 * u2(1,j) + r * u2(2,j) +
& tau * f2(1,j)
enddo
call progon(n,r,rr,r,g)
do j = 1,n
u2(1,j) = g(j)
enddo
do i = 2,m - 1
do j = 1,n
g(j) = r * u2(i - 1,j) + r2 * u2(i,j) + r *
& u2(i + 1,j) + tau * f2(i,j)
enddo
call progon(n,r,rr,r,g)
do j = 1,n
140 u2(i,j) = g(j)
enddo
enddo
do j = 1,n
gran1(j) = u1(m,j)
gran2(j) = u2(1,j)
enddo
do i = 1,m
do j = 1,n
160 u(i,j) = u1(i,j)
enddo
enddo
do i = 1,m - 1
do j = 1,n
170 u(i + m,j) = u2(i,j)
enddo
enddo
enddo
print 190, net,ntime
190 FORMAT(I5,I5)
print *, u
200 FORMAT(F5.2)
end
subroutine progon (n, a, b, c, f)
dimension f(n)
! $SPF ANALYSIS (PRIVATE(alfa,beta))
real, allocatable:: alfa(:),beta(:)
allocate(alfa(9),beta(9))
alfa(1) = 0.
beta(1) = 0.
do i = 1,n - 1
w = 1. / (b - a * alfa(i))
alfa(i + 1) = c * w
beta(i + 1) = w * (a * beta(i) + f(i))
enddo
f(n) = (a * beta(n) + f(n)) / (b - a * alfa(n))
do i = n - 1,1,(-(1))
f(i) = alfa(i + 1) * f(i + 1) + beta(i + 1)
enddo
deallocate(alfa)
deallocate(beta)
return
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": true,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": true,
"KEEP_SPF_DIRECTIVES": true,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 100,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": true,
"KEEP_GCOV": true,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": true,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 1,
"DVMConvertationOptions": " "
}

View File

@@ -1,262 +0,0 @@
program DISTRINDIRECT3
! Testing DISTRIBUTE and REDISTRIBUTE directives
! INDIRECT distribution
print *,'=== START OF distrindirect3 ========================'
call distrindirect31
print *,'=== END OF distrindirect3 ========================= '
end
subroutine distrindirect31
parameter (L=10, ER=100000)
integer:: A(L,L,L), B(L,L,L),AS(L,L,L), BS(L,L,L)
integer,dimension(:,:,:),allocatable:: ib1, ib2, ib3, ib4, ib5, ib6
integer,dimension(L,L,L):: indir_x, indir_y, indir_z
integer MAP1(L), MAP2(L), MAP3(L)
integer:: erri=ER
character*15:: tname="distrindirect31"
!DVM$ TEMPLATE E(L,L,L)
!DVM$ DISTRIBUTE :: E
!DVM$ ALIGN :: A,B
!DVM$ ALIGN :: indir_x, indir_y,indir_z
!DVM$ ALIGN :: ib1,ib2,ib3,ib4,ib5,ib6
call distrindirect31_s (AS, BS)
call fillMap(MAP1,L,1)
call fillMap(MAP2,L,2)
call fillMap(MAP3,L,3)
allocate( ib1(L,L,L), ib2(L,L,L), ib3(L,L,L), &
& ib4(L,L,L), ib5(L,L,L), ib6(L,L,L) )
!DVM$ REDISTRIBUTE E(INDIRECT(MAP1),INDIRECT(MAP2),INDIRECT(MAP3))
!DVM$ REALIGN (I,J,K) WITH E(I,J,K) :: A,B
!DVM$ REALIGN (I,J,K) WITH E(I,J,K) :: indir_x, indir_y,indir_z
!DVM$ REALIGN (I,J,K) WITH E(I,J,K) :: ib1,ib2,ib3,ib4,ib5,ib6
do i = 1,L
do j = 1,L
do k = 1,L
indir_x(i,j,k) = i
indir_y(i,j,k) = j
indir_z(i,j,k) = k
if (i.gt.1) then
ib1(i,j,k) = i - 1
else
ib1(i,j,k) = 0
endif
if (i.lt.L) then
ib2(i,j,k) = i + 1
else
ib2(i,j,k) = 0
endif
if (j.gt.1) then
ib3(i,j,k) = j - 1
else
ib3(i,j,k) = 0
endif
if (j.lt.L) then
ib4(i,j,k) = j + 1
else
ib4(i,j,k) = 0
endif
if (k.gt.1) then
ib5(i,j,k) = k - 1
else
ib5(i,j,k) = 0
endif
if (k.lt.L) then
ib6(i,j,k) = k + 1
else
ib6(i,j,k) = 0
endif
enddo
enddo
enddo
!DVM$ SHADOW_ADD (E((ib1(i,j,k)) with E(@i,@j,@k),*,*) = "nei1") include_to A
!DVM$ SHADOW_ADD (E((ib2(i,j,k)) with E(@i,@j,@k),*,*) = "nei2") include_to A
!DVM$ SHADOW_ADD (E(*,(ib3(i,j,k)) with E(@i,@j,@k),*) = "nei3") include_to A
!DVM$ SHADOW_ADD (E(*,(ib4(i,j,k)) with E(@i,@j,@k),*) = "nei4") include_to A
!DVM$ SHADOW_ADD (E(*,*,(ib5(i,j,k)) with E(@i,@j,@k)) = "nei5") include_to A
!DVM$ SHADOW_ADD (E(*,*,(ib6(i,j,k)) with E(@i,@j,@k)) = "nei6") include_to A
!DVM$ LOCALIZE(ib1 => A(:,*,*))
!DVM$ LOCALIZE(ib2 => A(:,*,*))
!DVM$ LOCALIZE(ib3 => A(*,:,*))
!DVM$ LOCALIZE(ib4 => A(*,:,*))
!DVM$ LOCALIZE(ib5 => A(*,*,:))
!DVM$ LOCALIZE(ib6 => A(*,*,:))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON B(i,j,k)
do k = 1,L
do j = 1,L
do i = 1,L
A(i,j,k) = 0
if (indir_x(i,j,k) == 1 .or. indir_x(i,j,k) == L .or. &
& indir_y(i,j,k) == 1 .or. indir_y(i,j,k) == L .or. &
& indir_z(i,j,k) == 1 .or. indir_z(i,j,k) == L) then
B(i,j,k) = 0
else
B(i,j,k) = 1 + indir_x(i,j,k) + indir_y(i,j,k) + indir_z(i,j,k)
endif
enddo
enddo
enddo
!DVM$ PARALLEL (k,j,i) ON B(i,j,k), SHADOW_RENEW (A)
do k = 2,L-1
do j = 2,L-1
do i = 2,L-1
if (indir_x(i,j,k) /= 1 .and. indir_x(i,j,k) /= L .and. &
& indir_y(i,j,k) /= 1 .and. indir_y(i,j,k) /= L .and. &
& indir_z(i,j,k) /= 1 .and. indir_z(i,j,k) /= L) then
B(i,j,k) = (A(ib1(i,j,k),j,k) + A(ib2(i,j,k),j,k) + &
& A(i,ib3(i,j,k),k) + A(i,ib4(i,j,k),k) + A(i,j,ib5(i,j,k)) + &
& A(i,j,ib6(i,j,k))) / 6.0
endif
enddo
enddo
enddo
!DVM$ PARALLEL (k,j,i) ON B(i,j,k), REDUCTION(min(erri))
do k = 2,L-1
do j = 2,L-1
do i = 2,L-1
if (indir_x(i,j,k) /= 1 .and. indir_x(i,j,k) /= L .and. &
& indir_y(i,j,k) /= 1 .and. indir_y(i,j,k) /= L .and. &
& indir_z(i,j,k) /= 1 .and. indir_z(i,j,k) /= L) then
if(B(i,j,k) .ne. BS(i,j,k)) erri = min(erri, ABS(B(i,j,k)-BS(i,j,k)))
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL(erri)
if (erri .eq. ER) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate (ib1,ib2,ib3,ib4,ib5,ib6)
end subroutine
!---------------------------------------------------------------
subroutine fillMap(MAP,L,dim)
integer numproc
integer i,L,dim
real x
integer MAP(L)
PROCESSORS_SIZE(i) = 1
numproc = PROCESSORS_SIZE(dim) ! dvmh_get_num_procs(1)
do i=1,L
call RANDOM_NUMBER(x)
MAP(i) = MOD(INT(x*10), numproc) !rand()
enddo
end subroutine
!---------------------------------------------------------------
subroutine distrindirect31_s (A,B)
parameter (L=10)
integer:: A(L,L,L), B(L,L,L)
integer,dimension(:,:,:),allocatable:: ib1, ib2, ib3, ib4, ib5, ib6
integer,dimension(L,L,L):: indir_x, indir_y, indir_z
allocate( ib1(L,L,L), ib2(L,L,L), ib3(L,L,L), &
& ib4(L,L,L), ib5(L,L,L), ib6(L,L,L) )
do i = 1,L
do j = 1,L
do k = 1,L
indir_x(i,j,k) = i
indir_y(i,j,k) = j
indir_z(i,j,k) = k
if (i.gt.1) then
ib1(i,j,k) = i - 1
else
ib1(i,j,k) = 0
endif
if (i.lt.L) then
ib2(i,j,k) = i + 1
else
ib2(i,j,k) = 0
endif
if (j.gt.1) then
ib3(i,j,k) = j - 1
else
ib3(i,j,k) = 0
endif
if (j.lt.L) then
ib4(i,j,k) = j + 1
else
ib4(i,j,k) = 0
endif
if (k.gt.1) then
ib5(i,j,k) = k - 1
else
ib5(i,j,k) = 0
endif
if (k.lt.L) then
ib6(i,j,k) = k + 1
else
ib6(i,j,k) = 0
endif
enddo
enddo
enddo
do k = 1,L
do j = 1,L
do i = 1,L
A(i,j,k) = 0
if (indir_x(i,j,k) == 1 .or. indir_x(i,j,k) == L .or. &
& indir_y(i,j,k) == 1 .or. indir_y(i,j,k) == L .or. &
& indir_z(i,j,k) == 1 .or. indir_z(i,j,k) == L) then
B(i,j,k) = 0
else
B(i,j,k) = 1 + indir_x(i,j,k) + indir_y(i,j,k) + indir_z(i,j,k)
endif
enddo
enddo
enddo
do k = 2,L-1
do j = 2,L-1
do i = 2,L-1
if (indir_x(i,j,k) /= 1 .and. indir_x(i,j,k) /= L .and. &
& indir_y(i,j,k) /= 1 .and. indir_y(i,j,k) /= L .and. &
& indir_z(i,j,k) /= 1 .and. indir_z(i,j,k) /= L) then
B(i,j,k) = (A(ib1(i,j,k),j,k) + A(ib2(i,j,k),j,k) + &
& A(i,ib3(i,j,k),k) + A(i,ib4(i,j,k),k) + A(i,j,ib5(i,j,k)) + &
& A(i,j,ib6(i,j,k))) / 6.0
endif
enddo
enddo
enddo
deallocate (ib1,ib2,ib3,ib4,ib5,ib6)
end subroutine
!---------------------------------------------------------------
subroutine ansyes(name)
character*14 name
print *,name,' - complete'
end
subroutine ansno(name)
character*9 name
print *,name,' - ***error'
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": true,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": true,
"KEEP_SPF_DIRECTIVES": true,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 100,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": true,
"KEEP_GCOV": true,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": true,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 1,
"DVMConvertationOptions": " "
}

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*15 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,919 +0,0 @@
! *** generated by SAPFOR with version 2371 and build date: Nov 19 2024 14:25:24
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 10 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc=0
isuma=0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc=isumc+c(i,j)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma=isuma+a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(isuma.eq.isumc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda=1
iprodc=1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc=iprodc*c(i,j)
enddo
enddo
nloopi = nl
nloopj = nl
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda=iproda*a(i,j)
enddo
enddo
if ((nloopi .eq. nl).and.(iproda.eq.iprodc)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc=MAX(c(i,j),imaxc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imaxa=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa=MAX(a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
iminc=c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc=MIN(c(i,j),iminc)
enddo
enddo
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
imina=a(1,1)
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina=MIN(a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2), coora(2), imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl=nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc=c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS(REDUCTION(MAXLOC(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa=a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *,imaxc,imaxa, coorc(1), coorc(2), coora(1), coora(2)
if (imaxc .eq. imaxa.and.coora(1) .eq. coorc(1).and.
* coorc(2) .eq. coora(2) ) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,993 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!DVM$ TEMPLATE,COMMON:: dvmh_temp1(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp1
!DVM$ DYNAMIC dvmh_temp1
!DVM$ TEMPLATE,COMMON:: dvmh_temp2(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp2
!DVM$ DYNAMIC dvmh_temp2
!DVM$ TEMPLATE,COMMON:: dvmh_temp3(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp3
!DVM$ DYNAMIC dvmh_temp3
!DVM$ TEMPLATE,COMMON:: dvmh_temp4(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp4
!DVM$ DYNAMIC dvmh_temp4
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp4(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp4(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp4
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:1,1:1 )
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp4(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc = 0
isuma = 0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
!DVM$ ACTUAL (c)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:1,1:1)),REDUCT
!DVM$&ION (min (nloopi),min (nloopj),sum (isuma))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 0:1,0:0 )
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp0(iEX1,iEX2)
continue
nnl = nl
iproda = 1
iprodc = 1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
!DVM$ ACTUAL (c)
nloopi = nl
nloopj = nl
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,0:0)),REDUCT
!DVM$&ION (min (nloopi),min (nloopj),product (iproda))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp1(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp1(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp1
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:0,0:1 )
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp1(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
imaxa = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT
!DVM$&ION (max (imaxa))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
!DVM$ END REGION
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp2(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp2(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp2
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:0,0:1 )
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp2(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
iminc = c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
imina = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT
!DVM$&ION (min (imina))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
!DVM$ END REGION
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp3(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp3(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp3
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 0:1,1:0 )
character*7 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp3(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!DVM$ REGION
!DVM$ PARALLEL (i,j) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,1:0)),REDUCT
!DVM$&ION (maxloc (imaxa,coora,2))
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
!DVM$ END REGION
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *, imaxc,imaxa,coorc(1),coorc(2),coora(1),coora(2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc(1) .and. coorc(2) .
&eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/p1/visualiser_data/options/acrred21.for.dep

View File

@@ -1,993 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!DVM$ TEMPLATE,COMMON:: dvmh_temp1(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp1
!DVM$ DYNAMIC dvmh_temp1
!DVM$ TEMPLATE,COMMON:: dvmh_temp2(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp2
!DVM$ DYNAMIC dvmh_temp2
!DVM$ TEMPLATE,COMMON:: dvmh_temp3(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp3
!DVM$ DYNAMIC dvmh_temp3
!DVM$ TEMPLATE,COMMON:: dvmh_temp4(1:16,1:16)
!DVM$ DISTRIBUTE (BLOCK,BLOCK) :: dvmh_temp4
!DVM$ DYNAMIC dvmh_temp4
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp4(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp4(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp4
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:1,1:1 )
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp4(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc = 0
isuma = 0
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
!DVM$ ACTUAL (c)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:1,1:1)),REDUCT
!DVM$&ION (min (nloopi),min (nloopj),sum (isuma))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 0:1,0:0 )
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp0(iEX1,iEX2)
continue
nnl = nl
iproda = 1
iprodc = 1
call serial2(c,n,m,nnl)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
!DVM$ ACTUAL (c)
nloopi = nl
nloopj = nl
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,0:0)),REDUCT
!DVM$&ION (min (nloopi),min (nloopj),product (iproda))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp1(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp1(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp1
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:0,0:1 )
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp1(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
imaxa = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT
!DVM$&ION (max (imaxa))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
!DVM$ END REGION
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*15 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp2(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp2(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp2
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 1:0,0:1 )
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp2(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
iminc = c(1,1)
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
imina = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j),ACROSS (a(1:0,0:1)),REDUCT
!DVM$&ION (min (imina))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
!DVM$ END REGION
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
!DVM$ TEMPLATE, COMMON :: dvmh_temp3(1:16,1:16)
!DVM$ DISTRIBUTE dvmh_temp3(BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp3
!DVM$ ALIGN :: a
!DVM$ DYNAMIC a
integer ,allocatable:: a(:,:),c(:,:)
!DVM$ SHADOW a( 0:1,1:0 )
character*15 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
!DVM$ REALIGN a(iEX1,iEX2) WITH dvmh_temp3(iEX1,iEX2)
continue
nnl = nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
!DVM$ REGION
!DVM$ PARALLEL (j,i) ON a(i,j), PRIVATE (i,j)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
!DVM$ REMOTE_ACCESS (a(1,1))
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!DVM$ REGION
!DVM$ PARALLEL (i,j) ON a(i,j), PRIVATE (i,j),ACROSS (a(0:1,1:0)),REDUCT
!DVM$&ION (maxloc (imaxa,coora,2))
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
!DVM$ END REGION
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *, imaxc,imaxa,coorc(1),coorc(2),coora(1),coora(2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc(1) .and. coorc(2) .
&eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*15 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*15 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/p2/visualiser_data/options/acrred21.for.dep

View File

@@ -1,940 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
nloopi = nl
nloopj = nl
isumc = 0
isuma = 0
!DVM$ REGION
!DVM$ PARALLEL (i,j), PRIVATE (i,j),TIE (c(i,j)),ACROSS (c(1:1,1:1)),RED
!DVM$&UCTION (sum (isumc))
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j))
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j),c(i,j)),ACROSS (a(1:1,1:
!DVM$&1)),REDUCTION (min (nloopi),min (nloopj),sum (isuma))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(n,m),c(n,m))
nnl = nl
iproda = 1
iprodc = 1
call serial2(c,n,m,nnl)
!DVM$ REGION
!DVM$ PARALLEL (i,j), PRIVATE (i,j),TIE (c(i,j)),ACROSS (c(0:1,0:0)),RED
!DVM$&UCTION (product (iprodc))
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
!DVM$ END REGION
nloopi = nl
nloopj = nl
!DVM$ REGION
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j))
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j),c(i,j)),ACROSS (a(0:1,0:
!DVM$&0)),REDUCTION (min (nloopi),min (nloopj),product (iproda))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
!DVM$ END REGION
if (nloopi .eq. nl .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
!DVM$ GET_ACTUAL (c)
imaxc = c(1,1)
!DVM$ REGION
!DVM$ PARALLEL (i,j), PRIVATE (i,j),TIE (c(i,j)),ACROSS (c(1:0,0:1)),RED
!DVM$&UCTION (max (imaxc))
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j))
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
imaxa = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j)),ACROSS (a(1:0,0:1)),RED
!DVM$&UCTION (max (imaxa))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
!DVM$ END REGION
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
!DVM$ GET_ACTUAL (c)
iminc = c(1,1)
!DVM$ REGION
!DVM$ PARALLEL (i,j), PRIVATE (i,j),TIE (c(i,j)),ACROSS (c(1:0,0:1)),RED
!DVM$&UCTION (min (iminc))
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j))
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL (a)
imina = a(1,1)
!DVM$ REGION
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j)),ACROSS (a(1:0,0:1)),RED
!DVM$&UCTION (min (imina))
do j = 2,m - 1
do i = 2,n - 1
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
!DVM$ END REGION
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,n - 1
do j = 2,m - 1
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
!DVM$ REGION
!DVM$ PARALLEL (j,i), PRIVATE (i,j),TIE (a(i,j))
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
!DVM$ END REGION
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
!DVM$ GET_ACTUAL (a)
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
!DVM$ ACTUAL (coora(1))
coora(2) = 1
!DVM$ ACTUAL (coora(2))
!DVM$ REGION
!DVM$ PARALLEL (i,j), PRIVATE (i,j),TIE (a(i,j)),ACROSS (a(0:1,1:0)),RED
!DVM$&UCTION (maxloc (imaxa,coora,2))
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,n - 1
do j = 2,m - 1
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
!DVM$ END REGION
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
!DVM$ GET_ACTUAL (coora)
print *, imaxc,imaxa,coorc(1),coorc(2),coora(1),coora(2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc(1) .and. coorc(2) .
&eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 3,n - 2
do j = 3,m - 2
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,m - 2
do i = 3,n - 2
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 4,n - 3
do j = 4,m - 3
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,m - 3
do i = 4,n - 3
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(n,m),c(n,m))
nnl = nl
call serial2(c,n,m,nnl)
do i = 12,n - 11
do j = 12,m - 11
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = nl
nloopj = nl
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,m
do i = 1,n
a(i,j) = nl + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,m - 11
do i = 12,n - 11
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. nl) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/v1/visualiser_data/options/acrred21.for.dep

View File

@@ -1,894 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
nloopi = 1000
nloopj = 1000
isumc = 0
isuma = 0
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(16,16),c(16,16))
nnl = 1000
iproda = 1
iprodc = 1
call serial2(c,16,16,1000)
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imaxa = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
iminc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imina = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
!$SPF ANALYSIS(PROCESS_PRIVATE(coorc_io_l0))
integer :: coorc_io_l0(2)
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,15
do j = 2,15
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,15
do j = 2,15
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
coorc_io_l0 = coorc
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *, imaxc,imaxa,coorc_io_l0(1),coorc_io_l0(2),coora(1),coora(
&2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc_io_l0(1) .and. coor
&c_io_l0(2) .eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(59,59),c(59,59))
nnl = 1000
call serial2(c,59,59,1000)
do i = 12,48
do j = 12,48
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,59
do i = 1,59
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,48
do i = 12,48
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,894 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
nloopi = 1000
nloopj = 1000
isumc = 0
isuma = 0
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(16,16),c(16,16))
nnl = 1000
iproda = 1
iprodc = 1
call serial2(c,16,16,1000)
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imaxa = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
iminc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imina = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
!$SPF ANALYSIS(PROCESS_PRIVATE(coorc_io_l0))
integer :: coorc_io_l0(2)
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,15
do j = 2,15
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,15
do j = 2,15
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
coorc_io_l0 = coorc
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *, imaxc,imaxa,coorc_io_l0(1),coorc_io_l0(2),coora(1),coora(
&2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc_io_l0(1) .and. coor
&c_io_l0(2) .eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(59,59),c(59,59))
nnl = 1000
call serial2(c,59,59,1000)
do i = 12,48
do j = 12,48
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,59
do i = 1,59
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,48
do i = 12,48
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,894 +0,0 @@
! *** generated by SAPFOR with version 2373 and build date: Nov 22 2024 12:15:43
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program acrred21
! TESTING OF THE acrredOSS CLAUSE.
! DISTRIBUTED ARRAY A(N,M) IS TO HAVE DIFFERENT
! FLOW-DEP-LENGTH ON BOTH SIDES
print *, '===START OF acrred21========================'
! --------------------------------------------------
call acrred2101()
! --------------------------------------------------
call acrred2102()
! --------------------------------------------------
call acrred2103()
! -------------------------------------------------
call acrred2104()
! -------------------------------------------------
call acrred2105()
! -------------------------------------------------
! call acrred2106()
!
! --------------------------------------------------
! call acrred2107()
!
! --------------------------------------------------
! call acrred2108()
!
! --------------------------------------------------
! call acrred2109()
!
! -------------------------------------------------
! call acrred2110()
!
! -------------------------------------------------
! call acrred2111()
!
! -------------------------------------------------
! call acrred2112()
!
! -------------------------------------------------
! call acrred2113()
!
! -------------------------------------------------
! call acrred2114()
!
! -------------------------------------------------
! call acrred2115()
! -------------------------------------------------
print *, '=== END OF acrred21 ========================= '
end
! ---------------------------------------------acrred2101
subroutine acrred2101 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,isumc,isuma
intrinsic min
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2101'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
nloopi = 1000
nloopj = 1000
isumc = 0
isuma = 0
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j) + c(i,j + 1) + c(i - 1,j) + c(i,j - 1)
isumc = isumc + c(i,j)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j) + a(i,j + 1) + a(i - 1,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
isuma = isuma + a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. isuma .eq. isumc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ---------------------------------------------acrred2102
subroutine acrred2102 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj,iproda,iprodc
intrinsic min
tname = 'acrred2102'
allocate(a(16,16),c(16,16))
nnl = 1000
iproda = 1
iprodc = 1
call serial2(c,16,16,1000)
do i = 2,15
do j = 2,15
c(i,j) = c(i + 1,j)
iprodc = iprodc * c(i,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
do j = 2,15
do i = 2,15
a(i,j) = a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
iproda = iproda * a(i,j)
enddo
enddo
if (nloopi .eq. 1000 .and. iproda .eq. iprodc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------acrred2103
subroutine acrred2103 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: imaxc,imaxa
intrinsic max
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
imaxc = max (c(i,j),imaxc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imaxa = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imaxa = max (a(i,j),imaxa)
enddo
enddo
if (imaxa .eq. imaxc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2104
subroutine acrred2104 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*10 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: iminc,imina
intrinsic min
tname = 'acrred2103'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
iminc = c(1,1)
do i = 2,15
do j = 2,15
c(i,j) = c(i - 1,j) + c(i,j + 1)
iminc = min (c(i,j),iminc)
enddo
enddo
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
imina = a(1,1)
do j = 2,15
do i = 2,15
a(i,j) = a(i - 1,j) + a(i,j + 1)
imina = min (a(i,j),imina)
enddo
enddo
if (imina .eq. iminc) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! ------------------------------------------acrred2105
subroutine acrred2105 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*10 :: tname
integer :: coorc(2),coora(2),imaxc,imaxa,nnl
!$SPF ANALYSIS(PROCESS_PRIVATE(coorc_io_l0))
integer :: coorc_io_l0(2)
! DVM$ SHADOW A( 0:1,1:1 )
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2105'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
imaxc = c(1,1)
lcoor = 2
coorc(1) = 1
coorc(2) = 1
do i = 2,15
do j = 2,15
c(i,j) = c(i,j - 1) + c(i + 1,j)
if (c(i,j) .gt. imaxc) then
imaxc = c(i,j)
coorc(1) = i
coorc(2) = j
endif
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,1:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
imaxa = a(1,1)
lcoor = 2
coora(1) = 1
coora(2) = 1
!$SPF ANALYSIS (REDUCTION (maxloc(imaxa,coora,2)))
do i = 2,15
do j = 2,15
a(i,j) = a(i,j - 1) + a(i + 1,j)
if (a(i,j) .gt. imaxa) then
imaxa = a(i,j)
coora(1) = i
coora(2) = j
endif
enddo
enddo
coorc_io_l0 = coorc
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
print *, imaxc,imaxa,coorc_io_l0(1),coorc_io_l0(2),coora(1),coora(
&2)
if (imaxc .eq. imaxa .and. coora(1) .eq. coorc_io_l0(1) .and. coor
&c_io_l0(2) .eq. coora(2)) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2106
subroutine acrred2106 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2106'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i + 2,j) + c(i - 2,j) +
& c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i + 2,j) + a(i - 2,j) +
& a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2107
subroutine acrred2107 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2107'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i + 2,j) + c(i,j + 2) + c(i,j - 2)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:2,2:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i + 2,j) + a(i,j + 2) + a(i,j - 2)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2108
subroutine acrred2108 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,2:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2108'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i - 1,j) + c(i,j - 1) + c(i - 2,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,2:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i - 1,j) + a(i,j - 1) + a(i - 2,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2109
subroutine acrred2109 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (2:2,0:2):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2109'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j + 2) + c(i + 1,j) + c(i + 2,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(2:2,0:2))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j + 2) + a(i + 1,j) + a(i + 2,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2110
subroutine acrred2110 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2110'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i + 1,j) + c(i,j + 2) + c(i + 3,j) + c(i,j - 3) +
& c(i - 2,j) + c(i,j - 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i + 1,j) + a(i,j + 2) + a(i + 3,j) + a(i,j - 3) +
& a(i - 2,j) + a(i,j - 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -------------------------------------------acrred2111
subroutine acrred2111 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,0:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2111'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i,j + 1)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:0,0:1))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i,j + 1)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2112
subroutine acrred2112 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (0:3,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2112'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 3,14
do j = 3,14
c(i,j) = c(i,j) + c(i + 1,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(0:1,0:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 3,14
do i = 3,14
a(i,j) = a(i,j) + a(i + 1,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2113
subroutine acrred2113 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:3,3:0):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2113'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i,j - 3) + c(i + 3,j) + c(i - 3,j)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:3,3:0))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i,j - 3) + a(i + 3,j) + a(i - 3,j)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2114
subroutine acrred2114 ()
integer ,parameter:: n = 16,m = 16,nl = 1000
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
character*7 :: tname
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (3:0,3:3):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2114'
allocate(a(16,16),c(16,16))
nnl = 1000
call serial2(c,16,16,1000)
do i = 4,13
do j = 4,13
c(i,j) = c(i - 3,j) + c(i,j + 3)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,16
do i = 1,16
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(3:0,3:3))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 4,13
do i = 4,13
a(i,j) = a(i - 3,j) + a(i,j + 3)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! --------------------------------------------acrred2115
subroutine acrred2115 ()
integer ,parameter:: n = 59,m = 59,nl = 1000
character*7 :: tname
!$SPF ANALYSIS (PROCESS_PRIVATE (c))
integer ,allocatable:: a(:,:),c(:,:)
integer :: nloopi,nloopj
intrinsic min
! DVM$ SHADOW (11:11,11:11):: A
! DVM$ DISTRIBUTE (BLOCK,BLOCK) :: A
tname = 'acrred2115'
allocate(a(59,59),c(59,59))
nnl = 1000
call serial2(c,59,59,1000)
do i = 12,48
do j = 12,48
c(i,j) = c(i + 11,j) + c(i,j + 10) + c(i + 9,j) + c(i,j - 11
&) + c(i - 10,j) + c(i,j - 9)
enddo
enddo
nloopi = 1000
nloopj = 1000
! DVM$ PARALLEL (J,I) ON A(I,J)
! DVM$ REGION
! DVM$ ACTUAL (NLOOPI,NLOOPJ)
do j = 1,59
do i = 1,59
a(i,j) = 1000 + i + j
enddo
enddo
! DVM$ PARALLEL (J,I) ON A(I,J), acrredOSS (A(11:11,11:11))
! DVM$ PARALLEL (J,I) ON A(I,J), REDUCTION (MIN(NLOOPI),MIN(NLOOPJ))
do j = 12,48
do i = 12,48
a(i,j) = a(i + 11,j) + a(i,j + 10) + a(i + 9,j) + a(i,j - 11
&) + a(i - 10,j) + a(i,j - 9)
if (a(i,j) .ne. c(i,j)) then
nloopi = min (nloopi,i)
nloopj = min (nloopj,j)
endif
enddo
enddo
! DVM$ GET_ACTUAL (NLOOPI)
! DVM$ END REGION
if (nloopi .eq. 1000) then
call ansyes(tname)
else
call ansno(tname)
endif
deallocate(a,c)
end
! -----------------------------------------------
subroutine serial2 (ar, n, m, nl)
integer :: ar(n,m)
integer :: nl
intent(in) m,n,nl
intent(out) ar
do i = 1,n
do j = 1,m
ar(i,j) = nl + i + j
enddo
enddo
end
subroutine ansyes (name)
character*7 :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character*7 :: name
intent(in) name
print *, name,' - ***error'
end

File diff suppressed because it is too large Load Diff

View File

@@ -1,34 +0,0 @@
Mon Dec 2 18:10:40 2024: create and connect to server socket with port 14733
Mon Dec 2 18:10:40 2024: done
Mon Dec 2 18:10:40 2024: start main communications
Mon Dec 2 18:10:40 2024: wait for command from server
Mon Dec 2 18:10:40 2024: done with message size 37
Mon Dec 2 18:10:40 2024: decode message as analysis
Mon Dec 2 18:10:40 2024: send results to server
Mon Dec 2 18:10:40 2024: done with code 0
Mon Dec 2 18:10:40 2024: wait for command from server
Mon Dec 2 18:10:40 2024: done with message size 108
Mon Dec 2 18:10:40 2024: decode message as analysis
Mon Dec 2 18:10:40 2024: send results to server
Mon Dec 2 18:10:40 2024: done with code 0
Mon Dec 2 18:10:40 2024: wait for command from server
Mon Dec 2 18:11:05 2024: done with message size 261
Mon Dec 2 18:11:05 2024: decode message as analysis
Mon Dec 2 18:11:07 2024: send results to server
Mon Dec 2 18:11:07 2024: done with code 0
Mon Dec 2 18:11:07 2024: wait for command from server
Mon Dec 2 18:13:36 2024: done with message size 84
Mon Dec 2 18:13:36 2024: decode message as analysis
Mon Dec 2 18:13:36 2024: send results to server
Mon Dec 2 18:13:36 2024: done with code 0
Mon Dec 2 18:13:36 2024: wait for command from server
Mon Dec 2 18:15:35 2024: done with message size 84
Mon Dec 2 18:15:35 2024: decode message as analysis
Mon Dec 2 18:15:35 2024: send results to server
Mon Dec 2 18:15:35 2024: done with code 0
Mon Dec 2 18:15:35 2024: wait for command from server
Mon Dec 2 18:17:45 2024: done with message size 84
Mon Dec 2 18:17:45 2024: decode message as analysis
Mon Dec 2 18:17:45 2024: send results to server
Mon Dec 2 18:17:45 2024: done with code 0
Mon Dec 2 18:17:45 2024: wait for command from server

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": true,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": true,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 100,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": "",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": true,
"PARSE_FOR_INLINE": false,
"Precompilation": false,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": ""
}

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/v3/p1/visualiser_data/options/acrred21.for.dep

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/v3/visualiser_data/options/acrred21.for.dep

View File

@@ -1 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_ACROSS_REDUCTION/acrred21/visualiser_data/options/acrred21.for.dep

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,167 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,166 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,167 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,167 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,167 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,11 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
double precision function calculate (value)
double precision :: value
calculate = value / 6
end

View File

@@ -1,167 +0,0 @@
! *** generated by SAPFOR with version 2236 and build date: Nov 7 2023 14:50:57
! *** Enabled options ***:
! *** consider DVMH directives
! *** save SPF directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2 ,calculate
character(len=9) :: tname='contains1'
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
CDVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol(i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
CDVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate((a(i - 1,j,k) + a(i + 1,j,k) + a(i,j - 1,k) +
&a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1)))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,236 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(inout) a
intent(in) nz,ny,nx
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) b,a
intent(in) nz,ny,nx
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,19 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) nz,ny,nx,kk,jj,ii
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) nz,ny,nx,kk,jj,ii
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,3 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p1/visualiser_data/options/sol.for.dep

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,34 +0,0 @@
Tue Jan 21 16:13:23 2025: create and connect to server socket with port 5577
Tue Jan 21 16:13:23 2025: done
Tue Jan 21 16:13:23 2025: start main communications
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:23 2025: done with message size 37
Tue Jan 21 16:13:23 2025: decode message as analysis
Tue Jan 21 16:13:23 2025: send results to server
Tue Jan 21 16:13:23 2025: done with code 0
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:23 2025: done with message size 116
Tue Jan 21 16:13:23 2025: decode message as analysis
Tue Jan 21 16:13:23 2025: send results to server
Tue Jan 21 16:13:23 2025: done with code 0
Tue Jan 21 16:13:23 2025: wait for command from server
Tue Jan 21 16:13:49 2025: done with message size 268
Tue Jan 21 16:13:49 2025: decode message as analysis
Tue Jan 21 16:13:51 2025: send results to server
Tue Jan 21 16:13:51 2025: done with code 0
Tue Jan 21 16:13:51 2025: wait for command from server
Tue Jan 21 16:14:31 2025: done with message size 84
Tue Jan 21 16:14:31 2025: decode message as analysis
Tue Jan 21 16:14:31 2025: send results to server
Tue Jan 21 16:14:31 2025: done with code 0
Tue Jan 21 16:14:31 2025: wait for command from server
Tue Jan 21 16:15:55 2025: done with message size 84
Tue Jan 21 16:15:55 2025: decode message as analysis
Tue Jan 21 16:15:55 2025: send results to server
Tue Jan 21 16:15:55 2025: done with code 0
Tue Jan 21 16:15:55 2025: wait for command from server
Tue Jan 21 16:30:23 2025: done with message size 84
Tue Jan 21 16:30:23 2025: decode message as analysis
Tue Jan 21 16:30:23 2025: send results to server
Tue Jan 21 16:30:23 2025: done with code 0
Tue Jan 21 16:30:23 2025: wait for command from server

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,240 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,1:1 )
!DVM$ SHADOW a( 1:1,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(inout) a
intent(in) nz,ny,nx
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) b,a
intent(in) nz,ny,nx
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,19 +0,0 @@
! *** generated by SAPFOR with version 2237 and build date: Nov 8 2023 13:50:20
! *** Enabled options ***:
! *** consider DVMH directives
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) nz,ny,nx,kk,jj,ii
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) nz,ny,nx,kk,jj,ii
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,19 +0,0 @@
Wed Nov 8 19:40:29 2023: create and connect to server socket with port 3031
Wed Nov 8 19:40:29 2023: done
Wed Nov 8 19:40:29 2023: start main communications
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:40:29 2023: done with message size 37
Wed Nov 8 19:40:29 2023: decode message as analysis
Wed Nov 8 19:40:29 2023: send results to server
Wed Nov 8 19:40:29 2023: done with code 0
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:40:29 2023: done with message size 119
Wed Nov 8 19:40:29 2023: decode message as analysis
Wed Nov 8 19:40:29 2023: send results to server
Wed Nov 8 19:40:29 2023: done with code 0
Wed Nov 8 19:40:29 2023: wait for command from server
Wed Nov 8 19:42:32 2023: done with message size 271
Wed Nov 8 19:42:32 2023: decode message as analysis
Wed Nov 8 19:42:33 2023: send results to server
Wed Nov 8 19:42:33 2023: done with code 0
Wed Nov 8 19:42:33 2023: wait for command from server

View File

@@ -1,3 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/p2/visualiser_data/options/sol.for.dep

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,248 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,*,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,0:0,1:1 )
!DVM$ SHADOW a( 0:0,0:0,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,*,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,1:1,0:0 )
!DVM$ SHADOW a( 0:0,1:1,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,BLOCK,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 0:0,1:1,1:1 )
!DVM$ SHADOW a( 0:0,1:1,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (*,BLOCK,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(*,BLOCK,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,0:0,0:0 )
!DVM$ SHADOW a( 1:1,0:0,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,*,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,0:0,1:1 )
!DVM$ SHADOW a( 1:1,0:0,1:1 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,*,BLOCK) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,*,BLOCK)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,12 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
calculate = value / 6
end

View File

@@ -1,250 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
program contains1
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
!DVM$ ALIGN :: a
!DVM$ ALIGN :: b
!DVM$ ALIGN :: a2
!DVM$ ALIGN :: b2
!DVM$ DYNAMIC a,a2,b,b2
double precision ,dimension(:,:,:):: a,b,a2,b2
!DVM$ SHADOW a2( 1:1,1:1,0:0 )
!DVM$ SHADOW a( 1:1,1:1,0:0 )
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
!DVM$ TEMPLATE,COMMON:: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE (BLOCK,BLOCK,*) :: dvmh_temp0
!DVM$ DYNAMIC dvmh_temp0
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
!DVM$ REALIGN a(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
!DVM$ REALIGN a2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
!DVM$ REALIGN b2(iEX1,iEX2,iEX3) WITH dvmh_temp0(iEX1,iEX2,iEX3)
continue
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
!DVM$ INHERIT a
!DVM$ DYNAMIC a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz)
! DVM$ INHERIT A
integer :: nx,ny,nz
intent(in) nx,ny,nz
intent(out) a
interface
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
end function
end interface
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (i,j,k)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END REGION
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
!DVM$ INHERIT b,a
!DVM$ DYNAMIC b,a
!---------------------------------------------------------------------
!---------------------------------------------------------------------
!DVM$ TEMPLATE, COMMON :: dvmh_temp0(1:4,1:4,1:4)
!DVM$ DISTRIBUTE dvmh_temp0(BLOCK,BLOCK,*)
!DVM$ DYNAMIC dvmh_temp0
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
! DVM$ INHERIT A,B
integer :: nx,ny,nz
intent(inout) a,b
intent(in) nx,ny,nz
intrinsic abs,max
interface
pure double precision function calculate (value)
!DVM$ ROUTINE
double precision :: value
intent(in) value
end function
end interface
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON b(i,j,k), PRIVATE (i,j,k),SHADOW_RENEW (a)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
!DVM$ END REGION
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
!DVM$ REGION
!DVM$ PARALLEL (k,j,i) ON a(i,j,k), PRIVATE (bt,i,j,k),REDUCTION (max (e
!DVM$&ps))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
!DVM$ END REGION
relax2 = eps
end
subroutine ansyes (name)
character(len=9) :: name
intent(in) name
print *, name,' - complete'
end
subroutine ansno (name)
character(len=9) :: name
intent(in) name
print *, name,' - ***error'
end

View File

@@ -1,20 +0,0 @@
! *** generated by SAPFOR with version 2382 and build date: Jan 15 2025 15:14:37
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR
pure double precision function sol (ii, jj, kk, nx, ny, nz)
!DVM$ ROUTINE
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
intent(in) ii,jj,kk,nx,ny,nz
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
pure double precision function val (ii, jj, kk, nx, ny, nz)
integer :: ii,jj,kk,nx,ny,nz
intent(in) ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,23 +0,0 @@
{
"STATIC_SHADOW_ANALYSIS": false,
"STATIC_PRIVATE_ANALYSIS": true,
"FREE_FORM": false,
"KEEP_DVM_DIRECTIVES": false,
"KEEP_SPF_DIRECTIVES": false,
"PARALLELIZE_FREE_LOOPS": false,
"MAX_SHADOW_WIDTH": 50,
"OUTPUT_UPPER": false,
"TRANSLATE_MESSAGES": true,
"KEEP_LOOPS_CLOSE_NESTING": false,
"KEEP_GCOV": false,
"ANALYSIS_OPTIONS": " ",
"DEBUG_PRINT_ON": false,
"MPI_PROGRAM": false,
"IGNORE_IO_SAPFOR": false,
"KEEP_SPF_DIRECTIVES_AMONG_TRANSFORMATIONS": false,
"PARSE_FOR_INLINE": false,
"Precompilation": true,
"SaveModifications": true,
"GCOVLimit": 10,
"DVMConvertationOptions": " "
}

View File

@@ -1,13 +0,0 @@
double precision FUNCTION sol (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
double precision val
sol = 10.*val(ii,jj,kk,nx,ny,nz)
END
double precision FUNCTION val (ii,jj,kk,nx,ny,nz)
integer:: ii,jj,kk,nx,ny,nz
val = (ii-1)/(nx-1) +(jj-1)/(ny-1)+
> (kk-1)/(nz-1)
END

View File

@@ -1,15 +0,0 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function calculate (value)
implicit none
double precision :: value
calculate = value / 6
end

View File

@@ -1,191 +0,0 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
program contains1
implicit none
!
! integer ,parameter:: nxd = 32,nyd = 64,nzd = 32,itmaxd = 50
integer ,parameter:: nxd = 4,nyd = 4,nzd = 4,itmaxd = 2
double precision ,dimension(:,:,:):: a,b,a2,b2
allocatable:: a,b,a2,b2
! DVM$ ALIGN (I,J,K) WITH A(I,J,K):: B,A2,B2
! DVM$ DISTRIBUTE (BLOCK,BLOCK,BLOCK):: A
double precision :: relax2,eps1,eps2,calculate
character(len=9) :: tname='contains1'
integer :: it,itmax,nx,ny,nz
real :: relax1
!---------------------------------------------------------------------
! Read input file (if it exists), else take
! defaults from parameters
!---------------------------------------------------------------------
! open (unit=2,file='input.dat',status='old', iostat=istatus)
!
! if (istatus .eq. 0) then
! read (2,*) nx,ny,nz
! read (2,*) itmax
! close(2)
! else
nx = nxd
ny = nyd
nz = nzd
itmax = itmaxd
! endif
allocate(a(nx,ny,nz),b(nx,ny,nz))
allocate(a2(nx,ny,nz),b2(nx,ny,nz))
call init(a,nx,ny,nz)
call init(a2,nx,ny,nz)
!ВМЬ
! ITERATIONS
do it = 1,itmax
eps1 = relax1 ()
eps2 = relax2 (a2,b2,nx,ny,nz)
enddo
! END ITERATIONS
deallocate(a,b,a2,b2)
if (eps1 .eq. eps2) then
call ansyes(tname)
else
call ansno(tname)
endif
contains
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax1 ()
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: eps,bt
double precision :: calculate
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *, b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax1 = eps
end function
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
subroutine init (a, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),sol
! DVM$ INHERIT A
integer :: nx,ny,nz
integer :: i,j,k
! solution (i, j, k) = 10. * (i - 1) / (nx - 1) + 10. * (j - 1) / (n
! &y - 1) + 10. * (k - 1) / (nz - 1)
!DVM$ INTERVAL 1
! DVM$ PARALLEL (K,J,I) ON A(I,J,K)
do k = 1,nz
do j = 1,ny
do i = 1,nx
if (k .eq. 1 .or. k .eq. nz .or. j .eq. 1 .or. j .eq. ny
&.or. i .eq. 1 .or. i .eq. nx) then
a(i,j,k) = sol (i,j,k,nx,ny,nz)
else
a(i,j,k) = 0.d0
endif
enddo
enddo
enddo
!DVM$ END INTERVAL
end
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision function relax2 (a, b, nx, ny, nz)
implicit none
!---------------------------------------------------------------------
!---------------------------------------------------------------------
double precision :: a(nx,ny,nz),b(nx,ny,nz),eps,bt
double precision :: calculate
! DVM$ INHERIT A,B
integer :: nx,ny,nz
integer :: i,j,k,max
real :: abs
! DVM$ PARALLEL (K,J,I) ON B(I,J,K), SHADOW_RENEW (A)
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
b(i,j,k) = calculate (a(i - 1,j,k) + a(i + 1,j,k) + a(i,j
& - 1,k) + a(i,j + 1,k) + a(i,j,k - 1) + a(i,j,k + 1))
enddo
enddo
enddo
! print *,b
eps = 0.d0
! DVM$ PARALLEL (K,J,I) ON A(I,J,K), REDUCTION (MAX(EPS))
do k = 2,nz - 1
do j = 2,ny - 1
do i = 2,nx - 1
bt = b(i,j,k)
eps = max (eps,abs (bt - a(i,j,k)))
a(i,j,k) = bt
enddo
enddo
enddo
relax2 = eps
end
subroutine ansyes (name)
implicit none
character(len=9) :: name
print *, name,' - complete'
end
subroutine ansno (name)
implicit none
character(len=9) :: name
print *, name,' - ***error'
end

View File

@@ -1,23 +0,0 @@
! *** generated by SAPFOR with version 2343 and build date: May 19 2024 20:06:27
! *** Enabled options ***:
! *** shadow optimization
! *** save SPF directives
! *** MPI program regime (shared memory parallelization)
! *** ignore I/O checker for arrays (DVM I/O limitations)
! *** maximum shadow width is 100 percent
! *** generated by SAPFOR
double precision function sol (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
double precision :: val
sol = 10. * val (ii,jj,kk,nx,ny,nz)
end
double precision function val (ii, jj, kk, nx, ny, nz)
implicit none
integer :: ii,jj,kk,nx,ny,nz
val = (ii - 1) / (nx - 1) + (jj - 1) / (ny - 1) + (kk - 1) / (nz -
& 1)
end

View File

@@ -1,3 +0,0 @@
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/call.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/contains31.for.dep
E:/USERS/Olga/WORK/VISUAL_prj/VISUAL_PRIVATE_ROUTINE_Kolganov/test_routine_4/v1/visualiser_data/options/sol.for.dep

Some files were not shown because too many files have changed in this diff Show More