From 4b74ee14c77b99dbc04c192fef84fd377ade1010 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Fri, 5 May 2023 15:45:00 +0530 Subject: [PATCH 01/29] Fix added for the build error related to multiple definition of 'global_thread_mutex' object when linked with libFlame with gcc-12. Renamed 'global_thread_mutex' object to 'sl_global_thread_mutex'. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3299] Change-Id: I60d7c3897de9e4563a2fe56c60a8d15497cb6a95 --- FRAMEWORK/SL_Context.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/FRAMEWORK/SL_Context.c b/FRAMEWORK/SL_Context.c index 12235be8..e4de920f 100644 --- a/FRAMEWORK/SL_Context.c +++ b/FRAMEWORK/SL_Context.c @@ -102,7 +102,7 @@ void scalapack_pthread_once(scalapack_pthread_once_t *once, void (*init)(void)) **/ aocl_scalapack_global_context scalapack_context = {0,0,0}; /* A mutex to allow synchronous access to global_thread. */ -scalapack_pthread_mutex_t global_thread_mutex = SL_PTHREAD_MUTEX_INITIALIZER; +scalapack_pthread_mutex_t sl_global_thread_mutex = SL_PTHREAD_MUTEX_INITIALIZER; /******************************************************************************** * \brief scalapack_env_get_var is a function used to query the environment * variable and convert the string into integer and return the same @@ -216,8 +216,8 @@ void scalapack_thread_set_num_threads(int n_threads) // We must ensure that global_thread has been initialized. aocl_scalapack_init_(); // Acquire the mutex protecting global_thread. - scalapack_pthread_mutex_lock(&global_thread_mutex); + scalapack_pthread_mutex_lock(&sl_global_thread_mutex); scalapack_context.num_threads = n_threads; // Release the mutex protecting global_thread. - scalapack_pthread_mutex_unlock(&global_thread_mutex); + scalapack_pthread_mutex_unlock(&sl_global_thread_mutex); } From bf194f2a6b796126982021a0a30f0a24158f2510 Mon Sep 17 00:00:00 2001 From: arunchan Date: Mon, 8 May 2023 13:25:33 +0530 Subject: [PATCH 02/29] Fix the windows build error while linking to global context Signed-off-by: arunchan AMD-Internal: [CPUPL-3341] Change-Id: I2750b508429f04a82047bbd9550c35452e740dee --- TESTING/EIG/CMakeLists.txt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt index 7addff7c..43bb00e0 100644 --- a/TESTING/EIG/CMakeLists.txt +++ b/TESTING/EIG/CMakeLists.txt @@ -7,6 +7,7 @@ set (dmatgen pdmatgen.f pmatgeninc.f) set (cmatgen pcmatgen.f pmatgeninc.f) set (zmatgen pzmatgen.f pmatgeninc.f) set (TTRD_SRC ${CMAKE_SOURCE_DIR}/SRC) +set (FRAMEWORK_SRC ${CMAKE_SOURCE_DIR}/FRAMEWORK) if (WIN32 AND CMAKE_C_COMPILER_ID MATCHES Clang) add_definitions(-D__STDC__) @@ -23,10 +24,10 @@ add_executable(xchrd pchrddriver.f pchrdinfo.f pcgehdrv.f pclafchk.f ${cmatgen}) add_executable(xzhrd pzhrddriver.f pzhrdinfo.f pzgehdrv.f pzlafchk.f ${zmatgen}) if(MSVC) -add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f ${TTRD_SRC}/pssyttrd.f xpjlaenv.f ${smatgen}) -add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f ${TTRD_SRC}/pdsyttrd.f xpjlaenv.f ${dmatgen}) -add_executable(xctrd pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f ${TTRD_SRC}/pchettrd.f xpjlaenv.f ${cmatgen}) -add_executable(xztrd pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f ${TTRD_SRC}/pzhettrd.f xpjlaenv.f ${zmatgen}) +add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f ${TTRD_SRC}/pssyttrd.f xpjlaenv.f ${smatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) +add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f ${TTRD_SRC}/pdsyttrd.f xpjlaenv.f ${dmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) +add_executable(xctrd pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f ${TTRD_SRC}/pchettrd.f xpjlaenv.f ${cmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) +add_executable(xztrd pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f ${TTRD_SRC}/pzhettrd.f xpjlaenv.f ${zmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) else() add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f xpjlaenv.f ${smatgen}) add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f xpjlaenv.f ${dmatgen}) From 7a165d39f15f6fd809662aa2be43cac70ad18293 Mon Sep 17 00:00:00 2001 From: arunchan Date: Mon, 15 May 2023 15:23:10 +0530 Subject: [PATCH 03/29] Update the README files for 4.1 release Signed-off-by: arunchan AMD-Internal: [CPUPL-2702] Change-Id: Id5c6224557b68747e46bd5ba2fe76043e2080a15 --- CMakeLists.txt | 1 + README_ScaLAPACK_AMD | 14 +++--- TESTING/AOCL_PROGRESS_TESTS/README.txt | 59 +++++++++++++++----------- TESTING/README.txt | 39 +++++++++++++++++ 4 files changed, 82 insertions(+), 31 deletions(-) create mode 100644 TESTING/README.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 31fcce7f..eef4e862 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -526,3 +526,4 @@ install(FILES install(EXPORT scalapack-targets DESTINATION lib/cmake/scalapack-${SCALAPACK_VERSION}) +file(COPY scalapack_test.sh DESTINATION ${SCALAPACK_BINARY_DIR}) diff --git a/README_ScaLAPACK_AMD b/README_ScaLAPACK_AMD index 5fca3ca3..2c97560b 100644 --- a/README_ScaLAPACK_AMD +++ b/README_ScaLAPACK_AMD @@ -35,14 +35,16 @@ processors. c. To Build the AOCL-ScaLAPACK library and the test suite, Run the below commands: $ cmake .. -DBUILD_SHARED_LIBS=OFF -DBLAS_LIBRARIES="-fopenmp /libblis-mt.a" - -DLAPACK_LIBRARIES="/libflame.a" + -DLAPACK_LIBRARIES="-lstdc++ /libflame.a" -DCMAKE_C_COMPILER=mpicc -DCMAKE_Fortran_COMPILER=mpif90 -DUSE_OPTIMIZED_LAPACK_BLAS=OFF [-D DENABLE_ILP64=ON] $ make -j - This command generates the AOCL-ScaLAPACK library in the 'build/lib' folder and test applications in the 'build/TESTING' folder. + This command generates the AOCL-ScaLAPACK library in the 'build/lib' folder + and test applications in the 'build/TESTING' folder. -4. To Run the AOCL-ScaLAPACK test suite, Run the below script in the 'build/' folder: - cp -f ../scalapack_test.sh . - ./scalapack_test.sh - Test logs will be generated in 'ScalaPack_TestResults.txt'. +4. To execute the AOCL-ScaLAPACK test suite, run scalapack_test.sh from + 'build/' directory: + + $ ./scalapack_test.sh + Refer TESTING/README.txt to know more about scalapack_test.sh diff --git a/TESTING/AOCL_PROGRESS_TESTS/README.txt b/TESTING/AOCL_PROGRESS_TESTS/README.txt index e9dfd9c5..70f26930 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/README.txt +++ b/TESTING/AOCL_PROGRESS_TESTS/README.txt @@ -1,23 +1,29 @@ -Checking AOCL-ScaLAPACK Operation Progress -=========================================== +Checking the progress of AOCL-ScaLAPACK Operations +================================================== -AOCL libraries may be used to perform lengthy computations (for example, matrix multiplications, solver involving large matrices). These operations/computations may go on for hours. +AOCL libraries may be used to perform lengthy computations (Eg: matrix multiplications, +solver involving large matrices, etc). These operations/computations may go on for hours. -AOCL progress feature provides mechanism for the application to check how far the computations have progressed. Selected set of APIs of AOCL libraries periodically updates the application with progress made so far via a callback function. +AOCL progress feature provides mechanism for the application to check how far +the computations have progressed. Selected set of APIs of AOCL libraries +periodically updates the application with progress made so far via a callback function. -Usage: -====== -The Application needs to define a callback function in specific format and register this callback function with the AOCL-ScaLAPACK library. +AOCL progress is supported for the below APIs: + 1) Cholesky (pcpotrf, pdpotrf, pspotrf, pzpotrf) + 2) LU factorization (pcgetrf, pdgetrf, psgetrf, pzgetrf) + 3) QR factorization (pcgeqrf, pdgeqrf, psgeqrf, pzgeqrf) -The callback function prototype must be as defined below. -int aocl_scalapack_progress( -const char * const api, -const integer *lenapi, -const integer *progress, -const integer *mpi_rank, -const integer *total_mpi_processes -) +Usage +===== +The Application needs to define a callback function in specific +format and register this callback function with the AOCL-ScaLAPACK library. +The callback function prototype must be as defined below. +int aocl_scalapack_progress(const char *const api, + const integer *lenapi, + const integer *progress, + const integer *mpi_rank, + const integer *total_mpi_processes) The table below explains various parameters: ----------------------------------------------------------------------------- @@ -29,29 +35,32 @@ progress | Linear progress made in current thread so far mpi_rank | Current process rank total_mpi_processes | Total number of processes used to perform the operation -Callback Registration: +Callback Registration: ---------------------- -The callback function must be registered with library for it to report the progress. +The callback function must be registered with library for it to report the progress. -aocl_scalapack_set_progress(aocl_scalapack_progress); +aocl_scalapack_set_progress(aocl_scalapack_progress); Example: -------- -int aocl_scalapack_progress(const char* const api, const int *lenapi, const int *progress, const int *mpi_rank, const int *total_mpi_processes) +int aocl_scalapack_progress(const char* const api, const int *lenapi, + const int *progress, const int *mpi_rank, + const int *total_mpi_processes) { - printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api, *progress,*total_mpi_processes ); + printf("In AOCL Progress MPI Rank:%i, API:%s, progress:%i, MPI processes:%i\n", + *mpi_rank, api, *progress,*total_mpi_processes); return 0; } +Procedure to build and run the sample application with aocl progress feature +============================================================================ -Procedure to build and run the sample application with aocl progress feature: -============================================================================= - -1) The scalapack build system generates aocl-progress related test binaries along with test suite application as part of the build process. +1) The scalapack build system generates aocl-progress related test binaries + along with test suite application as part of the build process. Refer AOCL User guide for the scalapack build process. 2) The aocl-progress related tests generated in 'TESTING/AOCL_PROGRESS_TESTS' folder in the build folder. 3) The aocl-progress related tests can be run with the below command: - Ex: mpirun -np 4 ./xap_pdgetrf 32 8 2 2 + Eg: mpirun -np 4 ./xap_pdgetrf 32 8 2 2 mpirun -np 8 ./xap_pdgetrf 1024 32 4 2 diff --git a/TESTING/README.txt b/TESTING/README.txt new file mode 100644 index 00000000..7e92a360 --- /dev/null +++ b/TESTING/README.txt @@ -0,0 +1,39 @@ +Executing the AOCL-ScaLAPACK test suite +======================================= + +To execute AOCL-ScaLAPACK test suite against different +MPI configurations (ranks, binding, etc) you can use the script called +'/scalapack_test.sh' + +Upon running scalapack_test.sh the results will be saved in the +directory $HOME/aocl_scalapack_testing_results. The script provides +several command line options, and if no arguments are given, the +following default options will be used: + + a) MPI ranks => Maximum number of available cpu cores in the system + b) Test programs => All the programs in AOCL-ScaLAPACK test suite + will be executed + c) MPI flavour => The script will search for the mpirun executable in the + PATH variable and corresponding MPI installation will be used. + d) MPI binding, mapping => The test will be performed only with + 'map-by core' and 'bind-to core' + + +Below are some helpful examples demonstrating different options: + +Eg: To test only single precision cholesky transformation for all + the MPI mapping for ranks between 4 to 16 use + $ scalapack_test.sh -t xsllt -s 4 -i 1 -e 16 -c all + +Eg: To test all the programs with maximum avialable ranks + with MPI mapping "map-by l3cache" + $ scalapack_test.sh -t all -c map_l3cache + +To view all the supported options execute the script with argument -h + +Address Sanitizer(ASAN) testing: +================================ + +Address saitizer(ASAN) tests are supported through the AOCL-ScaLAPACK +test suite. To enable the same, include the build configure option +'-DENABLE_ASAN_TESTS=ON'. From 3e7548b47fee6d7eaf51184d28df12497a6d75fb Mon Sep 17 00:00:00 2001 From: nprasadm Date: Tue, 16 May 2023 14:32:17 +0530 Subject: [PATCH 04/29] Fix added for build issue for LLVM(Clang-16) on windows. Corrected the aocl-progress related functions with explicit return type. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3411] Change-Id: I075b319fb6fb526c24cba637ca11ce1e78fa5f53 --- SRC/aocl_scalapack_progress.c | 4 ++-- SRC/aocl_scalapack_progress.h | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/SRC/aocl_scalapack_progress.c b/SRC/aocl_scalapack_progress.c index 7aff206e..fb149394 100644 --- a/SRC/aocl_scalapack_progress.c +++ b/SRC/aocl_scalapack_progress.c @@ -20,7 +20,7 @@ void aocl_scalapack_set_progress_( aocl_scalapack_progress_callback func ) aocl_scalapack_progress_ptr_ = func; } -aocl_scalapack_progress_(const char* const api, const integer *lenapi, const integer* progress, +integer aocl_scalapack_progress_(const char* const api, const integer *lenapi, const integer* progress, const integer* current_process, const integer *total_processes) { integer ret = 0; @@ -30,7 +30,7 @@ aocl_scalapack_progress_(const char* const api, const integer *lenapi, const int return ret; } -AOCL_SCALAPACK_PROGRESS(const char* const api, const integer* lenapi, const integer* progress, +integer AOCL_SCALAPACK_PROGRESS(const char* const api, const integer* lenapi, const integer* progress, const integer* current_process, const integer* total_processes) { integer ret = 0; diff --git a/SRC/aocl_scalapack_progress.h b/SRC/aocl_scalapack_progress.h index 82b34bab..613ae21e 100644 --- a/SRC/aocl_scalapack_progress.h +++ b/SRC/aocl_scalapack_progress.h @@ -30,14 +30,14 @@ const integer *total_processes ); -aocl_scalapack_progress_( +integer aocl_scalapack_progress_( const char* const api, const integer* lenapi, const integer* progress, const integer* current_process, const integer* total_processes ); -AOCL_SCALAPACK_PROGRESS( +integer AOCL_SCALAPACK_PROGRESS( const char* const api, const integer* lenapi, const integer* progress, From 4f6e94d4f2a56843c7757aee30ca7662d1fcbec3 Mon Sep 17 00:00:00 2001 From: arunchan Date: Tue, 2 May 2023 16:31:33 +0530 Subject: [PATCH 05/29] Use 'TOTMEM' to increase the available memory with dynamic allocation The current memory allocation scheme uses 'MEMSIZ' to determine the memory allocation size, it is not the intended use of 'MEMSIZ'. The real purpose of 'MEMSIZ' is to hold the count of total number of array/matrix elements that can be used in a particular process without overwriting the 'TOTAL MEMORY' available to it. Use 'TOTMEM' to increase the memory limit in the case of memory allocation with DYNAMIC_WORK_MEM_ALLOC instead of 'MEMSIZ' Also add the missing 'free()' in few places. Change-Id: I23d7549fcb288de2aa540c63b3d4a401c5e58531 --- TESTING/EIG/pcbrddriver.f | 20 ++++++++++---------- TESTING/EIG/pcevcdriver.f | 12 +++++------- TESTING/EIG/pcgsepdriver.f | 18 ++++++------------ TESTING/EIG/pchrddriver.f | 16 ++++++---------- TESTING/EIG/pcnepdriver.f | 18 ++++++------------ TESTING/EIG/pcsepdriver.f | 9 +++++---- TESTING/EIG/pcseprdriver.f | 9 +++++---- TESTING/EIG/pctrddriver.f | 16 ++++++---------- TESTING/EIG/pdbrddriver.f | 21 ++++++++++----------- TESTING/EIG/pdgsepdriver.f | 18 ++++++------------ TESTING/EIG/pdhrddriver.f | 18 +++++++----------- TESTING/EIG/pdnepdriver.f | 19 +++++++------------ TESTING/EIG/pdsepdriver.f | 13 ++++++------- TESTING/EIG/pdseprdriver.f | 7 ++++++- TESTING/EIG/pdsvddriver.f | 7 ++++++- TESTING/EIG/pdtrddriver.f | 15 +++++---------- TESTING/EIG/psbrddriver.f | 16 ++++++---------- TESTING/EIG/psgsepdriver.f | 12 ++++++++---- TESTING/EIG/pshrddriver.f | 16 ++++++---------- TESTING/EIG/psnepdriver.f | 17 ++++++----------- TESTING/EIG/pssepdriver.f | 11 ++++++----- TESTING/EIG/psseprdriver.f | 9 +++++---- TESTING/EIG/pssvddriver.f | 19 +++++++------------ TESTING/EIG/pstrddriver.f | 16 ++++++---------- TESTING/EIG/pzbrddriver.f | 16 ++++++---------- TESTING/EIG/pzevcdriver.f | 18 ++++++------------ TESTING/EIG/pzgsepdriver.f | 9 +++++---- TESTING/EIG/pzhrddriver.f | 16 ++++++---------- TESTING/EIG/pznepdriver.f | 12 +++++------- TESTING/EIG/pzsepdriver.f | 9 +++++---- TESTING/EIG/pzseprdriver.f | 9 +++++---- TESTING/EIG/pztrddriver.f | 16 ++++++---------- TESTING/LIN/pcdbdriver.f | 19 ++++--------------- TESTING/LIN/pcdtdriver.f | 17 +++++------------ TESTING/LIN/pcgbdriver.f | 27 +++++++++------------------ TESTING/LIN/pcinvdriver.f | 23 +++++++---------------- TESTING/LIN/pclltdriver.f | 19 ++++++------------- TESTING/LIN/pclsdriver.f | 20 ++++++-------------- TESTING/LIN/pcludriver.f | 23 +++++------------------ TESTING/LIN/pcpbdriver.f | 15 ++++----------- TESTING/LIN/pcptdriver.f | 15 ++++----------- TESTING/LIN/pcqrdriver.f | 22 ++++++---------------- TESTING/LIN/pddbdriver.f | 13 ++++--------- TESTING/LIN/pddtdriver.f | 13 ++++--------- TESTING/LIN/pdgbdriver.f | 23 +++++++---------------- TESTING/LIN/pdinvdriver.f | 19 ++++++++----------- TESTING/LIN/pdlltdriver.f | 20 ++++++++------------ TESTING/LIN/pdlsdriver.f | 20 +++++++------------- TESTING/LIN/pdludriver.f | 14 +++++--------- TESTING/LIN/pdpbdriver.f | 17 ++++++----------- TESTING/LIN/pdptdriver.f | 15 +++++---------- TESTING/LIN/pdqrdriver.f | 18 +++++++----------- TESTING/LIN/psdbdriver.f | 15 +++++---------- TESTING/LIN/psdtdriver.f | 13 ++++--------- TESTING/LIN/psgbdriver.f | 21 ++++++--------------- TESTING/LIN/psinvdriver.f | 16 ++++++---------- TESTING/LIN/pslltdriver.f | 16 ++++++---------- TESTING/LIN/pslsdriver.f | 20 +++++++------------- TESTING/LIN/psludriver.f | 16 ++++++---------- TESTING/LIN/pspbdriver.f | 13 ++++--------- TESTING/LIN/psptdriver.f | 13 ++++--------- TESTING/LIN/psqrdriver.f | 16 ++++++---------- TESTING/LIN/pzdbdriver.f | 14 ++++---------- TESTING/LIN/pzdtdriver.f | 14 ++++---------- TESTING/LIN/pzgbdriver.f | 22 ++++++---------------- TESTING/LIN/pzinvdriver.f | 18 ++++++------------ TESTING/LIN/pzlltdriver.f | 18 ++++++------------ TESTING/LIN/pzlsdriver.f | 19 ++++++------------- TESTING/LIN/pzludriver.f | 19 ++++++------------- TESTING/LIN/pzpbdriver.f | 14 ++++---------- TESTING/LIN/pzptdriver.f | 14 ++++---------- TESTING/LIN/pzqrdriver.f | 17 ++++++----------- 72 files changed, 419 insertions(+), 738 deletions(-) diff --git a/TESTING/EIG/pcbrddriver.f b/TESTING/EIG/pcbrddriver.f index 98fb9b39..5a9c5192 100644 --- a/TESTING/EIG/pcbrddriver.f +++ b/TESTING/EIG/pcbrddriver.f @@ -64,20 +64,17 @@ PROGRAM PCBRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC + INTEGER CPLXSZ, MEMSIZ, NTESTS, TOTMEM, REALSZ - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, TOTMEM = 2000000, REALSZ = 8, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER CPLXSZ, NTESTS, TOTMEM, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, TOTMEM = 2000000, REALSZ = 8, - $ NTESTS = 20, + PARAMETER ( CPLXSZ = 8, REALSZ = 8, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK @@ -522,6 +519,9 @@ PROGRAM PCBRDDRIVER IF( NOUT.NE.6 .AND. NOUT.NE.0 ) CLOSE ( NOUT ) END IF * +#ifdef DYNAMIC_WORK_MEM_ALLOC + deallocate(MEM) +#endif CALL BLACS_EXIT( 0 ) * 9999 FORMAT( 'ILLEGAL ', A6, ': ', A5, ' = ', I3, diff --git a/TESTING/EIG/pcevcdriver.f b/TESTING/EIG/pcevcdriver.f index b16b356a..ee77bf13 100644 --- a/TESTING/EIG/pcevcdriver.f +++ b/TESTING/EIG/pcevcdriver.f @@ -68,16 +68,14 @@ PROGRAM PCEVCDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, TOTMEM, MEMSIZ, NTESTS - PARAMETER ( CPLXSZ = 8, TOTMEM = 200000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER (TOTMEM = 200000000) #else - INTEGER CPLXSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - PARAMETER ( CPLXSZ = 8, TOTMEM = 200000000, - $ NTESTS = 20 ) + PARAMETER (TOTMEM = 2100000000) #endif + PARAMETER ( CPLXSZ = 8, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20 ) COMPLEX PADVAL, ZERO, ONE PARAMETER ( PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = ( 0.0E+0, 0.0E+0 ), diff --git a/TESTING/EIG/pcgsepdriver.f b/TESTING/EIG/pcgsepdriver.f index 6cf1a9c4..74e08781 100644 --- a/TESTING/EIG/pcgsepdriver.f +++ b/TESTING/EIG/pcgsepdriver.f @@ -51,8 +51,12 @@ PROGRAM PCGSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, CPLXSZ, NIN - PARAMETER ( TOTMEM = 2000000, CPLXSZ = 8, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 21000000 ) +#endif + PARAMETER ( CPLXSZ = 8, NIN = 11 ) INTEGER MEMSIZ PARAMETER ( MEMSIZ = TOTMEM / CPLXSZ ) * .. @@ -65,19 +69,9 @@ PROGRAM PCGSEPDRIVER * .. Local Arrays .. * INTEGER ISEED( 4 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC COMPLEX MEM( MEMSIZ ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 -* .. -* .. Local Scalars .. - CHARACTER HETERO - CHARACTER*80 SUMMRY, USRINFO - INTEGER CONTEXT, IAM, INFO, ISIEEE, MAXNODES, NNOCHECK, - $ NOUT, NPASSED, NPROCS, NSKIPPED, NTESTS -* .. -* .. Local Arrays .. -* - INTEGER ISEED( 4 ) COMPLEX, allocatable :: MEM (:) #endif * .. diff --git a/TESTING/EIG/pchrddriver.f b/TESTING/EIG/pchrddriver.f index 81d4cd09..66818e3b 100644 --- a/TESTING/EIG/pchrddriver.f +++ b/TESTING/EIG/pchrddriver.f @@ -64,20 +64,16 @@ PROGRAM PCHRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS, TOTMEM - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER CPLXSZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( CPLXSZ = 8, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pcnepdriver.f b/TESTING/EIG/pcnepdriver.f index d973ea75..627f4ea6 100644 --- a/TESTING/EIG/pcnepdriver.f +++ b/TESTING/EIG/pcnepdriver.f @@ -66,24 +66,18 @@ PROGRAM PCNEPDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, TOTMEM, MEMSIZ, NTESTS - PARAMETER ( CPLXSZ = 16, TOTMEM = 200000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20 ) - COMPLEX PADVAL, ZERO, ONE - PARAMETER ( PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = ( 0.0E+0, 0.0E+0 ), - $ ONE = ( 1.0E+0, 0.0E+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 200000000 ) #else - INTEGER CPLXSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - PARAMETER ( CPLXSZ = 16, TOTMEM = 200000000, - $ NTESTS = 20 ) + PARAMETER ( TOTMEM = 2100000000 ) +#endif + PARAMETER ( CPLXSZ = 16, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20 ) COMPLEX PADVAL, ZERO, ONE PARAMETER ( PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = ( 0.0E+0, 0.0E+0 ), $ ONE = ( 1.0E+0, 0.0E+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pcsepdriver.f b/TESTING/EIG/pcsepdriver.f index 691f8726..d784c0e0 100644 --- a/TESTING/EIG/pcsepdriver.f +++ b/TESTING/EIG/pcsepdriver.f @@ -51,13 +51,14 @@ PROGRAM PCSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, CPLXSZ, NIN - PARAMETER ( TOTMEM = 2000000, CPLXSZ = 8, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / CPLXSZ ) + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 21000000 ) #endif + PARAMETER ( CPLXSZ = 8, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / CPLXSZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pcseprdriver.f b/TESTING/EIG/pcseprdriver.f index eedfba6e..89852432 100644 --- a/TESTING/EIG/pcseprdriver.f +++ b/TESTING/EIG/pcseprdriver.f @@ -43,13 +43,14 @@ PROGRAM PCSEPRDRIVER * .. Parameters .. * INTEGER TOTMEM, REALSZ, NIN - PARAMETER ( TOTMEM = 100000000, REALSZ = 8, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) + PARAMETER ( TOTMEM = 100000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 1000000000 ) #endif + PARAMETER ( REALSZ = 8, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pctrddriver.f b/TESTING/EIG/pctrddriver.f index 75271934..02df84f0 100644 --- a/TESTING/EIG/pctrddriver.f +++ b/TESTING/EIG/pctrddriver.f @@ -63,20 +63,16 @@ PROGRAM PCTRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, REALSZ, TOTMEM, MEMSIZ, NTESTS - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER CPLXSZ, REALSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, REALSZ = 4, TOTMEM = 10000000, - $ NTESTS = 20, + PARAMETER ( CPLXSZ = 8, REALSZ = 4, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pdbrddriver.f b/TESTING/EIG/pdbrddriver.f index 08e40911..2af8ab0b 100644 --- a/TESTING/EIG/pdbrddriver.f +++ b/TESTING/EIG/pdbrddriver.f @@ -63,20 +63,16 @@ PROGRAM PDBRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK @@ -100,7 +96,7 @@ PROGRAM PDBRDDRIVER DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 1 ), WTIME( 1 ) #else DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. @@ -518,6 +514,9 @@ PROGRAM PDBRDDRIVER IF( NOUT.NE.6 .AND. NOUT.NE.0 ) CLOSE ( NOUT ) END IF * +#ifdef DYNAMIC_WORK_MEM_ALLOC + deallocate(MEM) +#endif CALL BLACS_EXIT( 0 ) * 9999 FORMAT( 'ILLEGAL ', A6, ': ', A5, ' = ', I3, diff --git a/TESTING/EIG/pdgsepdriver.f b/TESTING/EIG/pdgsepdriver.f index ef6a34c4..f0ab1c98 100644 --- a/TESTING/EIG/pdgsepdriver.f +++ b/TESTING/EIG/pdgsepdriver.f @@ -57,8 +57,12 @@ PROGRAM PDGSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, DBLESZ, NIN - PARAMETER ( TOTMEM = 2000000, DBLESZ = 8, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif + PARAMETER (DBLESZ = 8, NIN = 11 ) INTEGER MEMSIZ PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) * .. @@ -71,19 +75,9 @@ PROGRAM PDGSEPDRIVER * .. Local Arrays .. * INTEGER ISEED( 4 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC DOUBLE PRECISION MEM( MEMSIZ ) #else - INTEGER, PARAMETER :: MEMSIZ = 2100000000 -* .. -* .. Local Scalars .. - CHARACTER HETERO - CHARACTER*80 SUMMRY, USRINFO - INTEGER CONTEXT, IAM, INFO, ISIEEE, MAXNODES, NNOCHECK, - $ NOUT, NPASSED, NPROCS, NSKIPPED, NTESTS -* .. -* .. Local Arrays .. -* - INTEGER ISEED( 4 ) DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. diff --git a/TESTING/EIG/pdhrddriver.f b/TESTING/EIG/pdhrddriver.f index c18ed2d2..1301a047 100644 --- a/TESTING/EIG/pdhrddriver.f +++ b/TESTING/EIG/pdhrddriver.f @@ -63,20 +63,16 @@ PROGRAM PDHRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK @@ -100,7 +96,7 @@ PROGRAM PDHRDDRIVER DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 1 ), WTIME( 1 ) #else DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/EIG/pdnepdriver.f b/TESTING/EIG/pdnepdriver.f index 5dc8816e..2c87c73e 100644 --- a/TESTING/EIG/pdnepdriver.f +++ b/TESTING/EIG/pdnepdriver.f @@ -61,22 +61,17 @@ PROGRAM PDNEPDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, TOTMEM, MEMSIZ, NTESTS - DOUBLE PRECISION PADVAL, ZERO, ONE - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0, - $ ONE = 1.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL, ZERO, ONE - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0, $ ONE = 1.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK @@ -98,7 +93,7 @@ PROGRAM PDNEPDRIVER DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 1 ), WTIME( 1 ) #else DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/EIG/pdsepdriver.f b/TESTING/EIG/pdsepdriver.f index 357472a5..63fb4a88 100644 --- a/TESTING/EIG/pdsepdriver.f +++ b/TESTING/EIG/pdsepdriver.f @@ -60,16 +60,15 @@ PROGRAM PDSEPDRIVER * * .. Parameters .. * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER TOTMEM, DBLESZ, NIN - PARAMETER ( TOTMEM = 2000000, DBLESZ = 8, NIN = 11 ) - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER TOTMEM, DBLESZ, NIN - PARAMETER ( TOTMEM = 20000000, DBLESZ = 8, NIN = 11 ) - INTEGER, PARAMETER :: MEMSIZ = 210000000 + PARAMETER ( TOTMEM = 210000000 ) #endif + PARAMETER ( DBLESZ = 8, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pdseprdriver.f b/TESTING/EIG/pdseprdriver.f index d0b437b7..2d82f5a6 100644 --- a/TESTING/EIG/pdseprdriver.f +++ b/TESTING/EIG/pdseprdriver.f @@ -43,7 +43,12 @@ PROGRAM PDSEPRDRIVER * .. Parameters .. * INTEGER TOTMEM, DBLESZ, NIN - PARAMETER ( TOTMEM = 100000000, DBLESZ = 8, NIN = 11 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 100000000 ) +#else + PARAMETER ( TOTMEM = 1000000000 ) +#endif + PARAMETER ( DBLESZ = 8, NIN = 11 ) INTEGER MEMSIZ PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) * .. diff --git a/TESTING/EIG/pdsvddriver.f b/TESTING/EIG/pdsvddriver.f index e815d626..4893acc4 100644 --- a/TESTING/EIG/pdsvddriver.f +++ b/TESTING/EIG/pdsvddriver.f @@ -48,8 +48,13 @@ PROGRAM PDSVDDRIVER * .. * .. Parameters .. INTEGER MAXSETSIZE, NIN, DBLSIZ, TOTMEM, MEMSIZ +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif PARAMETER ( MAXSETSIZE = 50, NIN = 11, DBLSIZ = 8, - $ TOTMEM = 2000000, MEMSIZ = TOTMEM / DBLSIZ ) + $ MEMSIZ = TOTMEM / DBLSIZ ) * .. * .. Local Arrays .. INTEGER ISEED( 4 ), MM( MAXSETSIZE ), diff --git a/TESTING/EIG/pdtrddriver.f b/TESTING/EIG/pdtrddriver.f index 20abd1a6..d0486609 100644 --- a/TESTING/EIG/pdtrddriver.f +++ b/TESTING/EIG/pdtrddriver.f @@ -62,21 +62,16 @@ PROGRAM PDTRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, TOTMEM, MEMSIZ, NTESTS - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL - INTEGER, PARAMETER :: MEMSIZ = 21000000 - INTEGER, PARAMETER :: TOTMEM = 80000000 PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/psbrddriver.f b/TESTING/EIG/psbrddriver.f index 9c086533..c3333da4 100644 --- a/TESTING/EIG/psbrddriver.f +++ b/TESTING/EIG/psbrddriver.f @@ -63,20 +63,16 @@ PROGRAM PSBRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/psgsepdriver.f b/TESTING/EIG/psgsepdriver.f index 89fff8ec..5cc10b31 100644 --- a/TESTING/EIG/psgsepdriver.f +++ b/TESTING/EIG/psgsepdriver.f @@ -57,13 +57,14 @@ PROGRAM PSGSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, REALSZ, NIN - PARAMETER ( TOTMEM = 2000000, REALSZ = 4, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) #endif + PARAMETER ( REALSZ = 4, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) * .. * .. Local Scalars .. CHARACTER HETERO @@ -259,6 +260,9 @@ PROGRAM PSGSEPDRIVER * CALL BLACS_GRIDEXIT( CONTEXT ) * +#ifdef DYNAMIC_WORK_MEM_ALLOC + deallocate(MEM) +#endif CALL BLACS_EXIT( 0 ) STOP * diff --git a/TESTING/EIG/pshrddriver.f b/TESTING/EIG/pshrddriver.f index 7ac68d69..912f3174 100644 --- a/TESTING/EIG/pshrddriver.f +++ b/TESTING/EIG/pshrddriver.f @@ -63,20 +63,16 @@ PROGRAM PSHRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/psnepdriver.f b/TESTING/EIG/psnepdriver.f index 5a6ca892..38c312a6 100644 --- a/TESTING/EIG/psnepdriver.f +++ b/TESTING/EIG/psnepdriver.f @@ -61,22 +61,17 @@ PROGRAM PSNEPDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER REALSZ, TOTMEM, MEMSIZ, NTESTS - REAL PADVAL, ZERO, ONE - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0, - $ ONE = 1.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER REALSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL, ZERO, ONE - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0, $ ONE = 1.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pssepdriver.f b/TESTING/EIG/pssepdriver.f index 6a800ef8..fec3f5b0 100644 --- a/TESTING/EIG/pssepdriver.f +++ b/TESTING/EIG/pssepdriver.f @@ -61,13 +61,14 @@ PROGRAM PSSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, REALSZ, NIN - PARAMETER ( TOTMEM = 2000000, REALSZ = 8, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 21000000 ) #endif + PARAMETER ( REALSZ = 8, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) * .. * .. Local Scalars .. CHARACTER HETERO @@ -100,7 +101,7 @@ PROGRAM PSSEPDRIVER * #ifdef DYNAMIC_WORK_MEM_ALLOC allocate(MEM(MEMSIZ)) - MEM(:) = 0 + MEM(:) = 0 #endif CALL BLACS_PINFO( IAM, NPROCS ) * diff --git a/TESTING/EIG/psseprdriver.f b/TESTING/EIG/psseprdriver.f index c733c226..c2c4f808 100644 --- a/TESTING/EIG/psseprdriver.f +++ b/TESTING/EIG/psseprdriver.f @@ -43,13 +43,14 @@ PROGRAM PSSEPRDRIVER * .. Parameters .. * INTEGER TOTMEM, REALSZ, NIN - PARAMETER ( TOTMEM = 100000000, REALSZ = 4, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) + PARAMETER ( TOTMEM = 100000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 1000000000 ) #endif + PARAMETER ( REALSZ = 4, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / REALSZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pssvddriver.f b/TESTING/EIG/pssvddriver.f index e891cc9b..1f4d32bc 100644 --- a/TESTING/EIG/pssvddriver.f +++ b/TESTING/EIG/pssvddriver.f @@ -47,28 +47,23 @@ PROGRAM PSSVDDRIVER REAL THRESH * .. * .. Parameters .. -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MAXSETSIZE, NIN, DBLSIZ, TOTMEM, MEMSIZ +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif PARAMETER ( MAXSETSIZE = 50, NIN = 11, DBLSIZ = 8, - $ TOTMEM = 2000000, MEMSIZ = TOTMEM / DBLSIZ ) + $ MEMSIZ = TOTMEM / DBLSIZ ) * .. * .. Local Arrays .. INTEGER ISEED( 4 ), MM( MAXSETSIZE ), $ NBS( MAXSETSIZE ), NN( MAXSETSIZE ), $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE ), $ RESULT( 9 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC REAL WORK( MEMSIZ ) #else - INTEGER MAXSETSIZE, NIN, DBLSIZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - PARAMETER ( MAXSETSIZE = 50, NIN = 11, DBLSIZ = 8, - $ TOTMEM = 2000000 ) -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), MM( MAXSETSIZE ), - $ NBS( MAXSETSIZE ), NN( MAXSETSIZE ), - $ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE ), - $ RESULT( 9 ) REAL, allocatable :: WORK (:) #endif * .. diff --git a/TESTING/EIG/pstrddriver.f b/TESTING/EIG/pstrddriver.f index eaa5f8f8..666b0d8e 100644 --- a/TESTING/EIG/pstrddriver.f +++ b/TESTING/EIG/pstrddriver.f @@ -62,20 +62,16 @@ PROGRAM PSTRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER REALSZ, TOTMEM, MEMSIZ, NTESTS - REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER REALSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 10000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pzbrddriver.f b/TESTING/EIG/pzbrddriver.f index e9d16674..c6878d7e 100644 --- a/TESTING/EIG/pzbrddriver.f +++ b/TESTING/EIG/pzbrddriver.f @@ -64,20 +64,16 @@ PROGRAM PZBRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, TOTMEM, ZPLXSZ, DBLESZ - COMPLEX*16 PADVAL - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, DBLESZ = 8, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, TOTMEM, ZPLXSZ, DBLESZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX*16 PADVAL - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, DBLESZ = 8, - $ NTESTS = 20, + PARAMETER ( ZPLXSZ = 16, DBLESZ = 8, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pzevcdriver.f b/TESTING/EIG/pzevcdriver.f index 14ae0c93..093b499f 100644 --- a/TESTING/EIG/pzevcdriver.f +++ b/TESTING/EIG/pzevcdriver.f @@ -68,24 +68,18 @@ PROGRAM PZEVCDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER ZPLXSZ, TOTMEM, MEMSIZ, NTESTS - PARAMETER ( ZPLXSZ = 16, TOTMEM = 200000000, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20 ) - COMPLEX*16 PADVAL, ZERO, ONE - PARAMETER ( PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ), - $ ONE = ( 1.0D+0, 0.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 200000000 ) #else - INTEGER ZPLXSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - PARAMETER ( ZPLXSZ = 16, TOTMEM = 200000000, - $ NTESTS = 20 ) + PARAMETER ( TOTMEM = 2100000000 ) +#endif + PARAMETER ( ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20 ) COMPLEX*16 PADVAL, ZERO, ONE PARAMETER ( PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = ( 0.0D+0, 0.0D+0 ), $ ONE = ( 1.0D+0, 0.0D+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pzgsepdriver.f b/TESTING/EIG/pzgsepdriver.f index c51beadf..22e5e9bf 100644 --- a/TESTING/EIG/pzgsepdriver.f +++ b/TESTING/EIG/pzgsepdriver.f @@ -57,13 +57,14 @@ PROGRAM PZGSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, ZPLXSZ, NIN - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / ZPLXSZ ) + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 21000000 ) #endif + PARAMETER ( ZPLXSZ = 16, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / ZPLXSZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pzhrddriver.f b/TESTING/EIG/pzhrddriver.f index 42de96ea..77c51795 100644 --- a/TESTING/EIG/pzhrddriver.f +++ b/TESTING/EIG/pzhrddriver.f @@ -64,20 +64,16 @@ PROGRAM PZHRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - COMPLEX*16 PADVAL - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX*16 PADVAL - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, - $ NTESTS = 20, + PARAMETER ( ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/EIG/pznepdriver.f b/TESTING/EIG/pznepdriver.f index a5e513d9..e4791dea 100644 --- a/TESTING/EIG/pznepdriver.f +++ b/TESTING/EIG/pznepdriver.f @@ -66,16 +66,14 @@ PROGRAM PZNEPDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER ZPLXSZ, TOTMEM, MEMSIZ, NTESTS - PARAMETER ( ZPLXSZ = 16, TOTMEM = 200000000, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 200000000 ) #else - INTEGER ZPLXSZ, TOTMEM, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - PARAMETER ( ZPLXSZ = 16, TOTMEM = 200000000, - $ NTESTS = 20 ) + PARAMETER ( TOTMEM = 2100000000 ) #endif + PARAMETER ( ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20 ) COMPLEX*16 PADVAL, ZERO, ONE PARAMETER ( PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = ( 0.0D+0, 0.0D+0 ), diff --git a/TESTING/EIG/pzsepdriver.f b/TESTING/EIG/pzsepdriver.f index 71a70d93..78bc3bdf 100644 --- a/TESTING/EIG/pzsepdriver.f +++ b/TESTING/EIG/pzsepdriver.f @@ -57,13 +57,14 @@ PROGRAM PZSEPDRIVER * .. Parameters .. * INTEGER TOTMEM, ZPLXSZ, NIN - PARAMETER ( TOTMEM = 2000000, ZPLXSZ = 16, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / ZPLXSZ ) + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 21000000 ) #endif + PARAMETER ( ZPLXSZ = 16, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / ZPLXSZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pzseprdriver.f b/TESTING/EIG/pzseprdriver.f index dbdc7f61..2e68285e 100644 --- a/TESTING/EIG/pzseprdriver.f +++ b/TESTING/EIG/pzseprdriver.f @@ -43,13 +43,14 @@ PROGRAM PZSEPRDRIVER * .. Parameters .. * INTEGER TOTMEM, DBLESZ, NIN - PARAMETER ( TOTMEM = 100000000, DBLESZ = 16, NIN = 11 ) #ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER MEMSIZ - PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) + PARAMETER ( TOTMEM = 100000000 ) #else - INTEGER, PARAMETER :: MEMSIZ = 21000000 + PARAMETER ( TOTMEM = 1000000000 ) #endif + PARAMETER ( DBLESZ = 16, NIN = 11 ) + INTEGER MEMSIZ + PARAMETER ( MEMSIZ = TOTMEM / DBLESZ ) * .. * .. Local Scalars .. CHARACTER HETERO diff --git a/TESTING/EIG/pztrddriver.f b/TESTING/EIG/pztrddriver.f index a29a7b3b..c36297cc 100644 --- a/TESTING/EIG/pztrddriver.f +++ b/TESTING/EIG/pztrddriver.f @@ -63,20 +63,16 @@ PROGRAM PZTRDDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, TOTMEM, ZPLXSZ, MEMSIZ, NTESTS - COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, ZPLXSZ = 16, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, TOTMEM, ZPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 210000000 + PARAMETER ( TOTMEM = 210000000 ) +#endif COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 80000000, ZPLXSZ = 16, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK diff --git a/TESTING/LIN/pcdbdriver.f b/TESTING/LIN/pcdbdriver.f index 02e497d7..fde3186f 100644 --- a/TESTING/LIN/pcdbdriver.f +++ b/TESTING/LIN/pcdbdriver.f @@ -71,10 +71,12 @@ PROGRAM PCDBDRIVER * ===================================================================== * * .. Parameters .. -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) -#endif +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -82,26 +84,13 @@ PROGRAM PCDBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS -#else - INTEGER CPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 -#endif - COMPLEX PADVAL -#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( CPLXSZ = 8, $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#else - PARAMETER ( CPLXSZ = 8, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pcdtdriver.f b/TESTING/LIN/pcdtdriver.f index 9ccad498..8bdb88eb 100644 --- a/TESTING/LIN/pcdtdriver.f +++ b/TESTING/LIN/pcdtdriver.f @@ -72,14 +72,17 @@ PROGRAM PCDTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * -#ifndef DYNAMIC_WORK_MEM_ALLOC REAL ZERO INTEGER CPLXSZ, MEMSIZ, NTESTS COMPLEX PADVAL @@ -87,16 +90,6 @@ PROGRAM PCDTDRIVER $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#else - REAL ZERO - INTEGER CPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. @@ -124,7 +117,7 @@ PROGRAM PCDTDRIVER $ NRVAL( NTESTS ), NVAL( NTESTS ), $ PVAL( NTESTS ), QVAL( NTESTS ) DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC +#ifndef DYNAMIC_WORK_MEM_ALLOC COMPLEX MEM( MEMSIZ ) #else COMPLEX, allocatable :: MEM (:) diff --git a/TESTING/LIN/pcgbdriver.f b/TESTING/LIN/pcgbdriver.f index d1096e61..74845fb5 100644 --- a/TESTING/LIN/pcgbdriver.f +++ b/TESTING/LIN/pcgbdriver.f @@ -77,8 +77,12 @@ PROGRAM PCGBDRIVER * ===================================================================== * * .. Parameters .. - INTEGER TOTMEM - PARAMETER ( TOTMEM = 3000000 ) + INTEGER TOTMEM, INTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 3000000, INTMEM = 2048 ) +#else + PARAMETER ( TOTMEM = 2100000000, INTMEM = 80000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -86,26 +90,13 @@ PROGRAM PCGBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER INTMEM - PARAMETER ( INTMEM = 2048 ) INTEGER CPLXSZ, MEMSIZ, NTESTS COMPLEX PADVAL PARAMETER ( CPLXSZ = 8, $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#else - INTEGER INTMEM - PARAMETER ( INTMEM = 80000 ) - INTEGER CPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif + $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), + $ ZERO = 0.0E+0 ) + INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pcinvdriver.f b/TESTING/LIN/pcinvdriver.f index ed465ca8..12b99f32 100644 --- a/TESTING/LIN/pcinvdriver.f +++ b/TESTING/LIN/pcinvdriver.f @@ -66,8 +66,13 @@ PROGRAM PCINVDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC + INTEGER CPLXSZ, INTGSZ, MEMSIZ, NTESTS, REALSZ, TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX PADVAL, ZERO #ifdef ENABLE_ILP64 PARAMETER ( INTGSZ = 8 ) @@ -75,24 +80,10 @@ PROGRAM PCINVDRIVER PARAMETER ( INTGSZ = 4 ) #endif PARAMETER ( CPLXSZ = 8, REALSZ = 4, - $ TOTMEM = 2000000, MEMSIZ = TOTMEM / CPLXSZ, + $ MEMSIZ = TOTMEM / CPLXSZ, $ NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = ( 0.0E+0, 0.0E+0 ) ) -#else - INTEGER CPLXSZ, INTGSZ, NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX PADVAL, ZERO -#ifdef ENABLE_ILP64 - PARAMETER ( CPLXSZ = 8, INTGSZ = 8, REALSZ = 4, -#else - PARAMETER ( CPLXSZ = 8, INTGSZ = 4, REALSZ = 4, -#endif - $ TOTMEM = 2000000, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = ( 0.0E+0, 0.0E+0 ) ) -#endif * .. * .. Local Scalars .. CHARACTER UPLO diff --git a/TESTING/LIN/pclltdriver.f b/TESTING/LIN/pclltdriver.f index d046bc2c..3774949b 100644 --- a/TESTING/LIN/pclltdriver.f +++ b/TESTING/LIN/pclltdriver.f @@ -71,25 +71,18 @@ PROGRAM PCLLTDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL ZERO - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER CPLXSZ, NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL ZERO COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( CPLXSZ = 8, REALSZ = 4, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pclsdriver.f b/TESTING/LIN/pclsdriver.f index e6ed6c98..9723b5db 100644 --- a/TESTING/LIN/pclsdriver.f +++ b/TESTING/LIN/pclsdriver.f @@ -66,27 +66,19 @@ PROGRAM PCLSDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL RZERO, RONE - COMPLEX ONE, PADVAL, ZERO - PARAMETER ( CPLXSZ = 8, REALSZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), RZERO = 0.0E+0, - $ RONE = 1.0E+0, ZERO = ( 0.0E+0, 0.0E+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER CPLXSZ, NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL RZERO, RONE COMPLEX ONE, PADVAL, ZERO - PARAMETER ( CPLXSZ = 8, REALSZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( CPLXSZ = 8, REALSZ = 8, + $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), RZERO = 0.0E+0, $ RONE = 1.0E+0, ZERO = ( 0.0E+0, 0.0E+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, TPSD diff --git a/TESTING/LIN/pcludriver.f b/TESTING/LIN/pcludriver.f index b75e55c3..7924d40e 100644 --- a/TESTING/LIN/pcludriver.f +++ b/TESTING/LIN/pcludriver.f @@ -72,8 +72,12 @@ PROGRAM PCLUDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, INTGSZ, MEMSIZ, NTESTS, REALSZ, TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 4000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL ZERO COMPLEX PADVAL #ifdef ENABLE_ILP64 @@ -82,26 +86,9 @@ PROGRAM PCLUDRIVER PARAMETER ( INTGSZ = 4 ) #endif PARAMETER ( CPLXSZ = 8, REALSZ = 4, - $ TOTMEM = 4000000, $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#else - INTEGER CPLXSZ, INTGSZ, NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - - REAL ZERO - COMPLEX PADVAL -#ifdef ENABLE_ILP64 - PARAMETER ( CPLXSZ = 8, INTGSZ = 8, REALSZ = 4, -#else - PARAMETER ( CPLXSZ = 8, INTGSZ = 4, REALSZ = 4, -#endif - $ TOTMEM = 4000000, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pcpbdriver.f b/TESTING/LIN/pcpbdriver.f index e0109193..e3d4c187 100644 --- a/TESTING/LIN/pcpbdriver.f +++ b/TESTING/LIN/pcpbdriver.f @@ -72,7 +72,11 @@ PROGRAM PCPBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,23 +84,12 @@ PROGRAM PCPBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS COMPLEX PADVAL PARAMETER ( CPLXSZ = 8, $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#else - INTEGER CPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pcptdriver.f b/TESTING/LIN/pcptdriver.f index c3e869a9..a431f383 100644 --- a/TESTING/LIN/pcptdriver.f +++ b/TESTING/LIN/pcptdriver.f @@ -72,7 +72,11 @@ PROGRAM PCPTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,7 +84,6 @@ PROGRAM PCPTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, MEMSIZ, NTESTS COMPLEX PADVAL @@ -88,16 +91,6 @@ PROGRAM PCPTDRIVER $ MEMSIZ = TOTMEM / CPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), $ ZERO = 0.0E+0 ) -#else - INTEGER CPLXSZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - - COMPLEX PADVAL - PARAMETER ( CPLXSZ = 8, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ), - $ ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pcqrdriver.f b/TESTING/LIN/pcqrdriver.f index f52b94b2..5a1c69a8 100644 --- a/TESTING/LIN/pcqrdriver.f +++ b/TESTING/LIN/pcqrdriver.f @@ -70,8 +70,12 @@ PROGRAM PCQRDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER CPLXSZ, INTGSZ, MEMSIZ, NTESTS, REALSZ, TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX PADVAL #ifdef ENABLE_ILP64 PARAMETER ( INTGSZ = 8 ) @@ -79,23 +83,9 @@ PROGRAM PCQRDRIVER PARAMETER ( INTGSZ = 4 ) #endif PARAMETER ( CPLXSZ = 8, REALSZ = 4, - $ TOTMEM = 2000000, MEMSIZ = TOTMEM / CPLXSZ, - $ NTESTS = 20, - $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) -#else - INTEGER CPLXSZ, INTGSZ, NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - - COMPLEX PADVAL -#ifdef ENABLE_ILP64 - PARAMETER ( CPLXSZ = 8, INTGSZ = 8, REALSZ = 4, -#else - PARAMETER ( CPLXSZ = 8, INTGSZ = 4, REALSZ = 4, -#endif - $ TOTMEM = 2000000, + $ MEMSIZ = TOTMEM / CPLXSZ, $ NTESTS = 20, $ PADVAL = ( -9923.0E+0, -9923.0E+0 ) ) -#endif * .. * .. Local Scalars .. CHARACTER*2 FACT diff --git a/TESTING/LIN/pddbdriver.f b/TESTING/LIN/pddbdriver.f index 8694a324..58ee82de 100644 --- a/TESTING/LIN/pddbdriver.f +++ b/TESTING/LIN/pddbdriver.f @@ -71,7 +71,11 @@ PROGRAM PDDBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PDDBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS DOUBLE PRECISION PADVAL PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pddtdriver.f b/TESTING/LIN/pddtdriver.f index 5ad75ddf..c3933104 100644 --- a/TESTING/LIN/pddtdriver.f +++ b/TESTING/LIN/pddtdriver.f @@ -71,7 +71,11 @@ PROGRAM PDDTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PDDTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS DOUBLE PRECISION PADVAL PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pdgbdriver.f b/TESTING/LIN/pdgbdriver.f index 1140fc13..4106280c 100644 --- a/TESTING/LIN/pdgbdriver.f +++ b/TESTING/LIN/pdgbdriver.f @@ -76,8 +76,12 @@ PROGRAM PDGBDRIVER * ===================================================================== * * .. Parameters .. - INTEGER TOTMEM - PARAMETER ( TOTMEM = 3000000 ) + INTEGER TOTMEM, INTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 3000000, INTMEM = 2048 ) +#else + PARAMETER ( TOTMEM = 2100000000, INTMEM = 20480 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -85,24 +89,11 @@ PROGRAM PDGBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER INTMEM - PARAMETER ( INTMEM = 2048 ) INTEGER DBLESZ, MEMSIZ, NTESTS DOUBLE PRECISION PADVAL PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER INTMEM - PARAMETER ( INTMEM = 20480 ) - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. @@ -135,7 +126,7 @@ PROGRAM PDGBDRIVER DOUBLE PRECISION CTIME( 2 ), MEM( MEMSIZ ), WTIME( 2 ) #else DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdinvdriver.f b/TESTING/LIN/pdinvdriver.f index 4503ce07..e664e76b 100644 --- a/TESTING/LIN/pdinvdriver.f +++ b/TESTING/LIN/pdinvdriver.f @@ -65,25 +65,22 @@ PROGRAM PDINVDRIVER $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) INTEGER DBLESZ, INTGSZ, NTESTS, TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) +#else + PARAMETER ( TOTMEM = WORK_BUFFER_SIZE ) +#endif #ifdef ENABLE_ILP64 PARAMETER ( INTGSZ = 8 ) #else PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ DOUBLE PRECISION PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, + PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER, PARAMETER :: MEMSIZ = WORK_BUFFER_SIZE - DOUBLE PRECISION PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. CHARACTER UPLO @@ -105,11 +102,11 @@ PROGRAM PDINVDRIVER INTEGER DESCA( DLEN_ ), IERR( 1 ), NBVAL( NTESTS ), $ NVAL( NTESTS ), PVAL( NTESTS ), $ QVAL( NTESTS ) -#ifndef DYNAMIC_WORK_MEM_ALLOC +#ifndef DYNAMIC_WORK_MEM_ALLOC DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 2 ), WTIME( 2 ) #else DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdlltdriver.f b/TESTING/LIN/pdlltdriver.f index badb95f0..c496d77e 100644 --- a/TESTING/LIN/pdlltdriver.f +++ b/TESTING/LIN/pdlltdriver.f @@ -78,20 +78,16 @@ PROGRAM PDLLTDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST @@ -114,11 +110,11 @@ PROGRAM PDLLTDRIVER $ NBRVAL( NTESTS ), NBVAL( NTESTS ), $ NRVAL( NTESTS ), NVAL( NTESTS ), $ PVAL( NTESTS ), QVAL( NTESTS ) -#ifndef DYNAMIC_WORK_MEM_ALLOC +#ifndef DYNAMIC_WORK_MEM_ALLOC DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 2 ), WTIME( 2 ) #else DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdlsdriver.f b/TESTING/LIN/pdlsdriver.f index 93558dbd..d17d5959 100644 --- a/TESTING/LIN/pdlsdriver.f +++ b/TESTING/LIN/pdlsdriver.f @@ -65,24 +65,18 @@ PROGRAM PDLSDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL - DOUBLE PRECISION ONE, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0 ) - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL DOUBLE PRECISION ONE, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0 ) PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, TPSD @@ -113,7 +107,7 @@ PROGRAM PDLSDRIVER #else DOUBLE PRECISION CTIME( 1 ), RESULT( 2 ), $ WTIME( 1 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdludriver.f b/TESTING/LIN/pdludriver.f index 52dc6e4d..2ac9bcbb 100644 --- a/TESTING/LIN/pdludriver.f +++ b/TESTING/LIN/pdludriver.f @@ -79,20 +79,16 @@ PROGRAM PDLUDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 4000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 4000000 ) #else - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = WORK_BUFFER_SIZE + PARAMETER ( TOTMEM = WORK_BUFFER_SIZE ) +#endif DOUBLE PRECISION PADVAL, ZERO PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pdpbdriver.f b/TESTING/LIN/pdpbdriver.f index 3c402888..9a0ab4f8 100644 --- a/TESTING/LIN/pdpbdriver.f +++ b/TESTING/LIN/pdpbdriver.f @@ -71,7 +71,11 @@ PROGRAM PDPBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PDPBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS DOUBLE PRECISION PADVAL PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. @@ -120,11 +115,11 @@ PROGRAM PDPBDRIVER $ NBRVAL( NTESTS ), NBVAL( NTESTS ), $ NRVAL( NTESTS ), NVAL( NTESTS ), $ PVAL( NTESTS ), QVAL( NTESTS ) -#ifndef DYNAMIC_WORK_MEM_ALLOC +#ifndef DYNAMIC_WORK_MEM_ALLOC DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 2 ), WTIME( 2 ) #else DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdptdriver.f b/TESTING/LIN/pdptdriver.f index 13115e78..5beb6475 100644 --- a/TESTING/LIN/pdptdriver.f +++ b/TESTING/LIN/pdptdriver.f @@ -71,7 +71,11 @@ PROGRAM PDPTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PDPTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS DOUBLE PRECISION PADVAL PARAMETER ( DBLESZ = 8, $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#else - INTEGER DBLESZ, NTESTS - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, - $ NTESTS = 20, - $ PADVAL = -9923.0D+0, ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. @@ -124,7 +119,7 @@ PROGRAM PDPTDRIVER DOUBLE PRECISION MEM( MEMSIZ ), CTIME( 2 ), WTIME( 2 ) #else DOUBLE PRECISION CTIME( 2 ), WTIME( 2 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/pdqrdriver.f b/TESTING/LIN/pdqrdriver.f index b1abad16..92cb83da 100644 --- a/TESTING/LIN/pdqrdriver.f +++ b/TESTING/LIN/pdqrdriver.f @@ -76,20 +76,16 @@ PROGRAM PDQRDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM - DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, - $ PADVAL = -9923.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, + $ MEMSIZ = TOTMEM / DBLESZ, NTESTS = 20, $ PADVAL = -9923.0D+0 ) -#endif * .. * .. Local Scalars .. CHARACTER*2 FACT @@ -117,7 +113,7 @@ PROGRAM PDQRDRIVER DOUBLE PRECISION CTIME( 1 ), MEM( MEMSIZ ), WTIME( 1 ) #else DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) - DOUBLE PRECISION, allocatable :: MEM (:) + DOUBLE PRECISION, allocatable :: MEM (:) #endif * .. * .. External Subroutines .. diff --git a/TESTING/LIN/psdbdriver.f b/TESTING/LIN/psdbdriver.f index 94884172..13a303bf 100644 --- a/TESTING/LIN/psdbdriver.f +++ b/TESTING/LIN/psdbdriver.f @@ -71,7 +71,11 @@ PROGRAM PSDBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 21000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PSDBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ REAL PADVAL PARAMETER ( REALSZ = 4, $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#else - INTEGER NTESTS, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 21000000 - REAL PADVAL - PARAMETER ( REALSZ = 4, - $ NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. @@ -119,7 +114,7 @@ PROGRAM PSDBDRIVER $ IERR( 1 ), NBRVAL( NTESTS ), NBVAL( NTESTS ), $ NRVAL( NTESTS ), NVAL( NTESTS ), $ PVAL( NTESTS ), QVAL( NTESTS ) -#ifndef DYNAMIC_WORK_MEM_ALLOC +#ifndef DYNAMIC_WORK_MEM_ALLOC REAL MEM( MEMSIZ ) #else REAL, allocatable :: MEM (:) diff --git a/TESTING/LIN/psdtdriver.f b/TESTING/LIN/psdtdriver.f index 0c93f21a..c7a01f5f 100644 --- a/TESTING/LIN/psdtdriver.f +++ b/TESTING/LIN/psdtdriver.f @@ -71,7 +71,11 @@ PROGRAM PSDTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PSDTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ REAL PADVAL PARAMETER ( REALSZ = 4, $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#else - INTEGER NTESTS, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - REAL PADVAL - PARAMETER ( REALSZ = 4, - $ NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/psgbdriver.f b/TESTING/LIN/psgbdriver.f index e8107d87..24e641e2 100644 --- a/TESTING/LIN/psgbdriver.f +++ b/TESTING/LIN/psgbdriver.f @@ -76,8 +76,12 @@ PROGRAM PSGBDRIVER * ===================================================================== * * .. Parameters .. - INTEGER TOTMEM - PARAMETER ( TOTMEM = 3000000 ) + INTEGER TOTMEM, INTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 3000000, INTMEM = 2048 ) +#else + PARAMETER ( TOTMEM = 21000000, INTMEM = 20480 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -85,24 +89,11 @@ PROGRAM PSGBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER INTMEM - PARAMETER ( INTMEM = 2048 ) INTEGER MEMSIZ, NTESTS, REALSZ REAL PADVAL PARAMETER ( REALSZ = 4, $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#else - INTEGER INTMEM - PARAMETER ( INTMEM = 20480 ) - INTEGER NTESTS, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 21000000 - REAL PADVAL - PARAMETER ( REALSZ = 4, - $ NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/psinvdriver.f b/TESTING/LIN/psinvdriver.f index edc23699..dde803c2 100644 --- a/TESTING/LIN/psinvdriver.f +++ b/TESTING/LIN/psinvdriver.f @@ -72,20 +72,16 @@ PROGRAM PSINVDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif * .. * .. Local Scalars .. CHARACTER UPLO diff --git a/TESTING/LIN/pslltdriver.f b/TESTING/LIN/pslltdriver.f index 7d9e6e59..b28314a2 100644 --- a/TESTING/LIN/pslltdriver.f +++ b/TESTING/LIN/pslltdriver.f @@ -78,20 +78,16 @@ PROGRAM PSLLTDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pslsdriver.f b/TESTING/LIN/pslsdriver.f index f1be138b..81ed67f4 100644 --- a/TESTING/LIN/pslsdriver.f +++ b/TESTING/LIN/pslsdriver.f @@ -65,24 +65,18 @@ PROGRAM PSLSDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL - REAL ONE, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0 ) - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL REAL ONE, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0 ) PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, TPSD @@ -112,7 +106,7 @@ PROGRAM PSLSDRIVER #else REAL, allocatable :: MEM (:) #endif - + DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) * .. * .. External Subroutines .. diff --git a/TESTING/LIN/psludriver.f b/TESTING/LIN/psludriver.f index 545336d3..1ce446f6 100644 --- a/TESTING/LIN/psludriver.f +++ b/TESTING/LIN/psludriver.f @@ -79,20 +79,16 @@ PROGRAM PSLUDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM + PARAMETER ( TOTMEM = 2100000000 ) +#endif REAL PADVAL, ZERO - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) - INTEGER, PARAMETER :: MEMSIZ = 2100000000 -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pspbdriver.f b/TESTING/LIN/pspbdriver.f index 2aa0c8b4..61dddafb 100644 --- a/TESTING/LIN/pspbdriver.f +++ b/TESTING/LIN/pspbdriver.f @@ -71,7 +71,11 @@ PROGRAM PSPBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PSPBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ REAL PADVAL PARAMETER ( REALSZ = 4, $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#else - INTEGER NTESTS, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - REAL PADVAL - PARAMETER ( REALSZ = 4, - $ NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/psptdriver.f b/TESTING/LIN/psptdriver.f index 6a50e927..24f9f396 100644 --- a/TESTING/LIN/psptdriver.f +++ b/TESTING/LIN/psptdriver.f @@ -71,7 +71,11 @@ PROGRAM PSPTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -79,20 +83,11 @@ PROGRAM PSPTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * REAL ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ REAL PADVAL PARAMETER ( REALSZ = 4, $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#else - INTEGER NTESTS, REALSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - REAL PADVAL - PARAMETER ( REALSZ = 4, - $ NTESTS = 20, - $ PADVAL = -9923.0E+0, ZERO = 0.0E+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/psqrdriver.f b/TESTING/LIN/psqrdriver.f index 013ff80d..050d4b46 100644 --- a/TESTING/LIN/psqrdriver.f +++ b/TESTING/LIN/psqrdriver.f @@ -76,20 +76,16 @@ PROGRAM PSQRDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, REALSZ, TOTMEM - REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, - $ PADVAL = -9923.0E+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER NTESTS, REALSZ, TOTMEM - INTEGER, PARAMETER :: MEMSIZ = 2100000 + PARAMETER ( TOTMEM = 21000000 ) +#endif REAL PADVAL - PARAMETER ( REALSZ = 4, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( REALSZ = 4, + $ MEMSIZ = TOTMEM / REALSZ, NTESTS = 20, $ PADVAL = -9923.0E+0 ) -#endif * .. * .. Local Scalars .. CHARACTER*2 FACT diff --git a/TESTING/LIN/pzdbdriver.f b/TESTING/LIN/pzdbdriver.f index 14378462..ff06a9c3 100644 --- a/TESTING/LIN/pzdbdriver.f +++ b/TESTING/LIN/pzdbdriver.f @@ -72,7 +72,11 @@ PROGRAM PZDBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,22 +84,12 @@ PROGRAM PZDBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, ZPLXSZ COMPLEX*16 PADVAL PARAMETER ( ZPLXSZ = 16, $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#else - INTEGER NTESTS, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX*16 PADVAL - PARAMETER ( ZPLXSZ = 16, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pzdtdriver.f b/TESTING/LIN/pzdtdriver.f index 2858acab..a407e375 100644 --- a/TESTING/LIN/pzdtdriver.f +++ b/TESTING/LIN/pzdtdriver.f @@ -72,7 +72,11 @@ PROGRAM PZDTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,22 +84,12 @@ PROGRAM PZDTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, ZPLXSZ COMPLEX*16 PADVAL PARAMETER ( ZPLXSZ = 16, $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#else - INTEGER NTESTS, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX*16 PADVAL - PARAMETER ( ZPLXSZ = 16, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pzgbdriver.f b/TESTING/LIN/pzgbdriver.f index 7341f6eb..490ed6f6 100644 --- a/TESTING/LIN/pzgbdriver.f +++ b/TESTING/LIN/pzgbdriver.f @@ -77,8 +77,12 @@ PROGRAM PZGBDRIVER * ===================================================================== * * .. Parameters .. - INTEGER TOTMEM - PARAMETER ( TOTMEM = 3000000 ) + INTEGER TOTMEM, INTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 3000000, INTMEM = 2048 ) +#else + PARAMETER ( TOTMEM = 2100000000, INTMEM = 80000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -86,26 +90,12 @@ PROGRAM PZGBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC - INTEGER INTMEM - PARAMETER ( INTMEM = 2048 ) INTEGER MEMSIZ, NTESTS, ZPLXSZ COMPLEX*16 PADVAL PARAMETER ( ZPLXSZ = 16, $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#else - INTEGER INTMEM - PARAMETER ( INTMEM = 80000 ) - INTEGER NTESTS, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX*16 PADVAL - PARAMETER ( ZPLXSZ = 16, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pzinvdriver.f b/TESTING/LIN/pzinvdriver.f index 0819d8fb..c55cc2e6 100644 --- a/TESTING/LIN/pzinvdriver.f +++ b/TESTING/LIN/pzinvdriver.f @@ -74,24 +74,18 @@ PROGRAM PZINVDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - COMPLEX*16 PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX*16 PADVAL, ZERO - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ ZPLXSZ = 16, + PARAMETER ( DBLESZ = 8, + $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, $ NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -#endif * .. * .. Local Scalars .. CHARACTER UPLO diff --git a/TESTING/LIN/pzlltdriver.f b/TESTING/LIN/pzlltdriver.f index 7b2f0b1f..db162cf1 100644 --- a/TESTING/LIN/pzlltdriver.f +++ b/TESTING/LIN/pzlltdriver.f @@ -71,24 +71,18 @@ PROGRAM PZLLTDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - DOUBLE PRECISION ZERO - COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, ZPLXSZ = 16, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION ZERO COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, ZPLXSZ = 16, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pzlsdriver.f b/TESTING/LIN/pzlsdriver.f index e279e0a3..09d12eb6 100644 --- a/TESTING/LIN/pzlsdriver.f +++ b/TESTING/LIN/pzlsdriver.f @@ -66,26 +66,19 @@ PROGRAM PZLSDRIVER PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - DOUBLE PRECISION RZERO, RONE - COMPLEX*16 ONE, PADVAL, ZERO - PARAMETER ( DBLESZ = 8, ZPLXSZ = 16, TOTMEM = 2000000, - $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), RZERO = 0.0D+0, - $ RONE = 1.0D+0, ZERO = ( 0.0D+0, 0.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION RZERO, RONE COMPLEX*16 ONE, PADVAL, ZERO - PARAMETER ( DBLESZ = 8, ZPLXSZ = 16, TOTMEM = 2000000, - $ NTESTS = 20, + PARAMETER ( DBLESZ = 8, ZPLXSZ = 16, + $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), RZERO = 0.0D+0, $ RONE = 1.0D+0, ZERO = ( 0.0D+0, 0.0D+0 ) ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, TPSD diff --git a/TESTING/LIN/pzludriver.f b/TESTING/LIN/pzludriver.f index 03635403..14a39ce2 100644 --- a/TESTING/LIN/pzludriver.f +++ b/TESTING/LIN/pzludriver.f @@ -80,26 +80,19 @@ PROGRAM PZLUDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - DOUBLE PRECISION ZERO - COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 8000000, - $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 8000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif DOUBLE PRECISION ZERO COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 8000000, - $ ZPLXSZ = 16, + PARAMETER ( DBLESZ = 8, + $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, $ NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#endif * .. * .. Local Scalars .. LOGICAL CHECK, EST diff --git a/TESTING/LIN/pzpbdriver.f b/TESTING/LIN/pzpbdriver.f index aeecbdb6..02454013 100644 --- a/TESTING/LIN/pzpbdriver.f +++ b/TESTING/LIN/pzpbdriver.f @@ -72,7 +72,11 @@ PROGRAM PZPBDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,22 +84,12 @@ PROGRAM PZPBDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, ZPLXSZ COMPLEX*16 PADVAL PARAMETER ( ZPLXSZ = 16, $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#else - INTEGER NTESTS, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX*16 PADVAL - PARAMETER ( ZPLXSZ = 16, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pzptdriver.f b/TESTING/LIN/pzptdriver.f index a7c7ae58..3a0873f0 100644 --- a/TESTING/LIN/pzptdriver.f +++ b/TESTING/LIN/pzptdriver.f @@ -72,7 +72,11 @@ PROGRAM PZPTDRIVER * * .. Parameters .. INTEGER TOTMEM +#ifndef DYNAMIC_WORK_MEM_ALLOC PARAMETER ( TOTMEM = 3000000 ) +#else + PARAMETER ( TOTMEM = 2100000000 ) +#endif INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, $ LLD_, MB_, M_, NB_, N_, RSRC_ PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, @@ -80,22 +84,12 @@ PROGRAM PZPTDRIVER $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) * DOUBLE PRECISION ZERO -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER MEMSIZ, NTESTS, ZPLXSZ COMPLEX*16 PADVAL PARAMETER ( ZPLXSZ = 16, $ MEMSIZ = TOTMEM / ZPLXSZ, NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), $ ZERO = 0.0D+0 ) -#else - INTEGER NTESTS, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 - COMPLEX*16 PADVAL - PARAMETER ( ZPLXSZ = 16, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ), - $ ZERO = 0.0D+0 ) -#endif INTEGER INT_ONE PARAMETER ( INT_ONE = 1 ) * .. diff --git a/TESTING/LIN/pzqrdriver.f b/TESTING/LIN/pzqrdriver.f index 01955542..48a151cd 100644 --- a/TESTING/LIN/pzqrdriver.f +++ b/TESTING/LIN/pzqrdriver.f @@ -78,22 +78,17 @@ PROGRAM PZQRDRIVER PARAMETER ( INTGSZ = 4 ) #endif * -#ifndef DYNAMIC_WORK_MEM_ALLOC INTEGER DBLESZ, MEMSIZ, NTESTS, TOTMEM, ZPLXSZ - COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, - $ NTESTS = 20, - $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) +#ifndef DYNAMIC_WORK_MEM_ALLOC + PARAMETER ( TOTMEM = 2000000 ) #else - INTEGER DBLESZ, NTESTS, TOTMEM, ZPLXSZ - INTEGER, PARAMETER :: MEMSIZ = 2100000000 + PARAMETER ( TOTMEM = 2100000000 ) +#endif COMPLEX*16 PADVAL - PARAMETER ( DBLESZ = 8, TOTMEM = 2000000, - $ ZPLXSZ = 16, + PARAMETER ( DBLESZ = 8, + $ ZPLXSZ = 16, MEMSIZ = TOTMEM / ZPLXSZ, $ NTESTS = 20, $ PADVAL = ( -9923.0D+0, -9923.0D+0 ) ) -#endif * .. * .. Local Scalars .. CHARACTER*2 FACT From fe8d77d2b834df29bf346d5f11c104b958fce88b Mon Sep 17 00:00:00 2001 From: prangana Date: Wed, 17 May 2023 07:23:14 -0400 Subject: [PATCH 06/29] Update AMD's version of README with content specific to AMD work Change-Id: I4153e5c520ec5a0ffed495908a97d37fd7381f9a --- README_ScaLAPACK_AMD | 60 ++++++++++++-------------------------------- 1 file changed, 16 insertions(+), 44 deletions(-) diff --git a/README_ScaLAPACK_AMD b/README_ScaLAPACK_AMD index 2c97560b..a2319339 100644 --- a/README_ScaLAPACK_AMD +++ b/README_ScaLAPACK_AMD @@ -1,50 +1,22 @@ -AOCL-ScaLAPACK -=============================================================================== -ScaLAPACK, or Scalable LAPACK, is a library of high performance linear algebra -routines for distributed memory computers supporting MPI. +# AOCL-ScaLAPACK -AOCL-ScaLAPACK is the optimized version of ScaLAPACK for AMD EPYC family of -processors. +AOCL-ScaLAPACK is a library of high-performance linear algebra routines for +parallel distributed memory machines. It can be used to solve linear systems, +least squares problems, eigenvalue problems, and singular value problems. -=============================================================================== +AOCL-ScaLAPACK is forked from upstream Netlib ScaLAPACK GitHub +[repository](https://github.com/Reference-ScaLAPACK/scalapack). This fork has +ScaLAPACK optimized for AMD “Zen” core based processors. It depends on external +libraries BLAS and LAPACK. For AMD CPUs, use of AOCL-BLIS and AOCL-libFLAME is +recommended. -1. Install MPI library and set the PATH and LD_LIBRARY_PATH environment - variables to point to installed binaries. - eg. export PATH=/bin:$PATH - eg. export LD_LIBRARY_PATH=/lib:$LD_LIBRARY_PATH +For detailed instructions on how to configure, build, install, and link against +AOCL-ScaLAPACK on AMD CPUs, please refer to the AOCL User Guide located on AMD +developer [portal](https://www.amd.com/en/developer/aocl.html). -2. Download AMD optimized versions of BLIS and libFLAME from following link - https://developer.amd.com/amd-aocl/ +For any issues/suggestion in the "amd" fork of ScaLAPACK, please email +toolchainsupport@amd.com. -3. Install latest CMAKE tool. - -4. Install AOCL-BLIS and AOCL-libFLAME libraries either using pre-built binaries or build - from source. - To build AOCL-BLIS and AOCL-libFLAME from source, clone from following github links - BLIS: https://github.com/amd/blis - libFLAME: https://github.com/amd/libflame - -5. Steps to build the AOCL-ScaLAPACK library and the test suite: - - a. Create a new directory. For example, build: - $ mkdir build - $ cd build - - b. Set PATH and LD_LIBRARY_PATH appropriately to the MPI installation. - - c. To Build the AOCL-ScaLAPACK library and the test suite, Run the below commands: - $ cmake .. -DBUILD_SHARED_LIBS=OFF -DBLAS_LIBRARIES="-fopenmp /libblis-mt.a" - -DLAPACK_LIBRARIES="-lstdc++ /libflame.a" - -DCMAKE_C_COMPILER=mpicc -DCMAKE_Fortran_COMPILER=mpif90 - -DUSE_OPTIMIZED_LAPACK_BLAS=OFF [-D DENABLE_ILP64=ON] - $ make -j - - This command generates the AOCL-ScaLAPACK library in the 'build/lib' folder - and test applications in the 'build/TESTING' folder. - -4. To execute the AOCL-ScaLAPACK test suite, run scalapack_test.sh from - 'build/' directory: - - $ ./scalapack_test.sh - Refer TESTING/README.txt to know more about scalapack_test.sh +Also, please read the LICENSE file for information on copying and distributing +this software. From d01906252ac9e627f9228f1e256c8614f12a09fa Mon Sep 17 00:00:00 2001 From: arunchan Date: Fri, 19 May 2023 17:06:43 +0530 Subject: [PATCH 07/29] Remove duplicate addition of "-cpp" and change -fp_port to -fp-port Signed-off-by: arunchan Change-Id: I2e1921de705c63904f6f3536fcd0353db6dc7f51 --- CMakeLists.txt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index eef4e862..410bb828 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -75,15 +75,15 @@ endif(ENABLE_LARGE_MATRIX_TESTING) if (UNIX) if ("${CMAKE_C_COMPILER_ID}" STREQUAL "GNU") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -ffixed-line-length-none -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffixed-line-length-none -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) endif () if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "Flang") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -ffixed-line-length-132 -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffixed-line-length-132 -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) endif () if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "Intel") - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fltconsistency -fp_port -no-vec -cpp -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fltconsistency -fp-port -no-vec -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) elseif ("${CMAKE_Fortran_COMPILER}" MATCHES "ifort" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fltconsistency -fp_port -no-vec -cpp -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fltconsistency -fp-port -no-vec -I ${SL_FRAMEWORK_INCLUDE_PATH}/" ) endif () if (("${CMAKE_C_COMPILER_ID}" STREQUAL "Intel") AND ( "${CMAKE_C_COMPILER}" MATCHES "icc" ) ) @@ -97,7 +97,7 @@ if (UNIX) message(STATUS "Found Intel icx compiler : ${CMAKE_ICC_FLAGS} ") endif () else () - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -I ${SL_FRAMEWORK_INCLUDE_PATH}/ " ) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -I ${SL_FRAMEWORK_INCLUDE_PATH}/ " ) endif () From 37741193dc529722f518c0042289da6359b95dd1 Mon Sep 17 00:00:00 2001 From: arunchan Date: Wed, 7 Jun 2023 20:31:35 +0530 Subject: [PATCH 08/29] Fix build warning of type Wincompatible-pointer-types Signed-off-by: arunchan AMD-Internal: [CPUPL-3547] Change-Id: I445cd8f3376b864c9217b65d62735deedb196917 --- BLACS/SRC/dgamn2d_.c | 10 +++++----- BLACS/SRC/dgamx2d_.c | 10 +++++----- BLACS/SRC/dgsum2d_.c | 8 ++++---- BLACS/SRC/igamn2d_.c | 10 +++++----- BLACS/SRC/igamx2d_.c | 10 +++++----- BLACS/SRC/igsum2d_.c | 8 ++++---- BLACS/SRC/sgamn2d_.c | 10 +++++----- BLACS/SRC/sgamx2d_.c | 10 +++++----- BLACS/SRC/sgsum2d_.c | 8 ++++---- PBLAS/SRC/pdgemmla_.c | 4 ++-- PBLAS/SRC/pdpanel_lcast_.c | 4 ++-- PBLAS/SRC/pdtrsmla_.c | 4 ++-- 12 files changed, 48 insertions(+), 48 deletions(-) diff --git a/BLACS/SRC/dgamn2d_.c b/BLACS/SRC/dgamn2d_.c index 06c9163f..753c984c 100644 --- a/BLACS/SRC/dgamn2d_.c +++ b/BLACS/SRC/dgamn2d_.c @@ -201,7 +201,7 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); /* * Fill in distance vector */ @@ -254,7 +254,7 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = MPI_DOUBLE; @@ -280,7 +280,7 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -291,7 +291,7 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -370,6 +370,6 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amn array */ - if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } } diff --git a/BLACS/SRC/dgamx2d_.c b/BLACS/SRC/dgamx2d_.c index 8662ef25..51fb1d7b 100644 --- a/BLACS/SRC/dgamx2d_.c +++ b/BLACS/SRC/dgamx2d_.c @@ -201,7 +201,7 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); /* * Fill in distance vector */ @@ -254,7 +254,7 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = MPI_DOUBLE; @@ -280,7 +280,7 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -291,7 +291,7 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -370,6 +370,6 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amx array */ - if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } } diff --git a/BLACS/SRC/dgsum2d_.c b/BLACS/SRC/dgsum2d_.c index 09fc6bd0..554e238e 100644 --- a/BLACS/SRC/dgsum2d_.c +++ b/BLACS/SRC/dgsum2d_.c @@ -151,7 +151,7 @@ F_VOID_FUNC dgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } bp->dtype = bp2->dtype = MPI_DOUBLE; bp->N = bp2->N = N; @@ -164,13 +164,13 @@ F_VOID_FUNC dgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, dest, ctxt->scp->comm); if (ctxt->scp->Iam == dest) - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); } else { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, ctxt->scp->comm); - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; @@ -224,7 +224,7 @@ F_VOID_FUNC dgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) - BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); BI_UpdateBuffs(bp); } else diff --git a/BLACS/SRC/igamn2d_.c b/BLACS/SRC/igamn2d_.c index 3038784d..e0bf1bcd 100644 --- a/BLACS/SRC/igamn2d_.c +++ b/BLACS/SRC/igamn2d_.c @@ -198,7 +198,7 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_imvcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); /* * Fill in distance vector */ @@ -251,7 +251,7 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_imvcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = IntTyp; @@ -277,7 +277,7 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -288,7 +288,7 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -367,6 +367,6 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amn array */ - if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } } diff --git a/BLACS/SRC/igamx2d_.c b/BLACS/SRC/igamx2d_.c index 778208b9..cd842afd 100644 --- a/BLACS/SRC/igamx2d_.c +++ b/BLACS/SRC/igamx2d_.c @@ -198,7 +198,7 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_imvcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); /* * Fill in distance vector */ @@ -251,7 +251,7 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_imvcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = IntTyp; @@ -277,7 +277,7 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -288,7 +288,7 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -367,6 +367,6 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amx array */ - if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } } diff --git a/BLACS/SRC/igsum2d_.c b/BLACS/SRC/igsum2d_.c index e08ec281..b533060f 100644 --- a/BLACS/SRC/igsum2d_.c +++ b/BLACS/SRC/igsum2d_.c @@ -151,7 +151,7 @@ F_VOID_FUNC igsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_imvcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } MPI_Type_match_size(MPI_TYPECLASS_INTEGER, sizeof(Int), &Dtype); @@ -166,13 +166,13 @@ F_VOID_FUNC igsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, dest, ctxt->scp->comm); if (ctxt->scp->Iam == dest) - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); } else { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, ctxt->scp->comm); - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; @@ -226,7 +226,7 @@ F_VOID_FUNC igsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) - BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); BI_UpdateBuffs(bp); } else diff --git a/BLACS/SRC/sgamn2d_.c b/BLACS/SRC/sgamn2d_.c index de331857..1aed4ed6 100644 --- a/BLACS/SRC/sgamn2d_.c +++ b/BLACS/SRC/sgamn2d_.c @@ -201,7 +201,7 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_smvcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); /* * Fill in distance vector */ @@ -254,7 +254,7 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_smvcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = MPI_FLOAT; @@ -280,7 +280,7 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -291,7 +291,7 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -370,6 +370,6 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amn array */ - if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } } diff --git a/BLACS/SRC/sgamx2d_.c b/BLACS/SRC/sgamx2d_.c index e30b155a..54899330 100644 --- a/BLACS/SRC/sgamx2d_.c +++ b/BLACS/SRC/sgamx2d_.c @@ -201,7 +201,7 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_smvcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); /* * Fill in distance vector */ @@ -254,7 +254,7 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_smvcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = MPI_FLOAT; @@ -280,7 +280,7 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ctxt->scp->comm); if (ctxt->scp->Iam == dest) { - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -291,7 +291,7 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm); - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], @@ -370,6 +370,6 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, /* * Unpack the amx array */ - if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } } diff --git a/BLACS/SRC/sgsum2d_.c b/BLACS/SRC/sgsum2d_.c index f3170002..c9b8e8d1 100644 --- a/BLACS/SRC/sgsum2d_.c +++ b/BLACS/SRC/sgsum2d_.c @@ -151,7 +151,7 @@ F_VOID_FUNC sgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; - BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_smvcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } bp->dtype = bp2->dtype = MPI_FLOAT; bp->N = bp2->N = N; @@ -164,13 +164,13 @@ F_VOID_FUNC sgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, ierr=MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, dest, ctxt->scp->comm); if (ctxt->scp->Iam == dest) - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); } else { ierr=MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, MPI_SUM, ctxt->scp->comm); - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; @@ -224,7 +224,7 @@ F_VOID_FUNC sgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) - BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); + BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); BI_UpdateBuffs(bp); } else diff --git a/PBLAS/SRC/pdgemmla_.c b/PBLAS/SRC/pdgemmla_.c index b216f960..c53c25e4 100644 --- a/PBLAS/SRC/pdgemmla_.c +++ b/PBLAS/SRC/pdgemmla_.c @@ -129,8 +129,8 @@ void pdgemmla_( TRANSA, TRANSB, M, N, K, ALPHA, PANEL->Xjj, PANEL->lda, type->size ); if( PANEL->brows > 0 ) type->Fgemm( TRANSA, TRANSB, &PANEL->brows, &ln, &PANEL->JB, - ALPHA, PANEL->pmem, &PANEL->ldm, Bptr, &PANEL->ldu, - BETA, Cptr, &PANEL->lda ); + (char *)ALPHA, (char *)PANEL->pmem, &PANEL->ldm, Bptr, &PANEL->ldu, + (char *)BETA, Cptr, &PANEL->lda ); return; /* * End of PDGEMMLA diff --git a/PBLAS/SRC/pdpanel_lcast_.c b/PBLAS/SRC/pdpanel_lcast_.c index 971b97c8..e2010108 100644 --- a/PBLAS/SRC/pdpanel_lcast_.c +++ b/PBLAS/SRC/pdpanel_lcast_.c @@ -36,12 +36,12 @@ void pdpanel_lcast_( pd_panel * panel, Int *N ) if( panel->myrow == panel->iarow ) { type->Cgebs2d( panel->ictxt, COLUMN, " " /*top*/, - *N, *N, panel->lmem, *N ); + *N, *N, (char *)panel->lmem, *N ); } else { type->Cgebr2d( panel->ictxt, COLUMN, " " /*top*/, - *N, *N, panel->lmem, *N, + *N, *N, (char *)panel->lmem, *N, panel->iarow, panel->mycol ); } return; diff --git a/PBLAS/SRC/pdtrsmla_.c b/PBLAS/SRC/pdtrsmla_.c index 67313d4b..16eec6b3 100644 --- a/PBLAS/SRC/pdtrsmla_.c +++ b/PBLAS/SRC/pdtrsmla_.c @@ -130,8 +130,8 @@ void pdtrsmla_( SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, PANEL ) Bptr = Mptr( ( ( char * ) PANEL->umem ), 0, PANEL->uoff, PANEL->ldu, type->size ); type->Ftrsm( SIDE, UPLO, TRANS, DIAG, - &PANEL->JB, &ln, ALPHA, - PANEL->lmem, &PANEL->JB, + &PANEL->JB, &ln, (char *)ALPHA, + (char *)PANEL->lmem, &PANEL->JB, Bptr, &PANEL->ldu ); return; /* From 9749a04e68f4164fcd64aad5129f4b65ef62c2d8 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Mon, 17 Jul 2023 22:12:44 +0530 Subject: [PATCH 09/29] Added wrapper functions for BLACS APIs, DTL calls, aocl-progress APIs needed for Fortran to C calls. 1) Lower case without underscore 2) Uppercase without underscore 3) Uppercase with underscore Signed-off-by: Nagendra AMD-Internal: [CPUPL-3674] Change-Id: If32e6b49afe7d75fe344b4a15924dd1ada5d363d --- BLACS/SRC/Bdef.h | 190 +------------------------------ BLACS/SRC/blacs_abort_.c | 18 +++ BLACS/SRC/blacs_barr_.c | 18 +++ BLACS/SRC/blacs_exit_.c | 18 +++ BLACS/SRC/blacs_free_.c | 18 +++ BLACS/SRC/blacs_get_.c | 18 +++ BLACS/SRC/blacs_grid_.c | 18 +++ BLACS/SRC/blacs_info_.c | 21 ++++ BLACS/SRC/blacs_init_.c | 18 +++ BLACS/SRC/blacs_map_.c | 21 ++++ BLACS/SRC/blacs_pcoord_.c | 18 +++ BLACS/SRC/blacs_pinfo_.c | 18 +++ BLACS/SRC/blacs_pnum_.c | 18 +++ BLACS/SRC/blacs_set_.c | 18 +++ BLACS/SRC/blacs_setup_.c | 18 +++ BLACS/SRC/cgamn2d_.c | 24 ++++ BLACS/SRC/cgamx2d_.c | 24 ++++ BLACS/SRC/cgebr2d_.c | 21 ++++ BLACS/SRC/cgebs2d_.c | 21 ++++ BLACS/SRC/cgerv2d_.c | 21 ++++ BLACS/SRC/cgesd2d_.c | 21 ++++ BLACS/SRC/cgsum2d_.c | 21 ++++ BLACS/SRC/ctrbr2d_.c | 24 ++++ BLACS/SRC/ctrbs2d_.c | 21 ++++ BLACS/SRC/ctrrv2d_.c | 21 ++++ BLACS/SRC/ctrsd2d_.c | 21 ++++ BLACS/SRC/dcputime00_.c | 18 +++ BLACS/SRC/dgamn2d_.c | 24 ++++ BLACS/SRC/dgamx2d_.c | 24 ++++ BLACS/SRC/dgebr2d_.c | 21 ++++ BLACS/SRC/dgebs2d_.c | 21 ++++ BLACS/SRC/dgerv2d_.c | 21 ++++ BLACS/SRC/dgesd2d_.c | 21 ++++ BLACS/SRC/dgsum2d_.c | 21 ++++ BLACS/SRC/dtrbr2d_.c | 24 ++++ BLACS/SRC/dtrbs2d_.c | 21 ++++ BLACS/SRC/dtrrv2d_.c | 21 ++++ BLACS/SRC/dtrsd2d_.c | 21 ++++ BLACS/SRC/dwalltime00_.c | 18 +++ BLACS/SRC/igamn2d_.c | 24 ++++ BLACS/SRC/igamx2d_.c | 24 ++++ BLACS/SRC/igebr2d_.c | 21 ++++ BLACS/SRC/igebs2d_.c | 21 ++++ BLACS/SRC/igerv2d_.c | 21 ++++ BLACS/SRC/igesd2d_.c | 21 ++++ BLACS/SRC/igsum2d_.c | 21 ++++ BLACS/SRC/itrbr2d_.c | 24 ++++ BLACS/SRC/itrbs2d_.c | 21 ++++ BLACS/SRC/itrrv2d_.c | 21 ++++ BLACS/SRC/itrsd2d_.c | 21 ++++ BLACS/SRC/sgamn2d_.c | 24 ++++ BLACS/SRC/sgamx2d_.c | 24 ++++ BLACS/SRC/sgebr2d_.c | 21 ++++ BLACS/SRC/sgebs2d_.c | 21 ++++ BLACS/SRC/sgerv2d_.c | 21 ++++ BLACS/SRC/sgesd2d_.c | 21 ++++ BLACS/SRC/sgsum2d_.c | 21 ++++ BLACS/SRC/strbr2d_.c | 24 ++++ BLACS/SRC/strbs2d_.c | 21 ++++ BLACS/SRC/strrv2d_.c | 21 ++++ BLACS/SRC/strsd2d_.c | 21 ++++ BLACS/SRC/zgamn2d_.c | 24 ++++ BLACS/SRC/zgamx2d_.c | 24 ++++ BLACS/SRC/zgebr2d_.c | 21 ++++ BLACS/SRC/zgebs2d_.c | 21 ++++ BLACS/SRC/zgerv2d_.c | 21 ++++ BLACS/SRC/zgesd2d_.c | 21 ++++ BLACS/SRC/zgsum2d_.c | 21 ++++ BLACS/SRC/ztrbr2d_.c | 24 ++++ BLACS/SRC/ztrbs2d_.c | 21 ++++ BLACS/SRC/ztrrv2d_.c | 21 ++++ BLACS/SRC/ztrsd2d_.c | 21 ++++ BLACS/TESTING/CMakeLists.txt | 5 - FRAMEWORK/SL_Context.c | 14 ++- FRAMEWORK/SL_Context.h | 14 ++- SRC/aocl_dtl_trace_entry.c | 44 +++++++ SRC/aocl_dtl_trace_exit.c | 25 +++- SRC/aocl_scalapack_progress.c | 37 +++++- SRC/aocl_scalapack_progress.h | 25 +++- SRC/get_aocl_scalapack_version.c | 19 ++++ SRC/pxsyevx.h | 13 --- 81 files changed, 1656 insertions(+), 224 deletions(-) diff --git a/BLACS/SRC/Bdef.h b/BLACS/SRC/Bdef.h index da2f062c..4aad2113 100644 --- a/BLACS/SRC/Bdef.h +++ b/BLACS/SRC/Bdef.h @@ -337,194 +337,8 @@ Int BI_ContxtNum(BLACSCONTEXT *ctxt); #define BI_MPI_TYPE_FREE(t) MPI_Type_free(t) #endif -#if (FORTRAN_CALL_C == NOCHANGE) -/* - * These defines set up the naming scheme required to have a fortran - * routine call a C routine (which is what the BLACS are written in) - * for the following Fortran to C interface: - * FORTRAN CALL C DECLARATION - * call dgebs2d(...) void dgebs2d(...) - */ - -/* - * Support routines - */ -#define blacs_pinfo_ blacs_pinfo -#define blacs_setup_ blacs_setup -#define setpvmtids_ setpvmtids -#define blacs_set_ blacs_set -#define blacs_get_ blacs_get -#define blacs_gridinit_ blacs_gridinit -#define blacs_gridmap_ blacs_gridmap -#define ksendid_ ksendid -#define krecvid_ krecvid -#define kbsid_ kbsid -#define kbrid_ kbrid -#define blacs_freebuff_ blacs_freebuff -#define blacs_gridexit_ blacs_gridexit -#define blacs_abort_ blacs_abort -#define blacs_exit_ blacs_exit -#define blacs_gridinfo_ blacs_gridinfo -#define blacs_pnum_ blacs_pnum -#define blacs_pcoord_ blacs_pcoord -#define dcputime00_ dcputime00 -#define dwalltime00_ dwalltime00 -#define blacs_barrier_ blacs_barrier - -/* - * Main, type dependent, routines - */ -#define igesd2d_ igesd2d -#define igerv2d_ igerv2d -#define igebs2d_ igebs2d -#define igebr2d_ igebr2d -#define itrsd2d_ itrsd2d -#define itrrv2d_ itrrv2d -#define itrbs2d_ itrbs2d -#define itrbr2d_ itrbr2d -#define igsum2d_ igsum2d -#define igamx2d_ igamx2d -#define igamn2d_ igamn2d -#define sgesd2d_ sgesd2d -#define sgerv2d_ sgerv2d -#define sgebs2d_ sgebs2d -#define sgebr2d_ sgebr2d -#define strsd2d_ strsd2d -#define strrv2d_ strrv2d -#define strbs2d_ strbs2d -#define strbr2d_ strbr2d -#define sgsum2d_ sgsum2d -#define sgamx2d_ sgamx2d -#define sgamn2d_ sgamn2d -#define dgesd2d_ dgesd2d -#define dgerv2d_ dgerv2d -#define dgebs2d_ dgebs2d -#define dgebr2d_ dgebr2d -#define ugesr2d_ ugesr2d -#define dtrsd2d_ dtrsd2d -#define dtrrv2d_ dtrrv2d -#define dtrbs2d_ dtrbs2d -#define dtrbr2d_ dtrbr2d -#define dgsum2d_ dgsum2d -#define dgamx2d_ dgamx2d -#define dgamn2d_ dgamn2d -#define cgesd2d_ cgesd2d -#define cgerv2d_ cgerv2d -#define cgebs2d_ cgebs2d -#define cgebr2d_ cgebr2d -#define ctrsd2d_ ctrsd2d -#define ctrrv2d_ ctrrv2d -#define ctrbs2d_ ctrbs2d -#define ctrbr2d_ ctrbr2d -#define cgsum2d_ cgsum2d -#define cgamx2d_ cgamx2d -#define cgamn2d_ cgamn2d -#define zgesd2d_ zgesd2d -#define zgerv2d_ zgerv2d -#define zgebs2d_ zgebs2d -#define zgebr2d_ zgebr2d -#define ztrsd2d_ ztrsd2d -#define ztrrv2d_ ztrrv2d -#define ztrbs2d_ ztrbs2d -#define ztrbr2d_ ztrbr2d -#define zgsum2d_ zgsum2d -#define zgamx2d_ zgamx2d -#define zgamn2d_ zgamn2d - -#elif (FORTRAN_CALL_C == UPCASE) -/* - * These defines set up the naming scheme required to have a fortran - * routine call a C routine (which is what the BLACS are written in) - * for the following Fortran to C interface: - * FORTRAN CALL C DECLARATION - * call dgebs2d(...) void DGEBS2D(...) - */ -/* - * Support routines - */ -#define blacs_pinfo_ BLACS_PINFO -#define blacs_setup_ BLACS_SETUP -#define setpvmtids_ SETPVMTIDS -#define blacs_set_ BLACS_SET -#define blacs_get_ BLACS_GET -#define blacs_gridinit_ BLACS_GRIDINIT -#define blacs_gridmap_ BLACS_GRIDMAP -#define ksendid_ KSENDID -#define krecvid_ KRECVID -#define kbsid_ KBSID -#define kbrid_ KBRID -#define blacs_freebuff_ BLACS_FREEBUFF -#define blacs_gridexit_ BLACS_GRIDEXIT -#define blacs_abort_ BLACS_ABORT -#define blacs_exit_ BLACS_EXIT -#define blacs_gridinfo_ BLACS_GRIDINFO -#define blacs_pnum_ BLACS_PNUM -#define blacs_pcoord_ BLACS_PCOORD -#define dcputime00_ DCPUTIME00 -#define dwalltime00_ DWALLTIME00 -#define blacs_barrier_ BLACS_BARRIER - -/* - * Main, type dependent, routines - */ -#define igesd2d_ IGESD2D -#define igerv2d_ IGERV2D -#define igebs2d_ IGEBS2D -#define igebr2d_ IGEBR2D -#define itrsd2d_ ITRSD2D -#define itrrv2d_ ITRRV2D -#define itrbs2d_ ITRBS2D -#define itrbr2d_ ITRBR2D -#define igsum2d_ IGSUM2D -#define igamx2d_ IGAMX2D -#define igamn2d_ IGAMN2D -#define sgesd2d_ SGESD2D -#define sgerv2d_ SGERV2D -#define sgebs2d_ SGEBS2D -#define sgebr2d_ SGEBR2D -#define strsd2d_ STRSD2D -#define strrv2d_ STRRV2D -#define strbs2d_ STRBS2D -#define strbr2d_ STRBR2D -#define sgsum2d_ SGSUM2D -#define sgamx2d_ SGAMX2D -#define sgamn2d_ SGAMN2D -#define dgesd2d_ DGESD2D -#define dgerv2d_ DGERV2D -#define dgebs2d_ DGEBS2D -#define dgebr2d_ DGEBR2D -#define ugesr2d_ UGESR2D -#define dtrsd2d_ DTRSD2D -#define dtrrv2d_ DTRRV2D -#define dtrbs2d_ DTRBS2D -#define dtrbr2d_ DTRBR2D -#define dgsum2d_ DGSUM2D -#define dgamx2d_ DGAMX2D -#define dgamn2d_ DGAMN2D -#define cgesd2d_ CGESD2D -#define cgerv2d_ CGERV2D -#define cgebs2d_ CGEBS2D -#define cgebr2d_ CGEBR2D -#define ctrsd2d_ CTRSD2D -#define ctrrv2d_ CTRRV2D -#define ctrbs2d_ CTRBS2D -#define ctrbr2d_ CTRBR2D -#define cgsum2d_ CGSUM2D -#define cgamx2d_ CGAMX2D -#define cgamn2d_ CGAMN2D -#define zgesd2d_ ZGESD2D -#define zgerv2d_ ZGERV2D -#define zgebs2d_ ZGEBS2D -#define zgebr2d_ ZGEBR2D -#define ztrsd2d_ ZTRSD2D -#define ztrrv2d_ ZTRRV2D -#define ztrbs2d_ ZTRBS2D -#define ztrbr2d_ ZTRBR2D -#define zgsum2d_ ZGSUM2D -#define zgamx2d_ ZGAMX2D -#define zgamn2d_ ZGAMN2D - -#elif (FORTRAN_CALL_C == FCISF2C) + +#if (FORTRAN_CALL_C == FCISF2C) /* * These defines set up the naming scheme required to have a fortran * routine call a C routine (which is what the BLACS are written in) diff --git a/BLACS/SRC/blacs_abort_.c b/BLACS/SRC/blacs_abort_.c index 0e440995..428da20a 100644 --- a/BLACS/SRC/blacs_abort_.c +++ b/BLACS/SRC/blacs_abort_.c @@ -18,3 +18,21 @@ F_VOID_FUNC blacs_abort_(Int *ConTxt, Int *ErrNo) BI_BlacsAbort(Mpval(ErrNo)); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_abort(Int *ConTxt, Int *ErrNo) +{ + blacs_abort_( ConTxt, ErrNo); +} + +F_VOID_FUNC BLACS_ABORT(Int *ConTxt, Int *ErrNo) +{ + blacs_abort_( ConTxt, ErrNo); +} + +F_VOID_FUNC BLACS_ABORT_(Int *ConTxt, Int *ErrNo) +{ + blacs_abort_( ConTxt, ErrNo); +} +#endif diff --git a/BLACS/SRC/blacs_barr_.c b/BLACS/SRC/blacs_barr_.c index 84ff3489..9d0e04b0 100644 --- a/BLACS/SRC/blacs_barr_.c +++ b/BLACS/SRC/blacs_barr_.c @@ -26,3 +26,21 @@ F_VOID_FUNC blacs_barrier_(Int *ConTxt, F_CHAR scope) break; } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_barrier(Int *ConTxt, F_CHAR scope) +{ + blacs_barrier_( ConTxt, scope); +} + +F_VOID_FUNC BLACS_BARRIER(Int *ConTxt, F_CHAR scope) +{ + blacs_barrier_( ConTxt, scope); +} + +F_VOID_FUNC BLACS_BARRIER_(Int *ConTxt, F_CHAR scope) +{ + blacs_barrier_( ConTxt, scope); +} +#endif diff --git a/BLACS/SRC/blacs_exit_.c b/BLACS/SRC/blacs_exit_.c index cb6177fc..0d6301d9 100644 --- a/BLACS/SRC/blacs_exit_.c +++ b/BLACS/SRC/blacs_exit_.c @@ -50,3 +50,21 @@ F_VOID_FUNC blacs_exit_(Int *NotDone) BI_AuxBuff.Aops = NULL; BI_Stats = NULL; } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_exit(Int *NotDone) +{ + blacs_exit_( NotDone); +} + +F_VOID_FUNC BLACS_EXIT(Int *NotDone) +{ + blacs_exit_( NotDone); +} + +F_VOID_FUNC BLACS_EXIT_(Int *NotDone) +{ + blacs_exit_( NotDone); +} +#endif diff --git a/BLACS/SRC/blacs_free_.c b/BLACS/SRC/blacs_free_.c index 6810c34d..134d5795 100644 --- a/BLACS/SRC/blacs_free_.c +++ b/BLACS/SRC/blacs_free_.c @@ -22,3 +22,21 @@ F_VOID_FUNC blacs_freebuff_(Int *ConTxt, Int *Wait) BI_ReadyB = NULL; } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_freebuff(Int *ConTxt, Int *Wait) +{ + blacs_freebuff_( ConTxt, Wait); +} + +F_VOID_FUNC BLACS_FREEBUFF(Int *ConTxt, Int *Wait) +{ + blacs_freebuff_( ConTxt, Wait); +} + +F_VOID_FUNC BLACS_FREEBUFF_(Int *ConTxt, Int *Wait) +{ + blacs_freebuff_( ConTxt, Wait); +} +#endif diff --git a/BLACS/SRC/blacs_get_.c b/BLACS/SRC/blacs_get_.c index 1337caa3..cdd7a86b 100644 --- a/BLACS/SRC/blacs_get_.c +++ b/BLACS/SRC/blacs_get_.c @@ -77,3 +77,21 @@ F_VOID_FUNC blacs_get_(Int *ConTxt, Int *what, Int *val) Mpval(what)); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_get(Int *ConTxt, Int *what, Int *val) +{ + blacs_get_( ConTxt, what, val); +} + +F_VOID_FUNC BLACS_GET(Int *ConTxt, Int *what, Int *val) +{ + blacs_get_( ConTxt, what, val); +} + +F_VOID_FUNC BLACS_GET_(Int *ConTxt, Int *what, Int *val) +{ + blacs_get_( ConTxt, what, val); +} +#endif diff --git a/BLACS/SRC/blacs_grid_.c b/BLACS/SRC/blacs_grid_.c index 1889d1b5..5c518ad1 100644 --- a/BLACS/SRC/blacs_grid_.c +++ b/BLACS/SRC/blacs_grid_.c @@ -42,3 +42,21 @@ F_VOID_FUNC blacs_gridexit_(Int *ConTxt) free(ctxt); BI_MyContxts[Mpval(ConTxt)] = NULL; } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_gridexit(Int *ConTxt) +{ + blacs_gridexit_( ConTxt); +} + +F_VOID_FUNC BLACS_GRIDEXIT(Int *ConTxt) +{ + blacs_gridexit_( ConTxt); +} + +F_VOID_FUNC BLACS_GRIDEXIT_(Int *ConTxt) +{ + blacs_gridexit_( ConTxt); +} +#endif diff --git a/BLACS/SRC/blacs_info_.c b/BLACS/SRC/blacs_info_.c index 3aedb923..827ef01e 100644 --- a/BLACS/SRC/blacs_info_.c +++ b/BLACS/SRC/blacs_info_.c @@ -30,3 +30,24 @@ F_VOID_FUNC blacs_gridinfo_(Int *ConTxt, Int *nprow, Int *npcol, } else *nprow = *npcol = *myrow = *mycol = -1; } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_gridinfo(Int *ConTxt, Int *nprow, Int *npcol, + Int *myrow, Int *mycol) +{ + blacs_gridinfo_( ConTxt, nprow, npcol, myrow, mycol); +} + +F_VOID_FUNC BLACS_GRIDINFO(Int *ConTxt, Int *nprow, Int *npcol, + Int *myrow, Int *mycol) +{ + blacs_gridinfo_( ConTxt, nprow, npcol, myrow, mycol); +} + +F_VOID_FUNC BLACS_GRIDINFO_(Int *ConTxt, Int *nprow, Int *npcol, + Int *myrow, Int *mycol) +{ + blacs_gridinfo_( ConTxt, nprow, npcol, myrow, mycol); +} +#endif diff --git a/BLACS/SRC/blacs_init_.c b/BLACS/SRC/blacs_init_.c index 002416f4..f02bc5e9 100644 --- a/BLACS/SRC/blacs_init_.c +++ b/BLACS/SRC/blacs_init_.c @@ -36,3 +36,21 @@ F_VOID_FUNC blacs_gridinit_(Int *ConTxt, F_CHAR order, Int *nprow, Int *npcol) #endif free(tmpgrid); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_gridinit(Int *ConTxt, F_CHAR order, Int *nprow, Int *npcol) +{ + blacs_gridinit_( ConTxt, order, nprow, npcol); +} + +F_VOID_FUNC BLACS_GRIDINIT(Int *ConTxt, F_CHAR order, Int *nprow, Int *npcol) +{ + blacs_gridinit_( ConTxt, order, nprow, npcol); +} + +F_VOID_FUNC BLACS_GRIDINIT_(Int *ConTxt, F_CHAR order, Int *nprow, Int *npcol) +{ + blacs_gridinit_( ConTxt, order, nprow, npcol); +} +#endif diff --git a/BLACS/SRC/blacs_map_.c b/BLACS/SRC/blacs_map_.c index aa05229c..528df0b9 100644 --- a/BLACS/SRC/blacs_map_.c +++ b/BLACS/SRC/blacs_map_.c @@ -164,3 +164,24 @@ F_VOID_FUNC blacs_gridmap_(Int *ConTxt, Int *usermap, Int *ldup, Int *nprow0, free(iptr); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_gridmap(Int *ConTxt, Int *usermap, Int *ldup, Int *nprow0, + Int *npcol0) +{ + blacs_gridmap_( ConTxt, usermap, ldup, nprow0, npcol0); +} + +F_VOID_FUNC BLACS_GRIDMAP(Int *ConTxt, Int *usermap, Int *ldup, Int *nprow0, + Int *npcol0) +{ + blacs_gridmap_( ConTxt, usermap, ldup, nprow0, npcol0); +} + +F_VOID_FUNC BLACS_GRIDMAP_(Int *ConTxt, Int *usermap, Int *ldup, Int *nprow0, + Int *npcol0) +{ + blacs_gridmap_( ConTxt, usermap, ldup, nprow0, npcol0); +} +#endif diff --git a/BLACS/SRC/blacs_pcoord_.c b/BLACS/SRC/blacs_pcoord_.c index 455d84cd..acd41025 100644 --- a/BLACS/SRC/blacs_pcoord_.c +++ b/BLACS/SRC/blacs_pcoord_.c @@ -15,3 +15,21 @@ F_VOID_FUNC blacs_pcoord_(Int *ConTxt, Int *nodenum, Int *prow, Int *pcol) } else *prow = *pcol = -1; } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_pcoord(Int *ConTxt, Int *nodenum, Int *prow, Int *pcol) +{ + blacs_pcoord_( ConTxt, nodenum, prow, pcol); +} + +F_VOID_FUNC BLACS_PCOORD(Int *ConTxt, Int *nodenum, Int *prow, Int *pcol) +{ + blacs_pcoord_( ConTxt, nodenum, prow, pcol); +} + +F_VOID_FUNC BLACS_PCOORD_(Int *ConTxt, Int *nodenum, Int *prow, Int *pcol) +{ + blacs_pcoord_( ConTxt, nodenum, prow, pcol); +} +#endif diff --git a/BLACS/SRC/blacs_pinfo_.c b/BLACS/SRC/blacs_pinfo_.c index b878e23d..9a1d82c5 100644 --- a/BLACS/SRC/blacs_pinfo_.c +++ b/BLACS/SRC/blacs_pinfo_.c @@ -26,3 +26,21 @@ F_VOID_FUNC blacs_pinfo_(Int *mypnum, Int *nprocs) *mypnum = BI_Iam = Iam; *nprocs = BI_Np = Np; } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_pinfo(Int *mypnum, Int *nprocs) +{ + blacs_pinfo_( mypnum, nprocs); +} + +F_VOID_FUNC BLACS_PINFO(Int *mypnum, Int *nprocs) +{ + blacs_pinfo_( mypnum, nprocs); +} + +F_VOID_FUNC BLACS_PINFO_(Int *mypnum, Int *nprocs) +{ + blacs_pinfo_( mypnum, nprocs); +} +#endif diff --git a/BLACS/SRC/blacs_pnum_.c b/BLACS/SRC/blacs_pnum_.c index 1d0fe0b2..ece559a9 100644 --- a/BLACS/SRC/blacs_pnum_.c +++ b/BLACS/SRC/blacs_pnum_.c @@ -14,3 +14,21 @@ F_INT_FUNC blacs_pnum_(Int *ConTxt, Int *prow, Int *pcol) return( Mkpnum(ctxt, Mpval(prow), Mpval(pcol)) ); else return(-1); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_INT_FUNC blacs_pnum(Int *ConTxt, Int *prow, Int *pcol) +{ + return blacs_pnum_( ConTxt, prow, pcol); +} + +F_INT_FUNC BLACS_PNUM(Int *ConTxt, Int *prow, Int *pcol) +{ + return blacs_pnum_( ConTxt, prow, pcol); +} + +F_INT_FUNC BLACS_PNUM_(Int *ConTxt, Int *prow, Int *pcol) +{ + return blacs_pnum_( ConTxt, prow, pcol); +} +#endif diff --git a/BLACS/SRC/blacs_set_.c b/BLACS/SRC/blacs_set_.c index daaefb2d..11015882 100644 --- a/BLACS/SRC/blacs_set_.c +++ b/BLACS/SRC/blacs_set_.c @@ -65,3 +65,21 @@ F_VOID_FUNC blacs_set_(Int *ConTxt, Int *what, Int *val) Mpval(what)); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_set(Int *ConTxt, Int *what, Int *val) +{ + blacs_set_( ConTxt, what, val); +} + +F_VOID_FUNC BLACS_SET(Int *ConTxt, Int *what, Int *val) +{ + blacs_set_( ConTxt, what, val); +} + +F_VOID_FUNC BLACS_SET_(Int *ConTxt, Int *what, Int *val) +{ + blacs_set_( ConTxt, what, val); +} +#endif diff --git a/BLACS/SRC/blacs_setup_.c b/BLACS/SRC/blacs_setup_.c index b97ab070..5bc8da59 100644 --- a/BLACS/SRC/blacs_setup_.c +++ b/BLACS/SRC/blacs_setup_.c @@ -12,3 +12,21 @@ F_VOID_FUNC blacs_setup_(Int *mypnum, Int *nprocs) void Cblacs_pinfo(Int *, Int *); Cblacs_pinfo(mypnum, nprocs); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC blacs_setup(Int *mypnum, Int *nprocs) +{ + blacs_setup_( mypnum, nprocs); +} + +F_VOID_FUNC BLACS_SETUP(Int *mypnum, Int *nprocs) +{ + blacs_setup_( mypnum, nprocs); +} + +F_VOID_FUNC BLACS_SETUP_(Int *mypnum, Int *nprocs) +{ + blacs_setup_( mypnum, nprocs); +} +#endif diff --git a/BLACS/SRC/cgamn2d_.c b/BLACS/SRC/cgamn2d_.c index aabd21b8..96d65108 100644 --- a/BLACS/SRC/cgamn2d_.c +++ b/BLACS/SRC/cgamn2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC cgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgamn2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC CGAMN2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC CGAMN2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/cgamx2d_.c b/BLACS/SRC/cgamx2d_.c index 18171f94..a11a724f 100644 --- a/BLACS/SRC/cgamx2d_.c +++ b/BLACS/SRC/cgamx2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC cgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgamx2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC CGAMX2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC CGAMX2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + cgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/cgebr2d_.c b/BLACS/SRC/cgebr2d_.c index e3035947..45fcf154 100644 --- a/BLACS/SRC/cgebr2d_.c +++ b/BLACS/SRC/cgebr2d_.c @@ -224,3 +224,24 @@ F_VOID_FUNC cgebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgebr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + cgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CGEBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + cgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CGEBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + cgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/cgebs2d_.c b/BLACS/SRC/cgebs2d_.c index 5e9e1c46..2935b495 100644 --- a/BLACS/SRC/cgebs2d_.c +++ b/BLACS/SRC/cgebs2d_.c @@ -193,3 +193,24 @@ F_VOID_FUNC cgebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, } else BI_UpdateBuffs(bp); } /* end cgebs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgebs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + cgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC CGEBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + cgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC CGEBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + cgebs2d_( ConTxt, scope, top, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/cgerv2d_.c b/BLACS/SRC/cgerv2d_.c index a7cb2625..3f89853a 100644 --- a/BLACS/SRC/cgerv2d_.c +++ b/BLACS/SRC/cgerv2d_.c @@ -80,3 +80,24 @@ F_VOID_FUNC cgerv2d_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgerv2d(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + cgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CGERV2D(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + cgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CGERV2D_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + cgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/cgesd2d_.c b/BLACS/SRC/cgesd2d_.c index c16d451a..da16e5b9 100644 --- a/BLACS/SRC/cgesd2d_.c +++ b/BLACS/SRC/cgesd2d_.c @@ -93,3 +93,24 @@ F_VOID_FUNC cgesd2d_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, BI_UpdateBuffs(bp); #endif } /* end of cgesd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgesd2d(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + cgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CGESD2D(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + cgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CGESD2D_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + cgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/cgsum2d_.c b/BLACS/SRC/cgsum2d_.c index aa8affe2..ad3df8c6 100644 --- a/BLACS/SRC/cgsum2d_.c +++ b/BLACS/SRC/cgsum2d_.c @@ -236,3 +236,24 @@ F_VOID_FUNC cgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, BI_BuffIsFree(bp, 1); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC cgsum2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + cgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CGSUM2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + cgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CGSUM2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + cgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/ctrbr2d_.c b/BLACS/SRC/ctrbr2d_.c index b1234023..67bfbb6f 100644 --- a/BLACS/SRC/ctrbr2d_.c +++ b/BLACS/SRC/ctrbr2d_.c @@ -222,3 +222,27 @@ F_VOID_FUNC ctrbr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, BI_UpdateBuffs(bp); #endif } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ctrbr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ctrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CTRBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ctrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CTRBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ctrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/ctrbs2d_.c b/BLACS/SRC/ctrbs2d_.c index c9f174f4..a6e3d637 100644 --- a/BLACS/SRC/ctrbs2d_.c +++ b/BLACS/SRC/ctrbs2d_.c @@ -204,3 +204,24 @@ F_VOID_FUNC ctrbs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, } else BI_UpdateBuffs(bp); } /* end ctrbs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ctrbs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + ctrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC CTRBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + ctrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC CTRBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + ctrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/ctrrv2d_.c b/BLACS/SRC/ctrrv2d_.c index fe03318f..1f4f16f0 100644 --- a/BLACS/SRC/ctrrv2d_.c +++ b/BLACS/SRC/ctrrv2d_.c @@ -99,3 +99,24 @@ F_VOID_FUNC ctrrv2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ctrrv2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + ctrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CTRRV2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + ctrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC CTRRV2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + ctrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/ctrsd2d_.c b/BLACS/SRC/ctrsd2d_.c index 06ab2c09..13560aa6 100644 --- a/BLACS/SRC/ctrsd2d_.c +++ b/BLACS/SRC/ctrsd2d_.c @@ -111,3 +111,24 @@ F_VOID_FUNC ctrsd2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, BI_UpdateBuffs(bp); #endif } /* end of ctrsd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ctrsd2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + ctrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CTRSD2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + ctrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC CTRSD2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + ctrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dcputime00_.c b/BLACS/SRC/dcputime00_.c index fa51b1c5..fbda2606 100644 --- a/BLACS/SRC/dcputime00_.c +++ b/BLACS/SRC/dcputime00_.c @@ -8,3 +8,21 @@ F_DOUBLE_FUNC dcputime00_(void) { return(-1.0); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_DOUBLE_FUNC dcputime00(void) +{ + return dcputime00_(); +} + +F_DOUBLE_FUNC DCPUTIME00(void) +{ + return dcputime00_(); +} + +F_DOUBLE_FUNC DCPUTIME00_(void) +{ + return dcputime00_(); +} +#endif diff --git a/BLACS/SRC/dgamn2d_.c b/BLACS/SRC/dgamn2d_.c index 753c984c..f23920bb 100644 --- a/BLACS/SRC/dgamn2d_.c +++ b/BLACS/SRC/dgamn2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC dgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgamn2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC DGAMN2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC DGAMN2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dgamx2d_.c b/BLACS/SRC/dgamx2d_.c index 51fb1d7b..7e3ffaf0 100644 --- a/BLACS/SRC/dgamx2d_.c +++ b/BLACS/SRC/dgamx2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC dgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, (double *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgamx2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC DGAMX2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC DGAMX2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + dgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dgebr2d_.c b/BLACS/SRC/dgebr2d_.c index a33c33a5..7eb5abd6 100644 --- a/BLACS/SRC/dgebr2d_.c +++ b/BLACS/SRC/dgebr2d_.c @@ -224,3 +224,24 @@ F_VOID_FUNC dgebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgebr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DGEBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DGEBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/dgebs2d_.c b/BLACS/SRC/dgebs2d_.c index 7e5840fa..b414d1f2 100644 --- a/BLACS/SRC/dgebs2d_.c +++ b/BLACS/SRC/dgebs2d_.c @@ -193,3 +193,24 @@ F_VOID_FUNC dgebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, } else BI_UpdateBuffs(bp); } /* end dgebs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgebs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + dgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC DGEBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + dgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC DGEBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + dgebs2d_( ConTxt, scope, top, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/dgerv2d_.c b/BLACS/SRC/dgerv2d_.c index 21642801..4b69da19 100644 --- a/BLACS/SRC/dgerv2d_.c +++ b/BLACS/SRC/dgerv2d_.c @@ -80,3 +80,24 @@ F_VOID_FUNC dgerv2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgerv2d(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DGERV2D(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DGERV2D_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/dgesd2d_.c b/BLACS/SRC/dgesd2d_.c index 987fe406..3490ade3 100644 --- a/BLACS/SRC/dgesd2d_.c +++ b/BLACS/SRC/dgesd2d_.c @@ -94,3 +94,24 @@ F_VOID_FUNC dgesd2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, BI_UpdateBuffs(bp); #endif } /* end of dgesd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgesd2d(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + dgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DGESD2D(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + dgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DGESD2D_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + dgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dgsum2d_.c b/BLACS/SRC/dgsum2d_.c index 554e238e..0c01fa8a 100644 --- a/BLACS/SRC/dgsum2d_.c +++ b/BLACS/SRC/dgsum2d_.c @@ -233,3 +233,24 @@ F_VOID_FUNC dgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, BI_BuffIsFree(bp, 1); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dgsum2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DGSUM2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DGSUM2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dtrbr2d_.c b/BLACS/SRC/dtrbr2d_.c index 62d75a81..ffd1d7ca 100644 --- a/BLACS/SRC/dtrbr2d_.c +++ b/BLACS/SRC/dtrbr2d_.c @@ -222,3 +222,27 @@ F_VOID_FUNC dtrbr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, BI_UpdateBuffs(bp); #endif } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dtrbr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dtrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DTRBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dtrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DTRBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + dtrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/dtrbs2d_.c b/BLACS/SRC/dtrbs2d_.c index 1a8eddee..eaf9ae1b 100644 --- a/BLACS/SRC/dtrbs2d_.c +++ b/BLACS/SRC/dtrbs2d_.c @@ -204,3 +204,24 @@ F_VOID_FUNC dtrbs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, } else BI_UpdateBuffs(bp); } /* end dtrbs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dtrbs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + dtrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC DTRBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + dtrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC DTRBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + dtrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/dtrrv2d_.c b/BLACS/SRC/dtrrv2d_.c index 931e1c62..56da5675 100644 --- a/BLACS/SRC/dtrrv2d_.c +++ b/BLACS/SRC/dtrrv2d_.c @@ -99,3 +99,24 @@ F_VOID_FUNC dtrrv2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dtrrv2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dtrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DTRRV2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dtrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC DTRRV2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + dtrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/dtrsd2d_.c b/BLACS/SRC/dtrsd2d_.c index e04fdee7..5ee21ada 100644 --- a/BLACS/SRC/dtrsd2d_.c +++ b/BLACS/SRC/dtrsd2d_.c @@ -111,3 +111,24 @@ F_VOID_FUNC dtrsd2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, BI_UpdateBuffs(bp); #endif } /* end of dtrsd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC dtrsd2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dtrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DTRSD2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dtrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC DTRSD2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + dtrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/dwalltime00_.c b/BLACS/SRC/dwalltime00_.c index f5c69fb8..13e088fa 100644 --- a/BLACS/SRC/dwalltime00_.c +++ b/BLACS/SRC/dwalltime00_.c @@ -8,3 +8,21 @@ F_DOUBLE_FUNC dwalltime00_(void) { return(MPI_Wtime()); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_DOUBLE_FUNC dwalltime00(void) +{ + return dwalltime00_(); +} + +F_DOUBLE_FUNC DWALLTIME00(void) +{ + return dwalltime00_(); +} + +F_DOUBLE_FUNC DWALLTIME00_(void) +{ + return dwalltime00_(); +} +#endif diff --git a/BLACS/SRC/igamn2d_.c b/BLACS/SRC/igamn2d_.c index e0bf1bcd..86d2941d 100644 --- a/BLACS/SRC/igamn2d_.c +++ b/BLACS/SRC/igamn2d_.c @@ -370,3 +370,27 @@ F_VOID_FUNC igamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igamn2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC IGAMN2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC IGAMN2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/igamx2d_.c b/BLACS/SRC/igamx2d_.c index cd842afd..23f40e27 100644 --- a/BLACS/SRC/igamx2d_.c +++ b/BLACS/SRC/igamx2d_.c @@ -370,3 +370,27 @@ F_VOID_FUNC igamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, (int *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igamx2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC IGAMX2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC IGAMX2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + igamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/igebr2d_.c b/BLACS/SRC/igebr2d_.c index 94e7411f..3e20a587 100644 --- a/BLACS/SRC/igebr2d_.c +++ b/BLACS/SRC/igebr2d_.c @@ -225,3 +225,24 @@ F_VOID_FUNC igebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igebr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + igebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC IGEBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + igebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC IGEBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + igebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/igebs2d_.c b/BLACS/SRC/igebs2d_.c index 38429980..7beb34d0 100644 --- a/BLACS/SRC/igebs2d_.c +++ b/BLACS/SRC/igebs2d_.c @@ -193,3 +193,24 @@ F_VOID_FUNC igebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, } else BI_UpdateBuffs(bp); } /* end igebs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igebs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda) +{ + igebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC IGEBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda) +{ + igebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC IGEBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda) +{ + igebs2d_( ConTxt, scope, top, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/igerv2d_.c b/BLACS/SRC/igerv2d_.c index 6cc3ea3c..05f11942 100644 --- a/BLACS/SRC/igerv2d_.c +++ b/BLACS/SRC/igerv2d_.c @@ -81,3 +81,24 @@ F_VOID_FUNC igerv2d_(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igerv2d(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + igerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC IGERV2D(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + igerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC IGERV2D_(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + igerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/igesd2d_.c b/BLACS/SRC/igesd2d_.c index 68aa6dbe..9e008777 100644 --- a/BLACS/SRC/igesd2d_.c +++ b/BLACS/SRC/igesd2d_.c @@ -94,3 +94,24 @@ F_VOID_FUNC igesd2d_(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, BI_UpdateBuffs(bp); #endif } /* end of igesd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igesd2d(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rdest, Int *cdest) +{ + igesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC IGESD2D(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rdest, Int *cdest) +{ + igesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC IGESD2D_(Int *ConTxt, Int *m, Int *n, Int *A, Int *lda, + Int *rdest, Int *cdest) +{ + igesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/igsum2d_.c b/BLACS/SRC/igsum2d_.c index b533060f..01f0b17d 100644 --- a/BLACS/SRC/igsum2d_.c +++ b/BLACS/SRC/igsum2d_.c @@ -235,3 +235,24 @@ F_VOID_FUNC igsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, BI_BuffIsFree(bp, 1); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC igsum2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + igsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC IGSUM2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + igsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC IGSUM2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + igsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/itrbr2d_.c b/BLACS/SRC/itrbr2d_.c index cec5f753..c3fc4c10 100644 --- a/BLACS/SRC/itrbr2d_.c +++ b/BLACS/SRC/itrbr2d_.c @@ -223,3 +223,27 @@ F_VOID_FUNC itrbr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, BI_UpdateBuffs(bp); #endif } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC itrbr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + itrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ITRBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + itrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ITRBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda, + Int *rsrc, Int *csrc) +{ + itrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/itrbs2d_.c b/BLACS/SRC/itrbs2d_.c index 04f352a2..fb06e9f6 100644 --- a/BLACS/SRC/itrbs2d_.c +++ b/BLACS/SRC/itrbs2d_.c @@ -206,3 +206,24 @@ F_VOID_FUNC itrbs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, } else BI_UpdateBuffs(bp); } /* end itrbs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC itrbs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda) +{ + itrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC ITRBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda) +{ + itrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC ITRBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, Int *A, Int *lda) +{ + itrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/itrrv2d_.c b/BLACS/SRC/itrrv2d_.c index 44cd74e5..59b1afa0 100644 --- a/BLACS/SRC/itrrv2d_.c +++ b/BLACS/SRC/itrrv2d_.c @@ -100,3 +100,24 @@ F_VOID_FUNC itrrv2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC itrrv2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + itrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ITRRV2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + itrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ITRRV2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rsrc, Int *csrc) +{ + itrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/itrsd2d_.c b/BLACS/SRC/itrsd2d_.c index e1d10055..f2a7f1b5 100644 --- a/BLACS/SRC/itrsd2d_.c +++ b/BLACS/SRC/itrsd2d_.c @@ -112,3 +112,24 @@ F_VOID_FUNC itrsd2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, BI_UpdateBuffs(bp); #endif } /* end of itrsd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC itrsd2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + itrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ITRSD2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + itrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ITRSD2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + Int *A, Int *lda, Int *rdest, Int *cdest) +{ + itrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/sgamn2d_.c b/BLACS/SRC/sgamn2d_.c index 1aed4ed6..4840bc09 100644 --- a/BLACS/SRC/sgamn2d_.c +++ b/BLACS/SRC/sgamn2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC sgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgamn2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC SGAMN2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC SGAMN2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/sgamx2d_.c b/BLACS/SRC/sgamx2d_.c index 54899330..22aa82a3 100644 --- a/BLACS/SRC/sgamx2d_.c +++ b/BLACS/SRC/sgamx2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC sgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, (float *)bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgamx2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC SGAMX2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC SGAMX2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + sgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/sgebr2d_.c b/BLACS/SRC/sgebr2d_.c index c26dd8c3..e8262d7d 100644 --- a/BLACS/SRC/sgebr2d_.c +++ b/BLACS/SRC/sgebr2d_.c @@ -224,3 +224,24 @@ F_VOID_FUNC sgebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgebr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + sgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC SGEBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + sgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC SGEBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + sgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/sgebs2d_.c b/BLACS/SRC/sgebs2d_.c index af647414..dc3d6ed8 100644 --- a/BLACS/SRC/sgebs2d_.c +++ b/BLACS/SRC/sgebs2d_.c @@ -193,3 +193,24 @@ F_VOID_FUNC sgebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, } else BI_UpdateBuffs(bp); } /* end sgebs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgebs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + sgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC SGEBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + sgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC SGEBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda) +{ + sgebs2d_( ConTxt, scope, top, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/sgerv2d_.c b/BLACS/SRC/sgerv2d_.c index 7e016e2f..41c32e27 100644 --- a/BLACS/SRC/sgerv2d_.c +++ b/BLACS/SRC/sgerv2d_.c @@ -80,3 +80,24 @@ F_VOID_FUNC sgerv2d_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgerv2d(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + sgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC SGERV2D(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + sgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC SGERV2D_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + sgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/sgesd2d_.c b/BLACS/SRC/sgesd2d_.c index 4cfa6122..935ebc95 100644 --- a/BLACS/SRC/sgesd2d_.c +++ b/BLACS/SRC/sgesd2d_.c @@ -93,3 +93,24 @@ F_VOID_FUNC sgesd2d_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, BI_UpdateBuffs(bp); #endif } /* end of sgesd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgesd2d(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + sgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC SGESD2D(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + sgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC SGESD2D_(Int *ConTxt, Int *m, Int *n, float *A, Int *lda, + Int *rdest, Int *cdest) +{ + sgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/sgsum2d_.c b/BLACS/SRC/sgsum2d_.c index c9b8e8d1..0ae2bb20 100644 --- a/BLACS/SRC/sgsum2d_.c +++ b/BLACS/SRC/sgsum2d_.c @@ -233,3 +233,24 @@ F_VOID_FUNC sgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, BI_BuffIsFree(bp, 1); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC sgsum2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + sgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC SGSUM2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + sgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC SGSUM2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + sgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/strbr2d_.c b/BLACS/SRC/strbr2d_.c index 43f3b3e3..39b69e08 100644 --- a/BLACS/SRC/strbr2d_.c +++ b/BLACS/SRC/strbr2d_.c @@ -222,3 +222,27 @@ F_VOID_FUNC strbr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, BI_UpdateBuffs(bp); #endif } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC strbr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + strbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC STRBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + strbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC STRBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda, + Int *rsrc, Int *csrc) +{ + strbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/strbs2d_.c b/BLACS/SRC/strbs2d_.c index 77d072ae..e3090be0 100644 --- a/BLACS/SRC/strbs2d_.c +++ b/BLACS/SRC/strbs2d_.c @@ -204,3 +204,24 @@ F_VOID_FUNC strbs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, } else BI_UpdateBuffs(bp); } /* end strbs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC strbs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + strbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC STRBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + strbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC STRBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, float *A, Int *lda) +{ + strbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/strrv2d_.c b/BLACS/SRC/strrv2d_.c index 4f24d86f..9d234eb1 100644 --- a/BLACS/SRC/strrv2d_.c +++ b/BLACS/SRC/strrv2d_.c @@ -99,3 +99,24 @@ F_VOID_FUNC strrv2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC strrv2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + strrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC STRRV2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + strrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC STRRV2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rsrc, Int *csrc) +{ + strrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/strsd2d_.c b/BLACS/SRC/strsd2d_.c index 3b566fbf..05038ca3 100644 --- a/BLACS/SRC/strsd2d_.c +++ b/BLACS/SRC/strsd2d_.c @@ -111,3 +111,24 @@ F_VOID_FUNC strsd2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, BI_UpdateBuffs(bp); #endif } /* end of strsd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC strsd2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + strsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC STRSD2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + strsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC STRSD2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + float *A, Int *lda, Int *rdest, Int *cdest) +{ + strsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/zgamn2d_.c b/BLACS/SRC/zgamn2d_.c index d12ba95f..d1a82496 100644 --- a/BLACS/SRC/zgamn2d_.c +++ b/BLACS/SRC/zgamn2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC zgamn2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgamn2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC ZGAMN2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC ZGAMN2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamn2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/zgamx2d_.c b/BLACS/SRC/zgamx2d_.c index 8d01c7ee..c8bc35b4 100644 --- a/BLACS/SRC/zgamx2d_.c +++ b/BLACS/SRC/zgamx2d_.c @@ -373,3 +373,27 @@ F_VOID_FUNC zgamx2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (bp != &BI_AuxBuff) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgamx2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC ZGAMX2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} + +F_VOID_FUNC ZGAMX2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rA, Int *cA, Int *ldia, + Int *rdest, Int *cdest) +{ + zgamx2d_( ConTxt, scope, top, m, n, A, lda, rA, cA, ldia, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/zgebr2d_.c b/BLACS/SRC/zgebr2d_.c index badb13b3..292eaae2 100644 --- a/BLACS/SRC/zgebr2d_.c +++ b/BLACS/SRC/zgebr2d_.c @@ -224,3 +224,24 @@ F_VOID_FUNC zgebr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgebr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + zgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZGEBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + zgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZGEBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + zgebr2d_( ConTxt, scope, top, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/zgebs2d_.c b/BLACS/SRC/zgebs2d_.c index 9619a872..0a8ea5ca 100644 --- a/BLACS/SRC/zgebs2d_.c +++ b/BLACS/SRC/zgebs2d_.c @@ -193,3 +193,24 @@ F_VOID_FUNC zgebs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, } else BI_UpdateBuffs(bp); } /* end zgebs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgebs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + zgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC ZGEBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + zgebs2d_( ConTxt, scope, top, m, n, A, lda); +} + +F_VOID_FUNC ZGEBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda) +{ + zgebs2d_( ConTxt, scope, top, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/zgerv2d_.c b/BLACS/SRC/zgerv2d_.c index fd6a9896..3c917ddd 100644 --- a/BLACS/SRC/zgerv2d_.c +++ b/BLACS/SRC/zgerv2d_.c @@ -80,3 +80,24 @@ F_VOID_FUNC zgerv2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgerv2d(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + zgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZGERV2D(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + zgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZGERV2D_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + zgerv2d_( ConTxt, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/zgesd2d_.c b/BLACS/SRC/zgesd2d_.c index b9a8a5c5..c7ceb55c 100644 --- a/BLACS/SRC/zgesd2d_.c +++ b/BLACS/SRC/zgesd2d_.c @@ -93,3 +93,24 @@ F_VOID_FUNC zgesd2d_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, BI_UpdateBuffs(bp); #endif } /* end of zgesd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgesd2d(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + zgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZGESD2D(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + zgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZGESD2D_(Int *ConTxt, Int *m, Int *n, double *A, Int *lda, + Int *rdest, Int *cdest) +{ + zgesd2d_( ConTxt, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/zgsum2d_.c b/BLACS/SRC/zgsum2d_.c index 18bad88b..439052ae 100644 --- a/BLACS/SRC/zgsum2d_.c +++ b/BLACS/SRC/zgsum2d_.c @@ -238,3 +238,24 @@ F_VOID_FUNC zgsum2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, BI_BuffIsFree(bp, 1); } } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC zgsum2d(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + zgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZGSUM2D(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + zgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZGSUM2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + zgsum2d_( ConTxt, scope, top, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/SRC/ztrbr2d_.c b/BLACS/SRC/ztrbr2d_.c index bb866a4c..d4126faa 100644 --- a/BLACS/SRC/ztrbr2d_.c +++ b/BLACS/SRC/ztrbr2d_.c @@ -222,3 +222,27 @@ F_VOID_FUNC ztrbr2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, BI_UpdateBuffs(bp); #endif } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ztrbr2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ztrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZTRBR2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ztrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZTRBR2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda, + Int *rsrc, Int *csrc) +{ + ztrbr2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/ztrbs2d_.c b/BLACS/SRC/ztrbs2d_.c index 25f7fc1b..3c7bb572 100644 --- a/BLACS/SRC/ztrbs2d_.c +++ b/BLACS/SRC/ztrbs2d_.c @@ -204,3 +204,24 @@ F_VOID_FUNC ztrbs2d_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, } else BI_UpdateBuffs(bp); } /* end ztrbs2d_ */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ztrbs2d(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + ztrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC ZTRBS2D(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + ztrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} + +F_VOID_FUNC ZTRBS2D_(Int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, + F_CHAR diag, Int *m, Int *n, double *A, Int *lda) +{ + ztrbs2d_( ConTxt, scope, top, uplo, diag, m, n, A, lda); +} +#endif diff --git a/BLACS/SRC/ztrrv2d_.c b/BLACS/SRC/ztrrv2d_.c index f1c04014..41e6b0f9 100644 --- a/BLACS/SRC/ztrrv2d_.c +++ b/BLACS/SRC/ztrrv2d_.c @@ -99,3 +99,24 @@ F_VOID_FUNC ztrrv2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, ierr=BI_MPI_TYPE_FREE(&MatTyp); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ztrrv2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + ztrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZTRRV2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + ztrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} + +F_VOID_FUNC ZTRRV2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rsrc, Int *csrc) +{ + ztrrv2d_( ConTxt, uplo, diag, m, n, A, lda, rsrc, csrc); +} +#endif diff --git a/BLACS/SRC/ztrsd2d_.c b/BLACS/SRC/ztrsd2d_.c index 10fd7bb3..2787a517 100644 --- a/BLACS/SRC/ztrsd2d_.c +++ b/BLACS/SRC/ztrsd2d_.c @@ -111,3 +111,24 @@ F_VOID_FUNC ztrsd2d_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, BI_UpdateBuffs(bp); #endif } /* end of ztrsd2d */ +#if (INTFACE != C_CALL) +/** Wrapper functions to support Fortran to C calls **/ + +F_VOID_FUNC ztrsd2d(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + ztrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZTRSD2D(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + ztrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} + +F_VOID_FUNC ZTRSD2D_(Int *ConTxt, F_CHAR uplo, F_CHAR diag, Int *m, Int *n, + double *A, Int *lda, Int *rdest, Int *cdest) +{ + ztrsd2d_( ConTxt, uplo, diag, m, n, A, lda, rdest, cdest); +} +#endif diff --git a/BLACS/TESTING/CMakeLists.txt b/BLACS/TESTING/CMakeLists.txt index 29c0303d..20e49bf3 100644 --- a/BLACS/TESTING/CMakeLists.txt +++ b/BLACS/TESTING/CMakeLists.txt @@ -12,11 +12,6 @@ target_link_libraries(xFbtest scalapack) set(CTestObj Cbt.c) -set_property( - SOURCE Cbt.c - APPEND PROPERTY COMPILE_DEFINITIONS BTCINTFACE - ) - if (UNIX) add_executable(xCbtest ${CTestObj} ${FTestObj}) target_link_libraries(xCbtest scalapack) diff --git a/FRAMEWORK/SL_Context.c b/FRAMEWORK/SL_Context.c index e4de920f..7a571aa0 100644 --- a/FRAMEWORK/SL_Context.c +++ b/FRAMEWORK/SL_Context.c @@ -196,9 +196,21 @@ void aocl_scalapack_init_() { scalapack_pthread_once(&once_init, scalapack_context_init); } + +/** Wrapper Functions for 'aocl_scalapack_init_' + To enable Fortran to C calls +**/ +void aocl_scalapack_init() +{ + aocl_scalapack_init_(); +} void AOCL_SCALAPACK_INIT() { - scalapack_pthread_once(&once_init, scalapack_context_init); + aocl_scalapack_init_(); +} +void AOCL_SCALAPACK_INIT_() +{ + aocl_scalapack_init_(); } void aocl_scalapack_finalize(void) diff --git a/FRAMEWORK/SL_Context.h b/FRAMEWORK/SL_Context.h index 8eaee0c6..8ab7770c 100644 --- a/FRAMEWORK/SL_Context.h +++ b/FRAMEWORK/SL_Context.h @@ -95,14 +95,16 @@ typedef aocl_scalapack_global_context AOCL_SCALAPACK_GLOBAL_CONTEXT; * context * * \retval none. - -void aocl_scalapack_init(); */ +*/ void aocl_scalapack_init_(); +/****************************************************************************************** + * \brief Wrapper functions for 'aocl_scalapack_init_' + to enable F2C calls. + + *****************************************************************************************/ +void aocl_scalapack_init(); void AOCL_SCALAPACK_INIT(); -/* Alias Declarations to enable F2C calls -#define aocl_scalapack_init_ aocl_scalapack_init -#define AOCL_SCALAPACK_INIT_ aocl_scalapack_init -#define AOCL_SCALAPACK_INIT aocl_scalapack_init*/ +void AOCL_SCALAPACK_INIT_(); /*! \ingroup aux_module * \brief Deallocate and clean all initalized buffers diff --git a/SRC/aocl_dtl_trace_entry.c b/SRC/aocl_dtl_trace_entry.c index d3c5be8a..fb2ee5f4 100644 --- a/SRC/aocl_dtl_trace_entry.c +++ b/SRC/aocl_dtl_trace_entry.c @@ -28,6 +28,28 @@ void aocl_sl_dtl_log_entry_( const char *filename, const char *function_name, buffer); } +/** + Wrapper functions for 'aocl_sl_dtl_log_entry_' function + to enable Fortran to C calls. +**/ +void aocl_sl_dtl_log_entry( const char *filename, const char *function_name, + unsigned int *line_number, const char *buffer ) +{ + aocl_sl_dtl_log_entry_(filename, function_name, line_number, buffer); +} + +void AOCL_SL_DTL_LOG_ENTRY( const char *filename, const char *function_name, + unsigned int *line_number, const char *buffer ) +{ + aocl_sl_dtl_log_entry_(filename, function_name, line_number, buffer); +} + +void AOCL_SL_DTL_LOG_ENTRY_( const char *filename, const char *function_name, + unsigned int *line_number, const char *buffer ) +{ + aocl_sl_dtl_log_entry_(filename, function_name, line_number, buffer); +} + void aocl_sl_dtl_trace_entry_( const char * fileName, unsigned int * lineNumber, const char * message ) { @@ -71,4 +93,26 @@ void aocl_sl_dtl_trace_entry_( const char * fileName, unsigned int * lineNumber, return; } +/** + Wrapper functions for 'aocl_sl_dtl_trace_entry_' function + to enable Fortran to C calls. +**/ + +void aocl_sl_dtl_trace_entry( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_entry_( fileName, lineNumber, message ); +} + +void AOCL_SL_DTL_TRACE_ENTRY( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_entry_( fileName, lineNumber, message ); +} + +void AOCL_SL_DTL_TRACE_ENTRY_( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_entry_( fileName, lineNumber, message ); +} diff --git a/SRC/aocl_dtl_trace_exit.c b/SRC/aocl_dtl_trace_exit.c index aaaa7afe..cba2b9e1 100644 --- a/SRC/aocl_dtl_trace_exit.c +++ b/SRC/aocl_dtl_trace_exit.c @@ -19,7 +19,7 @@ void aocl_sl_dtl_trace_exit_( const char * fileName, unsigned int * lineNumber, const char * message ) { -#if AOCL_DTL_TRACE_ENABLE +#if AOCL_DTL_TRACE_ENABLE char * funcName = NULL; Int i, fnlen, cval; @@ -29,7 +29,7 @@ void aocl_sl_dtl_trace_exit_( const char * fileName, unsigned int * lineNumber, if( funcName != NULL) { strncpy( funcName, fileName, fnlen ); - + funcName[ fnlen - 2 ] = '\0'; i = 0; @@ -47,7 +47,7 @@ void aocl_sl_dtl_trace_exit_( const char * fileName, unsigned int * lineNumber, DTL_Trace( AOCL_DTL_TRACE_LEVEL, TRACE_TYPE_FEXIT, fileName, funcName, *lineNumber, NULL ); - + free( funcName ); } else @@ -58,5 +58,24 @@ void aocl_sl_dtl_trace_exit_( const char * fileName, unsigned int * lineNumber, #endif return; } +/** + Wrapper functions for 'aocl_sl_dtl_trace_exit_' function + to enable Fortran to C calls. +**/ +void aocl_sl_dtl_trace_exit( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_exit_( fileName, lineNumber, message ); +} +void AOCL_SL_DTL_TRACE_EXIT( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_exit_( fileName, lineNumber, message ); +} +void AOCL_SL_DTL_TRACE_EXIT_( const char * fileName, unsigned int * lineNumber, + const char * message ) +{ + aocl_sl_dtl_trace_exit_( fileName, lineNumber, message ); +} diff --git a/SRC/aocl_scalapack_progress.c b/SRC/aocl_scalapack_progress.c index fb149394..cb62c487 100644 --- a/SRC/aocl_scalapack_progress.c +++ b/SRC/aocl_scalapack_progress.c @@ -15,9 +15,23 @@ void aocl_scalapack_set_progress( aocl_scalapack_progress_callback func ) aocl_scalapack_progress_ptr_ = func; } +/** + Wrapper functions for 'aocl_scalapack_set_progress' function + to enable Fortran to C calls. +**/ void aocl_scalapack_set_progress_( aocl_scalapack_progress_callback func ) { - aocl_scalapack_progress_ptr_ = func; + aocl_scalapack_set_progress(func); +} + +void AOCL_SCALAPACK_SET_PROGRESS_( aocl_scalapack_progress_callback func ) +{ + aocl_scalapack_set_progress(func); +} + +void AOCL_SCALAPACK_SET_PROGRESS( aocl_scalapack_progress_callback func ) +{ + aocl_scalapack_set_progress(func); } integer aocl_scalapack_progress_(const char* const api, const integer *lenapi, const integer* progress, @@ -30,13 +44,24 @@ integer aocl_scalapack_progress_(const char* const api, const integer *lenapi, c return ret; } +/** + Wrapper functions for 'aocl_scalapack_progress_' function + to enable Fortran to C calls. +**/ +integer aocl_scalapack_progress(const char* const api, const integer* lenapi, const integer* progress, + const integer* current_process, const integer* total_processes) +{ + return aocl_scalapack_progress_(api, lenapi, progress, current_process, total_processes); +} + integer AOCL_SCALAPACK_PROGRESS(const char* const api, const integer* lenapi, const integer* progress, const integer* current_process, const integer* total_processes) { - integer ret = 0; - if (aocl_scalapack_progress_ptr_ != NULL) { - ret = aocl_scalapack_progress_ptr_(api, lenapi, progress, current_process, total_processes); - } + return aocl_scalapack_progress_(api, lenapi, progress, current_process, total_processes); +} - return ret; +integer AOCL_SCALAPACK_PROGRESS_(const char* const api, const integer* lenapi, const integer* progress, + const integer* current_process, const integer* total_processes) +{ + return aocl_scalapack_progress_(api, lenapi, progress, current_process, total_processes); } diff --git a/SRC/aocl_scalapack_progress.h b/SRC/aocl_scalapack_progress.h index 613ae21e..87d797ed 100644 --- a/SRC/aocl_scalapack_progress.h +++ b/SRC/aocl_scalapack_progress.h @@ -29,6 +29,7 @@ const integer *current_process, const integer *total_processes ); +aocl_scalapack_progress_callback aocl_scalapack_progress_ptr_; integer aocl_scalapack_progress_( const char* const api, @@ -37,6 +38,16 @@ integer aocl_scalapack_progress_( const integer* current_process, const integer* total_processes ); +/** Wrapper function declarations for + 'aocl_scalapack_progress_' function +**/ +integer aocl_scalapack_progress( + const char* const api, + const integer* lenapi, + const integer* progress, + const integer* current_process, + const integer* total_processes +); integer AOCL_SCALAPACK_PROGRESS( const char* const api, const integer* lenapi, @@ -44,10 +55,20 @@ integer AOCL_SCALAPACK_PROGRESS( const integer* current_process, const integer* total_processes ); - -aocl_scalapack_progress_callback aocl_scalapack_progress_ptr_; +integer AOCL_SCALAPACK_PROGRESS_( + const char* const api, + const integer* lenapi, + const integer* progress, + const integer* current_process, + const integer* total_processes +); void aocl_scalapack_set_progress( aocl_scalapack_progress_callback func ); +/** Wrapper function declarations for + 'aocl_scalapack_set_progress' function +**/ void aocl_scalapack_set_progress_( aocl_scalapack_progress_callback func ); +void AOCL_SCALAPACK_SET_PROGRESS( aocl_scalapack_progress_callback func ); +void AOCL_SCALAPACK_SET_PROGRESS_( aocl_scalapack_progress_callback func ); #endif // _AOCL_SCALAPACK_PROGRESS_ diff --git a/SRC/get_aocl_scalapack_version.c b/SRC/get_aocl_scalapack_version.c index 78e0bba7..c7d7cc8d 100644 --- a/SRC/get_aocl_scalapack_version.c +++ b/SRC/get_aocl_scalapack_version.c @@ -57,3 +57,22 @@ void get_aocl_scalapack_version_( version ) return; } +/** + Wrapper functions for 'get_aocl_scalapack_version_' function + to enable Fortran to C calls. +**/ +void get_aocl_scalapack_version( char * version ) +{ + get_aocl_scalapack_version_( version ); +} + +void GET_AOCL_SCALAPACK_VERSION( char * version ) +{ + get_aocl_scalapack_version_( version ); +} + +void GET_AOCL_SCALAPACK_VERSION_( char * version ) +{ + get_aocl_scalapack_version_( version ); +} + diff --git a/SRC/pxsyevx.h b/SRC/pxsyevx.h index b0487052..2b430c05 100644 --- a/SRC/pxsyevx.h +++ b/SRC/pxsyevx.h @@ -64,11 +64,6 @@ #define pslachkieee_ PSLACHKIEEE #define pslaiect_ PSLAIECT -#define get_aocl_scalapack_version_ GET_AOCL_SCALAPACK_VERSION -#define aocl_sl_dtl_trace_entry_ AOCL_SL_DTL_TRACE_ENTRY -#define aocl_sl_dtl_trace_exit_ AOCL_SL_DTL_TRACE_EXIT -#define aocl_sl_dtl_log_entry_ AOCL_SL_DTL_LOG_ENTRY -#define aocl_dtl_log_exit_ AOCL_DTL_LOG_EXIT #endif #if (F77_CALL_C == NOCHANGE) @@ -89,12 +84,4 @@ #define pslachkieee_ pslachkieee #define pslaiect_ pslaiect -#define get_aocl_scalapack_version_ get_aocl_scalapack_version -#define aocl_scalapack_progress_ aocl_scalapack_progress -#define aocl_dtl_trace_entry_ aocl_dtl_trace_entry -#define aocl_dtl_trace_exit_ aocl_dtl_trace_exit -#define aocl_dtl_log_entry_ aocl_dtl_log_entry -#define aocl_dtl_log_exit_ aocl_dtl_log_exit -#define aocl_scalapack_init_ aocl_scalapack_init - #endif From dde8c93e9d68535e50f263e006da9ee830d2d157 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Thu, 10 Aug 2023 10:26:32 +0530 Subject: [PATCH 10/29] aocl-scaLAPACK: Version string updated to 4.1.1 Change-Id: Iecd982f356603b7c25c5a6fbdb91e3f5ea40d800 --- SRC/get_aocl_scalapack_version.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/SRC/get_aocl_scalapack_version.c b/SRC/get_aocl_scalapack_version.c index c7d7cc8d..26c0f3ef 100644 --- a/SRC/get_aocl_scalapack_version.c +++ b/SRC/get_aocl_scalapack_version.c @@ -27,7 +27,7 @@ void get_aocl_scalapack_version_( version ) #endif { #ifdef AOCL_SCALAPACK_VERSION - char slmainversion[] = "AOCL-ScaLAPACK 4.0.1 "; + char slmainversion[] = "AOCL-ScaLAPACK 4.1.1 "; char slversion[1000]; char scalapackversion[] = ", supports ScaLAPACK 2.2.0"; int length, i; @@ -52,7 +52,7 @@ void get_aocl_scalapack_version_( version ) slversion[length] = '\0'; strcpy(version, slversion); #else - strcpy(version, "AOCL-ScaLAPACK 4.0.1, supports ScaLAPACK 2.2.0"); + strcpy(version, "AOCL-ScaLAPACK 4.1.1, supports ScaLAPACK 2.2.0"); #endif return; } From 444fefb1bf935510149a95c66247a3a6b4760379 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Tue, 6 Jun 2023 17:42:19 +0530 Subject: [PATCH 11/29] Log buffer simplification. 1) Removed log buffer declaration separately for each double data type API. 2) Log buffer allocated commonly for all the APIs. Thus avoids unnecesary use of stack. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3505] Change-Id: I3e85bffe06cd1b14b635f7768afa18ccd5924fb0 --- CMakeLists.txt | 2 +- FRAMEWORK/SL_Context_fortran_include.h | 4 +- FRAMEWORK/SL_Context_module.f | 12 +++- SRC/pddbsv.f | 7 +- SRC/pddbtrf.f | 7 +- SRC/pddbtrs.f | 7 +- SRC/pddbtrsv.f | 7 +- SRC/pddtsv.f | 7 +- SRC/pddttrf.f | 7 +- SRC/pddttrs.f | 7 +- SRC/pddttrsv.f | 7 +- SRC/pdgbsv.f | 7 +- SRC/pdgbtrf.f | 7 +- SRC/pdgbtrs.f | 7 +- SRC/pdgebal.f | 7 +- SRC/pdgebd2.f | 7 +- SRC/pdgebrd.f | 7 +- SRC/pdgecon.f | 7 +- SRC/pdgeequ.f | 7 +- SRC/pdgehd2.f | 7 +- SRC/pdgehrd.f | 7 +- SRC/pdgelq2.f | 7 +- SRC/pdgelqf.f | 7 +- SRC/pdgels.f | 7 +- SRC/pdgeql2.f | 7 +- SRC/pdgeqlf.f | 7 +- SRC/pdgeqpf.f | 7 +- SRC/pdgeqr2.f | 7 +- SRC/pdgeqrf.f | 7 +- SRC/pdgerfs.f | 7 +- SRC/pdgerq2.f | 7 +- SRC/pdgerqf.f | 7 +- SRC/pdgesv.f | 7 +- SRC/pdgesvd.f | 7 +- SRC/pdgesvx.f | 7 +- SRC/pdgetf2.f | 7 +- SRC/pdgetf2K.f | 7 +- SRC/pdgetf2_comm.f | 7 +- SRC/pdgetrf.f | 6 +- SRC/pdgetri.f | 7 +- SRC/pdgetrs.f | 7 +- SRC/pdggqrf.f | 7 +- SRC/pdggrqf.f | 7 +- SRC/pdhseqr.f | 7 +- SRC/pdlabad.f | 12 ++-- SRC/pdlabrd.f | 7 +- SRC/pdlacon.f | 7 +- SRC/pdlaconsb.f | 7 +- SRC/pdlacp2.f | 7 +- SRC/pdlacp3.f | 7 +- SRC/pdlacpy.f | 15 +++-- SRC/pdlaed0.f | 7 +- SRC/pdlaed1.f | 7 +- SRC/pdlaed2.f | 7 +- SRC/pdlaed3.f | 7 +- SRC/pdlaedz.f | 7 +- SRC/pdlaevswp.f | 7 +- SRC/pdlahqr.f | 7 +- SRC/pdlahrd.f | 7 +- SRC/pdlamch.f | 13 ++-- SRC/pdlamr1d.f | 7 +- SRC/pdlamve.f | 7 +- SRC/pdlange.f | 7 +- SRC/pdlanhs.f | 7 +- SRC/pdlansy.f | 7 +- SRC/pdlantr.f | 7 +- SRC/pdlapiv.f | 7 +- SRC/pdlapv2.f | 7 +- SRC/pdlaqge.f | 7 +- SRC/pdlaqr0.f | 7 +- SRC/pdlaqr1.f | 7 +- SRC/pdlaqr2.f | 7 +- SRC/pdlaqr3.f | 7 +- SRC/pdlaqr4.f | 7 +- SRC/pdlaqr5.f | 7 +- SRC/pdlaqsy.f | 7 +- SRC/pdlared1d.f | 7 +- SRC/pdlared2d.f | 7 +- SRC/pdlarf.f | 7 +- SRC/pdlarfb.f | 7 +- SRC/pdlarfg.f | 7 +- SRC/pdlarft.f | 7 +- SRC/pdlarz.f | 7 +- SRC/pdlarzb.f | 7 +- SRC/pdlarzt.f | 7 +- SRC/pdlascl.f | 7 +- SRC/pdlase2.f | 7 +- SRC/pdlaset.f | 15 +++-- SRC/pdlasmsub.f | 7 +- SRC/pdlasrt.f | 7 +- SRC/pdlassq.f | 7 +- SRC/pdlaswp.f | 7 +- SRC/pdlatra.f | 7 +- SRC/pdlatrd.f | 7 +- SRC/pdlatrs.f | 7 +- SRC/pdlatrz.f | 7 +- SRC/pdlauu2.f | 7 +- SRC/pdlauum.f | 15 +++-- SRC/pdlawil.f | 7 +- SRC/pdorg2l.f | 7 +- SRC/pdorg2r.f | 7 +- SRC/pdorgl2.f | 7 +- SRC/pdorglq.f | 7 +- SRC/pdorgql.f | 7 +- SRC/pdorgqr.f | 7 +- SRC/pdorgr2.f | 7 +- SRC/pdorgrq.f | 7 +- SRC/pdorm2l.f | 7 +- SRC/pdorm2r.f | 7 +- SRC/pdormbr.f | 7 +- SRC/pdormhr.f | 7 +- SRC/pdorml2.f | 7 +- SRC/pdormlq.f | 7 +- SRC/pdormql.f | 7 +- SRC/pdormqr.f | 7 +- SRC/pdormr2.f | 7 +- SRC/pdormr3.f | 7 +- SRC/pdormrq.f | 7 +- SRC/pdormrz.f | 7 +- SRC/pdormtr.f | 7 +- SRC/pdpbsv.f | 7 +- SRC/pdpbtrf.f | 7 +- SRC/pdpbtrs.f | 7 +- SRC/pdpbtrsv.f | 7 +- SRC/pdpocon.f | 7 +- SRC/pdpoequ.f | 7 +- SRC/pdporfs.f | 7 +- SRC/pdposv.f | 7 +- SRC/pdposvx.f | 7 +- SRC/pdpotf2.f | 7 +- SRC/pdpotrf.f | 7 +- SRC/pdpotri.f | 7 +- SRC/pdpotrs.f | 7 +- SRC/pdptsv.f | 7 +- SRC/pdpttrf.f | 7 +- SRC/pdpttrs.f | 7 +- SRC/pdpttrsv.f | 7 +- SRC/pdrot.f | 7 +- SRC/pdrscl.f | 7 +- SRC/pdstedc.f | 7 +- SRC/pdstein.f | 7 +- SRC/pdsyev.f | 7 +- SRC/pdsyevd.f | 7 +- SRC/pdsyevr.f | 7 +- SRC/pdsyevx.f | 7 +- SRC/pdsygs2.f | 7 +- SRC/pdsygst.f | 7 +- SRC/pdsygvx.f | 7 +- SRC/pdsyngst.f | 7 +- SRC/pdsyntrd.f | 7 +- SRC/pdsytd2.f | 7 +- SRC/pdsytrd.f | 7 +- SRC/pdsyttrd.f | 7 +- SRC/pdtrcon.f | 7 +- SRC/pdtrord.f | 91 ++++++++++++-------------- SRC/pdtrrfs.f | 7 +- SRC/pdtrsen.f | 7 +- SRC/pdtrti2.f | 7 +- SRC/pdtrtri.f | 7 +- SRC/pdtrtrs.f | 7 +- SRC/pdtzrzf.f | 7 +- SRC/pdzsum1.f | 7 +- 162 files changed, 255 insertions(+), 994 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 410bb828..cb3f9416 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -47,7 +47,7 @@ if (WIN32 AND CMAKE_Fortran_COMPILER_ID MATCHES "Intel") endif() set(CMAKE_ICC_FLAGS " ") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp" ) +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -fopenmp" ) # set compile flags to enable address sanitizer (ASAN) tests if(ENABLE_ASAN_TESTS) diff --git a/FRAMEWORK/SL_Context_fortran_include.h b/FRAMEWORK/SL_Context_fortran_include.h index a37477fe..e4de8007 100644 --- a/FRAMEWORK/SL_Context_fortran_include.h +++ b/FRAMEWORK/SL_Context_fortran_include.h @@ -29,13 +29,13 @@ #define AOCL_DTL_TRACE_ENTRY_F CALL SL_DTL_TRACE_ENTRY_F(__FILE__, __LINE__, ' ') #define AOCL_DTL_TRACE_EXIT_F CALL SL_DTL_TRACE_EXIT_F (__FILE__, __LINE__, ' ') -#define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY(__FILE__, "", __LINE__, BUFFER ) +#define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY(__FILE__, "", __LINE__, LOG_BUF ) #define aocl_scalapack_init_ AOCL_SCALAPACK_INIT #else #define AOCL_DTL_TRACE_ENTRY_F CALL SL_DTL_TRACE_ENTRY_F(FILE_NAME, __LINE__, ' ') #define AOCL_DTL_TRACE_EXIT_F CALL SL_DTL_TRACE_EXIT_F (FILE_NAME, __LINE__, ' ') -#define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY( FILE_NAME// C_NULL_CHAR, FUNCTION_NAME// C_NULL_CHAR, __LINE__, BUFFER ) +#define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY( FILE_NAME// C_NULL_CHAR, FUNCTION_NAME// C_NULL_CHAR, __LINE__, LOG_BUF ) #endif #endif /* SL_CONTEXT_FORTRAN_H */ diff --git a/FRAMEWORK/SL_Context_module.f b/FRAMEWORK/SL_Context_module.f index f0b8e5b7..ed77c0cc 100644 --- a/FRAMEWORK/SL_Context_module.f +++ b/FRAMEWORK/SL_Context_module.f @@ -32,7 +32,17 @@ MODULE LINK_TO_C_GLOBALS INTEGER(C_INT)::NUM_PROCS END TYPE TYPE(AOCL_SCALAPACK_GLOBAL_CONTEXT),BIND(C)::SCALAPACK_CONTEXT - +* .. +* .. LOG variables declaration .. +* .. LOG BUFFER size is large enough to capture the scalar argument +* .. values.. + CHARACTER LOG_BUF*1024 +!$omp threadprivate(LOG_BUF) +* .. +* .. Variable to hold the 'End of string' character in C language + CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR +* .. +* .. END MODULE LINK_TO_C_GLOBALS * diff --git a/SRC/pddbsv.f b/SRC/pddbsv.f index d4709cda..f0dbab2a 100644 --- a/SRC/pddbsv.f +++ b/SRC/pddbsv.f @@ -389,12 +389,7 @@ SUBROUTINE PDDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDDBTRF, PDDBTRS, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -441,7 +436,7 @@ SUBROUTINE PDDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) BWL, BWU, IB, INFO, JA, LWORK, + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDDBSV inputs:,BWL:',I5,',BWU:',I5,',IB:',I5, diff --git a/SRC/pddbtrf.f b/SRC/pddbtrf.f index f23c8fa0..5e7d5d69 100644 --- a/SRC/pddbtrf.f +++ b/SRC/pddbtrf.f @@ -388,12 +388,7 @@ SUBROUTINE PDDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -443,7 +438,7 @@ SUBROUTINE PDDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) BWL, BWU, INFO, JA, LAF, LWORK, + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDDBTRF inputs:,BWL:',I5,',BWU:',I5,',INFO:',I5, $ ',JA:',I5,',LAF:',I5,',LWORK:',I5, diff --git a/SRC/pddbtrs.f b/SRC/pddbtrs.f index a966e7a4..1206df73 100644 --- a/SRC/pddbtrs.f +++ b/SRC/pddbtrs.f @@ -402,12 +402,7 @@ SUBROUTINE PDDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -482,7 +477,7 @@ SUBROUTINE PDDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, BWL, BWU, IB, INFO, JA, + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, JA, $ LAF, LWORK, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDDBTRS inputs:,TRANS:',A5,',BWL:',I5, diff --git a/SRC/pddbtrsv.f b/SRC/pddbtrsv.f index 89ab7d6c..2c5db81a 100644 --- a/SRC/pddbtrsv.f +++ b/SRC/pddbtrsv.f @@ -416,12 +416,7 @@ SUBROUTINE PDDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -501,7 +496,7 @@ SUBROUTINE PDDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, UPLO, BWL, BWU, IB, INFO, + WRITE(LOG_BUF,102) TRANS, UPLO, BWL, BWU, IB, INFO, $ JA, LAF, LWORK, N, NRHS, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDDBTRSV inputs:,TRANS:',A5,',UPLO:',A5, diff --git a/SRC/pddtsv.f b/SRC/pddtsv.f index 3bd85e50..da1e4c2e 100644 --- a/SRC/pddtsv.f +++ b/SRC/pddtsv.f @@ -399,12 +399,7 @@ SUBROUTINE PDDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDDTTRF, PDDTTRS, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -454,7 +449,7 @@ SUBROUTINE PDDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IB, INFO, JA, LWORK, N, NRHS, + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDDTSV inputs:,IB:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',N:',I5,',NRHS:',I5, diff --git a/SRC/pddttrf.f b/SRC/pddttrf.f index 0d524c2a..7d2b7ab7 100644 --- a/SRC/pddttrf.f +++ b/SRC/pddttrf.f @@ -398,12 +398,7 @@ SUBROUTINE PDDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -456,7 +451,7 @@ SUBROUTINE PDDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) INFO, JA, LAF, LWORK, N, NPROW, + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDDTTRF inputs:,INFO:',I5,',JA:',I5,',LAF:',I5, $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pddttrs.f b/SRC/pddttrs.f index bff166db..13534a13 100644 --- a/SRC/pddttrs.f +++ b/SRC/pddttrs.f @@ -417,12 +417,7 @@ SUBROUTINE PDDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -505,7 +500,7 @@ SUBROUTINE PDDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, IB, INFO, JA, LAF, LWORK, + WRITE(LOG_BUF,102) TRANS, IB, INFO, JA, LAF, LWORK, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDDTTRS inputs:,TRANS:',A5,',IB:',I5,',INFO:',I5, diff --git a/SRC/pddttrsv.f b/SRC/pddttrsv.f index 9d1ecebd..2ffe9f60 100644 --- a/SRC/pddttrsv.f +++ b/SRC/pddttrsv.f @@ -429,12 +429,7 @@ SUBROUTINE PDDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ICHAR, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -517,7 +512,7 @@ SUBROUTINE PDDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, UPLO, IB, INFO, JA, LAF, + WRITE(LOG_BUF,102) TRANS, UPLO, IB, INFO, JA, LAF, $ LWORK, N, NRHS, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDDTTRSV inputs:,TRANS:',A5,',UPLO:',A5, diff --git a/SRC/pdgbsv.f b/SRC/pdgbsv.f index ae8ccb36..93aebe82 100644 --- a/SRC/pdgbsv.f +++ b/SRC/pdgbsv.f @@ -394,12 +394,7 @@ SUBROUTINE PDGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * .. External Subroutines .. EXTERNAL PDGBTRF, PDGBTRS, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -446,7 +441,7 @@ SUBROUTINE PDGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) BWL, BWU, IB, INFO, JA, LWORK, + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDGBSV inputs:,BWL:',I5,',BWU:',I5,',IB:',I5, diff --git a/SRC/pdgbtrf.f b/SRC/pdgbtrf.f index c74c789c..01cbc07a 100644 --- a/SRC/pdgbtrf.f +++ b/SRC/pdgbtrf.f @@ -402,12 +402,7 @@ SUBROUTINE PDGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -453,7 +448,7 @@ SUBROUTINE PDGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) BWL, BWU, INFO, JA, LAF, LWORK, + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGBTRF inputs:,BWL:',I5,',BWU:',I5,',INFO:',I5, $ ',JA:',I5,',LAF:',I5,',LWORK:',I5, diff --git a/SRC/pdgbtrs.f b/SRC/pdgbtrs.f index 605c0ae8..bba8a1db 100644 --- a/SRC/pdgbtrs.f +++ b/SRC/pdgbtrs.f @@ -414,12 +414,7 @@ SUBROUTINE PDGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * .. Intrinsic Functions .. INTRINSIC ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -495,7 +490,7 @@ SUBROUTINE PDGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, BWL, BWU, IB, INFO, JA, + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, JA, $ LAF, LWORK, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDGBTRS inputs:,TRANS:',A5,',BWL:',I5, diff --git a/SRC/pdgebal.f b/SRC/pdgebal.f index 6e603a5b..0132e81a 100644 --- a/SRC/pdgebal.f +++ b/SRC/pdgebal.f @@ -213,12 +213,7 @@ SUBROUTINE PDGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -238,7 +233,7 @@ SUBROUTINE PDGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOB, IHI, ILO, INFO, N, NPROW, + WRITE(LOG_BUF,102) JOB, IHI, ILO, INFO, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEBAL inputs:,JOB:',A5,',IHI:',I5,',ILO:',I5, $ ',INFO:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdgebd2.f b/SRC/pdgebd2.f index cfd89173..b4f67e7a 100644 --- a/SRC/pdgebd2.f +++ b/SRC/pdgebd2.f @@ -272,12 +272,7 @@ SUBROUTINE PDGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -299,7 +294,7 @@ SUBROUTINE PDGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEBD2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgebrd.f b/SRC/pdgebrd.f index 8837fffe..2f189335 100644 --- a/SRC/pdgebrd.f +++ b/SRC/pdgebrd.f @@ -274,12 +274,7 @@ SUBROUTINE PDGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -301,7 +296,7 @@ SUBROUTINE PDGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEBRD inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgecon.f b/SRC/pdgecon.f index 3610d3db..dadfff4e 100644 --- a/SRC/pdgecon.f +++ b/SRC/pdgecon.f @@ -215,12 +215,7 @@ SUBROUTINE PDGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -242,7 +237,7 @@ SUBROUTINE PDGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) NORM, IA, INFO, JA, LIWORK, + WRITE(LOG_BUF,102) NORM, IA, INFO, JA, LIWORK, $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDGECON inputs:,NORM:',A5,',IA:',I5,',INFO:',I5, diff --git a/SRC/pdgeequ.f b/SRC/pdgeequ.f index 69adbbea..f2eeb1ea 100644 --- a/SRC/pdgeequ.f +++ b/SRC/pdgeequ.f @@ -192,12 +192,7 @@ SUBROUTINE PDGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -219,7 +214,7 @@ SUBROUTINE PDGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, M, N, AMAX, COLCND, + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, AMAX, COLCND, $ ROWCND, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDGEEQU inputs:,IA:',I5,',INFO:',I5,',JA:',I5, diff --git a/SRC/pdgehd2.f b/SRC/pdgehd2.f index 9be4d5e8..bba75f42 100644 --- a/SRC/pdgehd2.f +++ b/SRC/pdgehd2.f @@ -221,12 +221,7 @@ SUBROUTINE PDGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -248,7 +243,7 @@ SUBROUTINE PDGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IHI, ILO, INFO, JA, LWORK, + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEHD2 inputs:,IA:',I5,',IHI:',I5,',ILO:',I5, $ ',INFO:',I5,',JA:',I5,',LWORK:',I5, diff --git a/SRC/pdgehrd.f b/SRC/pdgehrd.f index 7edfcc01..51a8f82a 100644 --- a/SRC/pdgehrd.f +++ b/SRC/pdgehrd.f @@ -234,12 +234,7 @@ SUBROUTINE PDGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -261,7 +256,7 @@ SUBROUTINE PDGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IHI, ILO, INFO, JA, LWORK, + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEHRD inputs:,IA:',I5,',IHI:',I5,',ILO:',I5, $ ',INFO:',I5,',JA:',I5,',LWORK:',I5, diff --git a/SRC/pdgelq2.f b/SRC/pdgelq2.f index 2f2fd433..0a8674b0 100644 --- a/SRC/pdgelq2.f +++ b/SRC/pdgelq2.f @@ -194,12 +194,7 @@ SUBROUTINE PDGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -221,7 +216,7 @@ SUBROUTINE PDGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGELQ2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgelqf.f b/SRC/pdgelqf.f index 8cf57730..da11f0be 100644 --- a/SRC/pdgelqf.f +++ b/SRC/pdgelqf.f @@ -195,12 +195,7 @@ SUBROUTINE PDGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -222,7 +217,7 @@ SUBROUTINE PDGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGELQF inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgels.f b/SRC/pdgels.f index 41111b45..467cda78 100644 --- a/SRC/pdgels.f +++ b/SRC/pdgels.f @@ -270,12 +270,7 @@ SUBROUTINE PDGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -297,7 +292,7 @@ SUBROUTINE PDGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, IA, IB, INFO, JA, JB, + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, $ LWORK, M, N, NRHS, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDGELS inputs:,TRANS:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdgeql2.f b/SRC/pdgeql2.f index 84a8786d..0e89ec33 100644 --- a/SRC/pdgeql2.f +++ b/SRC/pdgeql2.f @@ -197,12 +197,7 @@ SUBROUTINE PDGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -224,7 +219,7 @@ SUBROUTINE PDGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEQL2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgeqlf.f b/SRC/pdgeqlf.f index 0804f900..e7068d1a 100644 --- a/SRC/pdgeqlf.f +++ b/SRC/pdgeqlf.f @@ -197,12 +197,7 @@ SUBROUTINE PDGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -224,7 +219,7 @@ SUBROUTINE PDGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEQLF inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgeqpf.f b/SRC/pdgeqpf.f index 608473b2..001aec70 100644 --- a/SRC/pdgeqpf.f +++ b/SRC/pdgeqpf.f @@ -226,12 +226,7 @@ SUBROUTINE PDGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, IDINT, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -253,7 +248,7 @@ SUBROUTINE PDGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, JA, INFO, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, JA, INFO, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEQPF inputs:,IA:',I5,',JA:',I5,',INFO:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgeqr2.f b/SRC/pdgeqr2.f index cf57407c..f622aecd 100644 --- a/SRC/pdgeqr2.f +++ b/SRC/pdgeqr2.f @@ -196,12 +196,7 @@ SUBROUTINE PDGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -223,7 +218,7 @@ SUBROUTINE PDGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEQR2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgeqrf.f b/SRC/pdgeqrf.f index 9b0636fc..83f4f82f 100644 --- a/SRC/pdgeqrf.f +++ b/SRC/pdgeqrf.f @@ -208,12 +208,7 @@ SUBROUTINE PDGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * * Initialize framework context structure if not initialized * @@ -241,7 +236,7 @@ SUBROUTINE PDGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGEQRF inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgerfs.f b/SRC/pdgerfs.f index a7406e25..fb41e82c 100644 --- a/SRC/pdgerfs.f +++ b/SRC/pdgerfs.f @@ -307,12 +307,7 @@ SUBROUTINE PDGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -335,7 +330,7 @@ SUBROUTINE PDGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, IA, IAF, IB, IX, INFO, + WRITE(LOG_BUF,102) TRANS, IA, IAF, IB, IX, INFO, $ JA, JAF, JB, JX, LIWORK, $ LWORK, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdgerq2.f b/SRC/pdgerq2.f index f4184b11..069aa0ae 100644 --- a/SRC/pdgerq2.f +++ b/SRC/pdgerq2.f @@ -195,12 +195,7 @@ SUBROUTINE PDGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -222,7 +217,7 @@ SUBROUTINE PDGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGERQ2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgerqf.f b/SRC/pdgerqf.f index e5f52876..42ab662a 100644 --- a/SRC/pdgerqf.f +++ b/SRC/pdgerqf.f @@ -195,12 +195,7 @@ SUBROUTINE PDGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -222,7 +217,7 @@ SUBROUTINE PDGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGERQF inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdgesv.f b/SRC/pdgesv.f index 3a4d5b2d..5990763e 100644 --- a/SRC/pdgesv.f +++ b/SRC/pdgesv.f @@ -184,12 +184,7 @@ SUBROUTINE PDGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -211,7 +206,7 @@ SUBROUTINE PDGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IB, INFO, JA, JB, N, NRHS, + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, N, NRHS, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGESV inputs:,IA:',I5,',IB:',I5,',INFO:',I5, $ ',JA:',I5,',JB:',I5,',N:',I5, diff --git a/SRC/pdgesvd.f b/SRC/pdgesvd.f index 06ed7446..440be3b9 100644 --- a/SRC/pdgesvd.f +++ b/SRC/pdgesvd.f @@ -327,12 +327,7 @@ SUBROUTINE PDGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * .. Intrinsic Functions .. INTRINSIC MAX,MIN,SQRT,DBLE * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -357,7 +352,7 @@ SUBROUTINE PDGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBU,JOBVT, IA,INFO,IU,IVT, + WRITE(LOG_BUF,102) JOBU,JOBVT, IA,INFO,IU,IVT, $ JA,JU,JVT,LWORK,M,N, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDGESVD inputs:,JOBU:',A5,',JOBVT:',A5, diff --git a/SRC/pdgesvx.f b/SRC/pdgesvx.f index 669a8819..667e522e 100644 --- a/SRC/pdgesvx.f +++ b/SRC/pdgesvx.f @@ -453,12 +453,7 @@ SUBROUTINE PDGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*512 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -480,7 +475,7 @@ SUBROUTINE PDGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) EQUED, FACT, TRANS, IA, IAF, + WRITE(LOG_BUF,102) EQUED, FACT, TRANS, IA, IAF, $ IB, INFO, IX, JA, JAF, JB, JX, LIWORK, $ LWORK, N, NRHS, $ RCOND, NPROW, NPCOL, MYROW, MYCOL, diff --git a/SRC/pdgetf2.f b/SRC/pdgetf2.f index 0feff12b..e0644e0f 100644 --- a/SRC/pdgetf2.f +++ b/SRC/pdgetf2.f @@ -164,12 +164,7 @@ SUBROUTINE PDGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -192,7 +187,7 @@ SUBROUTINE PDGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, M, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDGETF2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',M:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdgetf2K.f b/SRC/pdgetf2K.f index 221745d5..d02377e0 100644 --- a/SRC/pdgetf2K.f +++ b/SRC/pdgetf2K.f @@ -192,12 +192,7 @@ SUBROUTINE PDGETF2K( M, N, A, IA, JA, DESCA, IPIV, PANEL, INFO ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -220,7 +215,7 @@ SUBROUTINE PDGETF2K( M, N, A, IA, JA, DESCA, IPIV, PANEL, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, M, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDGETF2K inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',M:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdgetf2_comm.f b/SRC/pdgetf2_comm.f index db1dcc1f..4457cd2c 100644 --- a/SRC/pdgetf2_comm.f +++ b/SRC/pdgetf2_comm.f @@ -36,12 +36,7 @@ SUBROUTINE PDGETF2_COMM( M, N, A, IA, JA, DESCA, IPIV, INFO ) $ PDSCAL, PDSWAP, PB_TOPGET, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -63,7 +58,7 @@ SUBROUTINE PDGETF2_COMM( M, N, A, IA, JA, DESCA, IPIV, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, M, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDGETF2_COMM inputs:,IA:',I5,',INFO:',I5, $ ',JA:',I5,',M:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdgetrf.f b/SRC/pdgetrf.f index e7437b8f..58115892 100644 --- a/SRC/pdgetrf.f +++ b/SRC/pdgetrf.f @@ -142,15 +142,11 @@ SUBROUTINE PDGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * ===================================================================== * * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR CALL AOCL_SCALAPACK_INIT( ) AOCL_DTL_TRACE_ENTRY_F * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,101) M, N, IA, JA, eos_str + WRITE(LOG_BUF,101) M, N, IA, JA, eos_str 101 FORMAT('pdgetrf inputs:,M:',I9,',N:',I9, $ ',IA:',I5,',JA:',I5,A5 ) AOCL_DTL_LOG_ENTRY_F diff --git a/SRC/pdgetri.f b/SRC/pdgetri.f index b7c1efd6..d3b3b38d 100644 --- a/SRC/pdgetri.f +++ b/SRC/pdgetri.f @@ -196,12 +196,7 @@ SUBROUTINE PDGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -223,7 +218,7 @@ SUBROUTINE PDGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LIWORK, LWORK, + WRITE(LOG_BUF,102) IA, INFO, JA, LIWORK, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDGETRI inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LIWORK:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdgetrs.f b/SRC/pdgetrs.f index f30796a1..90badf32 100644 --- a/SRC/pdgetrs.f +++ b/SRC/pdgetrs.f @@ -184,12 +184,7 @@ SUBROUTINE PDGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -211,7 +206,7 @@ SUBROUTINE PDGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, IA, IB, INFO, JA, JB, + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDGETRS inputs:,TRANS:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdggqrf.f b/SRC/pdggqrf.f index 49c9b6bf..88ea04a5 100644 --- a/SRC/pdggqrf.f +++ b/SRC/pdggqrf.f @@ -287,12 +287,7 @@ SUBROUTINE PDGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC DBLE, INT, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -314,7 +309,7 @@ SUBROUTINE PDGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IB, INFO, JA, JB, LWORK, + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDGGQRF inputs:,IA:',I5,',IB:',I5,',INFO:',I5, diff --git a/SRC/pdggrqf.f b/SRC/pdggrqf.f index d042a07b..23eb2e52 100644 --- a/SRC/pdggrqf.f +++ b/SRC/pdggrqf.f @@ -287,12 +287,7 @@ SUBROUTINE PDGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC DBLE, INT, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -314,7 +309,7 @@ SUBROUTINE PDGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IB, INFO, JA, JB, LWORK, + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDGGRQF inputs:,IA:',I5,',IB:',I5,',INFO:',I5, diff --git a/SRC/pdhseqr.f b/SRC/pdhseqr.f index d7e8cb3b..aceda694 100644 --- a/SRC/pdhseqr.f +++ b/SRC/pdhseqr.f @@ -284,12 +284,7 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -312,7 +307,7 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IHI, ILO, INFO, LWORK, LIWORK, + WRITE(LOG_BUF,102) IHI, ILO, INFO, LWORK, LIWORK, $ N, COMPZ, JOB, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDHSEQR inputs:,IHI:',I5,',ILO:',I5,',INFO:',I5, diff --git a/SRC/pdlabad.f b/SRC/pdlabad.f index 9834d5b7..6d2b57cd 100644 --- a/SRC/pdlabad.f +++ b/SRC/pdlabad.f @@ -60,12 +60,7 @@ SUBROUTINE PDLABAD( ICTXT, SMALL, LARGE ) * .. Intrinsic Functions .. INTRINSIC LOG10, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -73,6 +68,13 @@ SUBROUTINE PDLABAD( ICTXT, SMALL, LARGE ) * CALL AOCL_SCALAPACK_INIT( ) * +* Update the log buffer with the scalar arguments details, +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) LARGE, SMALL, eos_str + 102 FORMAT('PDLABAD inputs:,LARGE:',F9.4,',SMALL:',F9.4,A1) + AOCL_DTL_LOG_ENTRY_F + END IF * * Capture the subroutine entry in the trace file * diff --git a/SRC/pdlabrd.f b/SRC/pdlabrd.f index 9acdcd19..023b1b36 100644 --- a/SRC/pdlabrd.f +++ b/SRC/pdlabrd.f @@ -276,12 +276,7 @@ SUBROUTINE PDLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -311,7 +306,7 @@ SUBROUTINE PDLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IX, IY, JA, JX, JY, M, N, + WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, N, $ NB, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLABRD inputs:,IA:',I5,',IX:',I5,',IY:',I5, $ ',JA:',I5,',JX:',I5,',JY:',I5, diff --git a/SRC/pdlacon.f b/SRC/pdlacon.f index 88fa8cee..0e2a43d8 100644 --- a/SRC/pdlacon.f +++ b/SRC/pdlacon.f @@ -187,12 +187,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, * .. Save statement .. SAVE * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -215,7 +210,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IV, IX, JV, JX, KASE, N, EST, + WRITE(LOG_BUF,102) IV, IX, JV, JX, KASE, N, EST, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLACON inputs:,IV:',I5,',IX:',I5,',JV:',I5, $ ',JX:',I5,',KASE:',I5,',N:',I5, diff --git a/SRC/pdlaconsb.f b/SRC/pdlaconsb.f index 87403f5d..dd95d158 100644 --- a/SRC/pdlaconsb.f +++ b/SRC/pdlaconsb.f @@ -188,12 +188,7 @@ SUBROUTINE PDLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * .. Intrinsic Functions .. INTRINSIC ABS, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -216,7 +211,7 @@ SUBROUTINE PDLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) I, L, LWORK, M, H33, H43H34, + WRITE(LOG_BUF,102) I, L, LWORK, M, H33, H43H34, $ H44, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLACONSB inputs:,I:',I5,',L:',I5,',LWORK:',I5, $ ',M:',I5,',H33:',F9.4,',H43H34:',F9.4, diff --git a/SRC/pdlacp2.f b/SRC/pdlacp2.f index 4b555358..b779862d 100644 --- a/SRC/pdlacp2.f +++ b/SRC/pdlacp2.f @@ -173,12 +173,7 @@ SUBROUTINE PDLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -207,7 +202,7 @@ SUBROUTINE PDLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, JA, JB, M, N, + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLACP2 inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, $ ',JA:',I5,',JB:',I5,',M:',I5, diff --git a/SRC/pdlacp3.f b/SRC/pdlacp3.f index 6e31f36e..66bd02c3 100644 --- a/SRC/pdlacp3.f +++ b/SRC/pdlacp3.f @@ -165,12 +165,7 @@ SUBROUTINE PDLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -203,7 +198,7 @@ SUBROUTINE PDLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) I, II, JJ, LDB, M, REV, NPROW, + WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLACP3 inputs:,I:',I5,',II:',I5,',JJ:',I5, $ ',LDB:',I5,',M:',I5,',REV:',I5, diff --git a/SRC/pdlacpy.f b/SRC/pdlacpy.f index 5b59733f..cd652e3a 100644 --- a/SRC/pdlacpy.f +++ b/SRC/pdlacpy.f @@ -167,12 +167,7 @@ SUBROUTINE PDLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -184,6 +179,16 @@ SUBROUTINE PDLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, eos_str + 102 FORMAT('PDLACPY inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, + $ ',JA:',I5,',JB:',I5,',M:',I5,',N:',I5,A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * diff --git a/SRC/pdlaed0.f b/SRC/pdlaed0.f index a01f1b09..72dd0b3f 100644 --- a/SRC/pdlaed0.f +++ b/SRC/pdlaed0.f @@ -106,12 +106,7 @@ SUBROUTINE PDLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -142,7 +137,7 @@ SUBROUTINE PDLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) INFO, IQ, JQ, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) INFO, IQ, JQ, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLAED0 inputs:,INFO:',I5,',IQ:',I5,',JQ:',I5, $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlaed1.f b/SRC/pdlaed1.f index 69b9b446..1a64b9b9 100644 --- a/SRC/pdlaed1.f +++ b/SRC/pdlaed1.f @@ -143,12 +143,7 @@ SUBROUTINE PDLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -180,7 +175,7 @@ SUBROUTINE PDLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) ID, INFO, IQ, JQ, N, N1, RHO, + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, N, N1, RHO, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAED1 inputs:,ID:',I5,',INFO:',I5,',IQ:',I5, $ ',JQ:',I5,',N:',I5,',N1:',I5, diff --git a/SRC/pdlaed2.f b/SRC/pdlaed2.f index 5ed50eee..6615994a 100644 --- a/SRC/pdlaed2.f +++ b/SRC/pdlaed2.f @@ -184,12 +184,7 @@ SUBROUTINE PDLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * .. Local Arrays .. INTEGER PTT( 4 ) * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -219,7 +214,7 @@ SUBROUTINE PDLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DCOL, DROW, IB1, IB2, ICTXT, + WRITE(LOG_BUF,102) DCOL, DROW, IB1, IB2, ICTXT, $ K, LDQ, LDQ2, N, N1, $ NB, NN, NN1, NN2, NPCOL, RHO, NPROW, $ NPCOL, MYROW, MYCOL, eos_str diff --git a/SRC/pdlaed3.f b/SRC/pdlaed3.f index 6e43c7dd..de9191cd 100644 --- a/SRC/pdlaed3.f +++ b/SRC/pdlaed3.f @@ -155,12 +155,7 @@ SUBROUTINE PDLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * .. Intrinsic Functions .. INTRINSIC MOD, SIGN, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -193,7 +188,7 @@ SUBROUTINE PDLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DCOL, DROW, ICTXT, INFO, K, + WRITE(LOG_BUF,102) DCOL, DROW, ICTXT, INFO, K, $ LDU, N, NB, NPCOL, RHO, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLAED3 inputs:,DCOL:',I5,',DROW:',I5, diff --git a/SRC/pdlaedz.f b/SRC/pdlaedz.f index 41df3748..9977b5e7 100644 --- a/SRC/pdlaedz.f +++ b/SRC/pdlaedz.f @@ -53,12 +53,7 @@ SUBROUTINE PDLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -89,7 +84,7 @@ SUBROUTINE PDLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) ID, IQ, JQ, LDQ, N, N1, NPROW, + WRITE(LOG_BUF,102) ID, IQ, JQ, LDQ, N, N1, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAEDZ inputs:,ID:',I5,',IQ:',I5,',JQ:',I5, $ ',LDQ:',I5,',N:',I5,',N1:',I5, diff --git a/SRC/pdlaevswp.f b/SRC/pdlaevswp.f index ba9cd9ac..a505e1eb 100644 --- a/SRC/pdlaevswp.f +++ b/SRC/pdlaevswp.f @@ -159,12 +159,7 @@ SUBROUTINE PDLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -191,7 +186,7 @@ SUBROUTINE PDLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IZ, JZ, LDZI, LWORK, N, NPROW, + WRITE(LOG_BUF,102) IZ, JZ, LDZI, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAEVSWP inputs:,IZ:',I5,',JZ:',I5,',LDZI:',I5, $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdlahqr.f b/SRC/pdlahqr.f index 6f6fb7cd..e37939cf 100644 --- a/SRC/pdlahqr.f +++ b/SRC/pdlahqr.f @@ -286,12 +286,7 @@ SUBROUTINE PDLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD, SIGN, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -330,7 +325,7 @@ SUBROUTINE PDLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) WANTT, WANTZ, IHI, IHIZ, ILO, + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, $ ILOZ, ILWORK, INFO, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAHQR inputs:,WANTT:',L2,',WANTZ:',L2, diff --git a/SRC/pdlahrd.f b/SRC/pdlahrd.f index 30b9c536..111969e5 100644 --- a/SRC/pdlahrd.f +++ b/SRC/pdlahrd.f @@ -165,12 +165,7 @@ SUBROUTINE PDLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -200,7 +195,7 @@ SUBROUTINE PDLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IY, JA, JY, K, N, NB, NPROW, + WRITE(LOG_BUF,102) IA, IY, JA, JY, K, N, NB, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAHRD inputs:,IA:',I5,',IY:',I5,',JA:',I5, $ ',JY:',I5,',K:',I5,',N:',I5,',NB:',I5, diff --git a/SRC/pdlamch.f b/SRC/pdlamch.f index 99efe269..29819bc4 100644 --- a/SRC/pdlamch.f +++ b/SRC/pdlamch.f @@ -69,12 +69,7 @@ DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH ) DOUBLE PRECISION DLAMCH EXTERNAL DLAMCH, LSAME * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -86,6 +81,14 @@ DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) CMACH, ICTXT, eos_str + 102 FORMAT('PDLAMCH inputs:,CMACH:',A5,',ICTXT:',I5,A1) + AOCL_DTL_LOG_ENTRY_F + END IF * TEMP = DLAMCH( CMACH ) IDUMM = 0 diff --git a/SRC/pdlamr1d.f b/SRC/pdlamr1d.f index 6f9d7d14..7151ebbc 100644 --- a/SRC/pdlamr1d.f +++ b/SRC/pdlamr1d.f @@ -112,12 +112,7 @@ SUBROUTINE PDLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -168,7 +163,7 @@ SUBROUTINE PDLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, IB, JA, JB, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, IB, JA, JB, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLAMR1D inputs:,IA:',I5,',IB:',I5,',JA:',I5, $ ',JB:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdlamve.f b/SRC/pdlamve.f index 711db2e5..a98fb42b 100644 --- a/SRC/pdlamve.f +++ b/SRC/pdlamve.f @@ -172,12 +172,7 @@ SUBROUTINE PDLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -199,7 +194,7 @@ SUBROUTINE PDLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, JA, JB, M, N, + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAMVE inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, $ ',JA:',I5,',JB:',I5,',M:',I5, diff --git a/SRC/pdlange.f b/SRC/pdlange.f index 60310cc8..175cec40 100644 --- a/SRC/pdlange.f +++ b/SRC/pdlange.f @@ -182,12 +182,7 @@ DOUBLE PRECISION FUNCTION PDLANGE( NORM, M, N, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -209,7 +204,7 @@ DOUBLE PRECISION FUNCTION PDLANGE( NORM, M, N, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) NORM, IA, JA, M, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) NORM, IA, JA, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLANGE inputs:,NORM:',A5,',IA:',I5,',JA:',I5, $ ',M:',I5,',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlanhs.f b/SRC/pdlanhs.f index 6fedf905..012df5b5 100644 --- a/SRC/pdlanhs.f +++ b/SRC/pdlanhs.f @@ -176,12 +176,7 @@ DOUBLE PRECISION FUNCTION PDLANHS( NORM, N, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -203,7 +198,7 @@ DOUBLE PRECISION FUNCTION PDLANHS( NORM, N, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) NORM, IA, JA, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) NORM, IA, JA, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT(' inputs:,NORM:',A5,',IA:',I5,',JA:',I5, $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlansy.f b/SRC/pdlansy.f index 54063997..470e5f0e 100644 --- a/SRC/pdlansy.f +++ b/SRC/pdlansy.f @@ -200,12 +200,7 @@ DOUBLE PRECISION FUNCTION PDLANSY( NORM, UPLO, N, A, IA, JA, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -227,7 +222,7 @@ DOUBLE PRECISION FUNCTION PDLANSY( NORM, UPLO, N, A, IA, JA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) NORM, UPLO, IA, JA, N, NPROW, + WRITE(LOG_BUF,102) NORM, UPLO, IA, JA, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT(' inputs:,NORM:',A5,',UPLO:',A5,',IA:',I5, $ ',JA:',I5,',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlantr.f b/SRC/pdlantr.f index ab476569..4387fb5b 100644 --- a/SRC/pdlantr.f +++ b/SRC/pdlantr.f @@ -198,12 +198,7 @@ DOUBLE PRECISION FUNCTION PDLANTR( NORM, UPLO, DIAG, M, N, A, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -225,7 +220,7 @@ DOUBLE PRECISION FUNCTION PDLANTR( NORM, UPLO, DIAG, M, N, A, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, NORM, UPLO, IA, JA, M, + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, M, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT(' inputs:,DIAG:',A5,',NORM:',A5,',UPLO:',A5, $ ',IA:',I5,',JA:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdlapiv.f b/SRC/pdlapiv.f index 535b3d9d..e180f572 100644 --- a/SRC/pdlapiv.f +++ b/SRC/pdlapiv.f @@ -229,12 +229,7 @@ SUBROUTINE PDLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * .. Intrinsic Functions .. INTRINSIC MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -256,7 +251,7 @@ SUBROUTINE PDLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIREC, PIVROC, ROWCOL, IA, IP, + WRITE(LOG_BUF,102) DIREC, PIVROC, ROWCOL, IA, IP, $ JA, JP, M, N, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDLAPIV inputs:,DIREC:',A5,',PIVROC:',A5, diff --git a/SRC/pdlapv2.f b/SRC/pdlapv2.f index cc137bf1..ce18a5e6 100644 --- a/SRC/pdlapv2.f +++ b/SRC/pdlapv2.f @@ -174,12 +174,7 @@ SUBROUTINE PDLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -225,7 +220,7 @@ SUBROUTINE PDLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIREC, ROWCOL, IA, IP, JA, JP, + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, IP, JA, JP, $ M, N, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDLAPV2 inputs:,DIREC:',A5,',ROWCOL:',A5, diff --git a/SRC/pdlaqge.f b/SRC/pdlaqge.f index fb95e914..7546207d 100644 --- a/SRC/pdlaqge.f +++ b/SRC/pdlaqge.f @@ -184,12 +184,7 @@ SUBROUTINE PDLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -222,7 +217,7 @@ SUBROUTINE PDLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) EQUED, IA, JA, M, N, AMAX, COLCND, + WRITE(LOG_BUF,102) EQUED, IA, JA, M, N, AMAX, COLCND, $ ROWCND, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDLAQGE inputs:,EQUED:',A5,',IA:',I5,',JA:',I5, diff --git a/SRC/pdlaqr0.f b/SRC/pdlaqr0.f index 0f34df04..e9a1a1f5 100644 --- a/SRC/pdlaqr0.f +++ b/SRC/pdlaqr0.f @@ -297,12 +297,7 @@ RECURSIVE SUBROUTINE PDLAQR0( WANTT, WANTZ, N, ILO, IHI, H, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -322,7 +317,7 @@ RECURSIVE SUBROUTINE PDLAQR0( WANTT, WANTZ, N, ILO, IHI, H, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IHI, IHIZ, ILO, ILOZ, INFO, + WRITE(LOG_BUF,102) IHI, IHIZ, ILO, ILOZ, INFO, $ LIWORK, LWORK, N, RECLEVEL, $ WANTT, WANTZ, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdlaqr1.f b/SRC/pdlaqr1.f index 09cfffec..f85ded27 100644 --- a/SRC/pdlaqr1.f +++ b/SRC/pdlaqr1.f @@ -308,12 +308,7 @@ RECURSIVE SUBROUTINE PDLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, MOD, SIGN, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -351,7 +346,7 @@ RECURSIVE SUBROUTINE PDLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) WANTT, WANTZ, IHI, IHIZ, ILO, + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, $ ILOZ, ILWORK, INFO, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAQR1 inputs:,WANTT:',L2,',WANTZ:',L2, diff --git a/SRC/pdlaqr2.f b/SRC/pdlaqr2.f index c910d523..12f74d2a 100644 --- a/SRC/pdlaqr2.f +++ b/SRC/pdlaqr2.f @@ -248,12 +248,7 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -290,7 +285,7 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IHIZ, ILOZ, KBOT, KTOP, LDT, + WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LDT, $ LDV, LWORK, N, ND, NS, $ NW, WANTT, WANTZ, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdlaqr3.f b/SRC/pdlaqr3.f index 0581919d..e1c63842 100644 --- a/SRC/pdlaqr3.f +++ b/SRC/pdlaqr3.f @@ -289,12 +289,7 @@ RECURSIVE SUBROUTINE PDLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -313,7 +308,7 @@ RECURSIVE SUBROUTINE PDLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IHIZ, ILOZ, KBOT, KTOP, LWORK, + WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LWORK, $ N, ND, NH, NS, NV, $ NW, LIWORK, RECLEVEL, WANTT, WANTZ, $ NPROW, NPCOL, MYROW, MYCOL, eos_str diff --git a/SRC/pdlaqr4.f b/SRC/pdlaqr4.f index c626b396..2b2eb2e3 100644 --- a/SRC/pdlaqr4.f +++ b/SRC/pdlaqr4.f @@ -233,12 +233,7 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -277,7 +272,7 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) WANTT, WANTZ, IHI, IHIZ, ILO, + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, $ ILOZ, INFO, LDT, LDV, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAQR4 inputs:,WANTT:',L2,',WANTZ:',L2, diff --git a/SRC/pdlaqr5.f b/SRC/pdlaqr5.f index 11d6a788..85043f53 100644 --- a/SRC/pdlaqr5.f +++ b/SRC/pdlaqr5.f @@ -186,12 +186,7 @@ SUBROUTINE PDLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, EXTERNAL DGEMM, DLABAD, DLAMOV, DLAQR1, DLARFG, DLASET, $ DTRMM, DLAQR6 * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -212,7 +207,7 @@ SUBROUTINE PDLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IHIZ, ILOZ, KACC22, KBOT, KTOP, + WRITE(LOG_BUF,102) IHIZ, ILOZ, KACC22, KBOT, KTOP, $ N, NSHFTS, LWORK, $ LIWORK, WANTT, WANTZ, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdlaqsy.f b/SRC/pdlaqsy.f index 58bfd7fc..e07d0a34 100644 --- a/SRC/pdlaqsy.f +++ b/SRC/pdlaqsy.f @@ -186,12 +186,7 @@ SUBROUTINE PDLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -224,7 +219,7 @@ SUBROUTINE PDLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) EQUED, UPLO, IA, JA, N, AMAX, + WRITE(LOG_BUF,102) EQUED, UPLO, IA, JA, N, AMAX, $ SCOND, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDLAQSY inputs:,EQUED:',A5,',UPLO:',A5, diff --git a/SRC/pdlared1d.f b/SRC/pdlared1d.f index bd94f746..b931d7e8 100644 --- a/SRC/pdlared1d.f +++ b/SRC/pdlared1d.f @@ -145,12 +145,7 @@ SUBROUTINE PDLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -178,7 +173,7 @@ SUBROUTINE PDLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, JA, LWORK, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, JA, LWORK, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLARED1D inputs:,IA:',I5,',JA:',I5,',LWORK:',I5, $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlared2d.f b/SRC/pdlared2d.f index 8d1042c3..cf1bf375 100644 --- a/SRC/pdlared2d.f +++ b/SRC/pdlared2d.f @@ -142,12 +142,7 @@ SUBROUTINE PDLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -175,7 +170,7 @@ SUBROUTINE PDLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, JA, LWORK, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, JA, LWORK, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLARED2D inputs:,IA:',I5,',JA:',I5,',LWORK:',I5, $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f index bd3a4104..ed58e428 100644 --- a/SRC/pdlarf.f +++ b/SRC/pdlarf.f @@ -264,12 +264,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -301,7 +296,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, IC, INCV, IV, JC, JV, + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, $ M, N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLARF inputs:,SIDE:',A5,',IC:',I5,',INCV:',I5, $ ',IV:',I5,',JC:',I5,',JV:',I5, diff --git a/SRC/pdlarfb.f b/SRC/pdlarfb.f index 94887287..9b65e623 100644 --- a/SRC/pdlarfb.f +++ b/SRC/pdlarfb.f @@ -254,12 +254,7 @@ SUBROUTINE PDLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, INTEGER ICEIL, NUMROC EXTERNAL ICEIL, LSAME, NUMROC * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -291,7 +286,7 @@ SUBROUTINE PDLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, DIRECT, STOREV, + WRITE(LOG_BUF,102) SIDE, TRANS, DIRECT, STOREV, $ IC, IV, JC, JV, K, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLARFB inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdlarfg.f b/SRC/pdlarfg.f index a7567557..038f0f3b 100644 --- a/SRC/pdlarfg.f +++ b/SRC/pdlarfg.f @@ -173,12 +173,7 @@ SUBROUTINE PDLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * .. Intrinsic Functions .. INTRINSIC ABS, SIGN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -200,7 +195,7 @@ SUBROUTINE PDLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IAX, INCX, IX, JAX, JX, N, ALPHA, + WRITE(LOG_BUF,102) IAX, INCX, IX, JAX, JX, N, ALPHA, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLARFG inputs:,IAX:',I5,',INCX:',I5,',IX:',I5, $ ',JAX:',I5,',JX:',I5,',N:',I5, diff --git a/SRC/pdlarft.f b/SRC/pdlarft.f index 4980f230..5ec4747a 100644 --- a/SRC/pdlarft.f +++ b/SRC/pdlarft.f @@ -204,12 +204,7 @@ SUBROUTINE PDLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -239,7 +234,7 @@ SUBROUTINE PDLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIRECT, STOREV, IV, JV, K, N, + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLARFT inputs:,DIRECT:',A5,',STOREV:',A5, $ ',IV:',I5,',JV:',I5,',K:',I5,',N:',I5, diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f index d0798568..4e81d7b5 100644 --- a/SRC/pdlarz.f +++ b/SRC/pdlarz.f @@ -273,12 +273,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -310,7 +305,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, IC, INCV, IV, JC, JV, + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, $ L, M, N, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDLARZ inputs:,SIDE:',A5,',IC:',I5,',INCV:',I5, diff --git a/SRC/pdlarzb.f b/SRC/pdlarzb.f index b6736725..fb24913d 100644 --- a/SRC/pdlarzb.f +++ b/SRC/pdlarzb.f @@ -259,12 +259,7 @@ SUBROUTINE PDLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, INTEGER ICEIL, NUMROC EXTERNAL ICEIL, LSAME, NUMROC * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -296,7 +291,7 @@ SUBROUTINE PDLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIRECT, SIDE, STOREV, TRANS, + WRITE(LOG_BUF,102) DIRECT, SIDE, STOREV, TRANS, $ IC, IV, JC, JV, K, L, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLARZB inputs:,DIRECT:',A5,',SIDE:',A5, diff --git a/SRC/pdlarzt.f b/SRC/pdlarzt.f index affd629f..f819768b 100644 --- a/SRC/pdlarzt.f +++ b/SRC/pdlarzt.f @@ -216,12 +216,7 @@ SUBROUTINE PDLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -243,7 +238,7 @@ SUBROUTINE PDLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIRECT, STOREV, IV, JV, K, N, + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLARZT inputs:,DIRECT:',A5,',STOREV:',A5, $ ',IV:',I5,',JV:',I5,',K:',I5,',N:',I5, diff --git a/SRC/pdlascl.f b/SRC/pdlascl.f index 3f9d37fa..4c9bfef2 100644 --- a/SRC/pdlascl.f +++ b/SRC/pdlascl.f @@ -168,12 +168,7 @@ SUBROUTINE PDLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ABS, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -195,7 +190,7 @@ SUBROUTINE PDLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TYPE, IA, INFO, JA, M, N, CFROM, + WRITE(LOG_BUF,102) TYPE, IA, INFO, JA, M, N, CFROM, $ CTO, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDLASCL inputs:,TYPE:',A5,',IA:',I5,',INFO:',I5, diff --git a/SRC/pdlase2.f b/SRC/pdlase2.f index ac5c292c..309e5896 100644 --- a/SRC/pdlase2.f +++ b/SRC/pdlase2.f @@ -161,12 +161,7 @@ SUBROUTINE PDLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -195,7 +190,7 @@ SUBROUTINE PDLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, JA, M, N, ALPHA, BETA, + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, BETA, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLASE2 inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, $ ',M:',I5,',N:',I5,',ALPHA:',F9.4, diff --git a/SRC/pdlaset.f b/SRC/pdlaset.f index 5b8d94b0..bea25545 100644 --- a/SRC/pdlaset.f +++ b/SRC/pdlaset.f @@ -156,12 +156,7 @@ SUBROUTINE PDLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -173,6 +168,16 @@ SUBROUTINE PDLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, BETA eos_str + 102 FORMAT('PDLASET inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, + $ ',M:',I5,',N:',I5,',ALPHA:',F9.4,',BETA:',F9.4,A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * diff --git a/SRC/pdlasmsub.f b/SRC/pdlasmsub.f index 5c19aa7b..19b528cb 100644 --- a/SRC/pdlasmsub.f +++ b/SRC/pdlasmsub.f @@ -172,12 +172,7 @@ SUBROUTINE PDLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -202,7 +197,7 @@ SUBROUTINE PDLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) I, K, L, LWORK, SMLNUM, NPROW, + WRITE(LOG_BUF,102) I, K, L, LWORK, SMLNUM, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLASMSUB inputs:,I:',I5,',K:',I5,',L:',I5, $ ',LWORK:',I5,',SMLNUM:',F9.4,',NPROW:',I5, diff --git a/SRC/pdlasrt.f b/SRC/pdlasrt.f index 5c66662c..c8df9ffb 100644 --- a/SRC/pdlasrt.f +++ b/SRC/pdlasrt.f @@ -108,12 +108,7 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -151,7 +146,7 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) ID, INFO, IQ, JQ, LIWORK, LWORK, + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, LIWORK, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDLASRT inputs:,ID:',A5,',INFO:',I5,',IQ:',I5, diff --git a/SRC/pdlassq.f b/SRC/pdlassq.f index 9b2aa4ab..84be00b1 100644 --- a/SRC/pdlassq.f +++ b/SRC/pdlassq.f @@ -168,12 +168,7 @@ SUBROUTINE PDLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * .. Intrinsic Functions .. INTRINSIC ABS, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -195,7 +190,7 @@ SUBROUTINE PDLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IX, INCX, JX, N, SCALE, SUMSQ, + WRITE(LOG_BUF,102) IX, INCX, JX, N, SCALE, SUMSQ, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLASSQ inputs:,IX:',I5,',INCX:',I5,',JX:',I5, $ ',N:',I5,',SCALE:',F9.4,',SUMSQ:',F9.4, diff --git a/SRC/pdlaswp.f b/SRC/pdlaswp.f index 519bfd8e..ffb8e894 100644 --- a/SRC/pdlaswp.f +++ b/SRC/pdlaswp.f @@ -159,12 +159,7 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, LOGICAL LSAME EXTERNAL LSAME * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -193,7 +188,7 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIREC, ROWCOL, IA, JA, K1, K2, + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, JA, K1, K2, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLASWP inputs:,DIREC:',A5,',ROWCOL:',A5, $ ',IA:',I5,',JA:',I5,',K1:',I5,',K2:',I5, diff --git a/SRC/pdlatra.f b/SRC/pdlatra.f index 5df19afb..b9da401d 100644 --- a/SRC/pdlatra.f +++ b/SRC/pdlatra.f @@ -130,12 +130,7 @@ DOUBLE PRECISION FUNCTION PDLATRA( N, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -156,7 +151,7 @@ DOUBLE PRECISION FUNCTION PDLATRA( N, A, IA, JA, DESCA ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, JA, N, NPROW, NPCOL, MYROW, + WRITE(LOG_BUF,102) IA, JA, N, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT(' inputs:,IA:',I5,',JA:',I5,',N:',I5,',NPROW:',I5, $ ',NPCOL:',I5,',MYROW:',I5, diff --git a/SRC/pdlatrd.f b/SRC/pdlatrd.f index 1964e782..0ec029c4 100644 --- a/SRC/pdlatrd.f +++ b/SRC/pdlatrd.f @@ -256,12 +256,7 @@ SUBROUTINE PDLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -291,7 +286,7 @@ SUBROUTINE PDLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IW, JA, JW, N, NB, + WRITE(LOG_BUF,102) UPLO, IA, IW, JA, JW, N, NB, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLATRD inputs:,UPLO:',A5,',IA:',I5,',IW:',I5, $ ',JA:',I5,',JW:',I5,',N:',I5, diff --git a/SRC/pdlatrs.f b/SRC/pdlatrs.f index fc4f4ffb..1354cca7 100644 --- a/SRC/pdlatrs.f +++ b/SRC/pdlatrs.f @@ -54,12 +54,7 @@ SUBROUTINE PDLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, EXTERNAL BLACS_GRIDINFO, DGEBR2D, DGEBS2D, INFOG2L, $ PDTRSV * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -81,7 +76,7 @@ SUBROUTINE PDLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, NORMIN, TRANS, UPLO, IA, + WRITE(LOG_BUF,102) DIAG, NORMIN, TRANS, UPLO, IA, $ IX, JA, JX, N, SCALE, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLATRS inputs:,DIAG:',A5,',NORMIN:',A5, diff --git a/SRC/pdlatrz.f b/SRC/pdlatrz.f index c3180a9f..fe2ecd70 100644 --- a/SRC/pdlatrz.f +++ b/SRC/pdlatrz.f @@ -192,12 +192,7 @@ SUBROUTINE PDLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -229,7 +224,7 @@ SUBROUTINE PDLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, JA, L, M, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) IA, JA, L, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLATRZ inputs:,IA:',I5,',JA:',I5,',L:',I5, $ ',M:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdlauu2.f b/SRC/pdlauu2.f index a82aace1..3d9306f5 100644 --- a/SRC/pdlauu2.f +++ b/SRC/pdlauu2.f @@ -147,12 +147,7 @@ SUBROUTINE PDLAUU2( UPLO, N, A, IA, JA, DESCA ) DOUBLE PRECISION DDOT EXTERNAL DDOT, LSAME * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -183,7 +178,7 @@ SUBROUTINE PDLAUU2( UPLO, N, A, IA, JA, DESCA ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, JA, N, NPROW, NPCOL, + WRITE(LOG_BUF,102) UPLO, IA, JA, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDLAUU2 inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, diff --git a/SRC/pdlauum.f b/SRC/pdlauum.f index 0825cc3d..caf7b5a5 100644 --- a/SRC/pdlauum.f +++ b/SRC/pdlauum.f @@ -146,12 +146,7 @@ SUBROUTINE PDLAUUM( UPLO, N, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -164,6 +159,16 @@ SUBROUTINE PDLAUUM( UPLO, N, A, IA, JA, DESCA ) * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PDLACPY inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, + $ ',N:',I5,A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* +* * Quick return if possible * IF( N.EQ.0 ) THEN diff --git a/SRC/pdlawil.f b/SRC/pdlawil.f index dd2920cc..7fc1bac2 100644 --- a/SRC/pdlawil.f +++ b/SRC/pdlawil.f @@ -138,12 +138,7 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * .. Intrinsic Functions .. INTRINSIC ABS, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -165,7 +160,7 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) II, JJ, M, H33, H43H34, H44, + WRITE(LOG_BUF,102) II, JJ, M, H33, H43H34, H44, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDLAWIL inputs:,II:',I5,',JJ:',I5,',M:',I5, $ ',H33:',F9.4,',H43H34:',F9.4,',H44:',F9.4, diff --git a/SRC/pdorg2l.f b/SRC/pdorg2l.f index aedd4a33..1f1d9913 100644 --- a/SRC/pdorg2l.f +++ b/SRC/pdorg2l.f @@ -188,12 +188,7 @@ SUBROUTINE PDORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -215,7 +210,7 @@ SUBROUTINE PDORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORG2L inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorg2r.f b/SRC/pdorg2r.f index 6d2d7a21..f65b65a3 100644 --- a/SRC/pdorg2r.f +++ b/SRC/pdorg2r.f @@ -189,12 +189,7 @@ SUBROUTINE PDORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -216,7 +211,7 @@ SUBROUTINE PDORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORG2R inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorgl2.f b/SRC/pdorgl2.f index ca797180..a00b826c 100644 --- a/SRC/pdorgl2.f +++ b/SRC/pdorgl2.f @@ -188,12 +188,7 @@ SUBROUTINE PDORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -215,7 +210,7 @@ SUBROUTINE PDORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGL2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorglq.f b/SRC/pdorglq.f index 02017a97..3c4bce2b 100644 --- a/SRC/pdorglq.f +++ b/SRC/pdorglq.f @@ -191,12 +191,7 @@ SUBROUTINE PDORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -218,7 +213,7 @@ SUBROUTINE PDORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGLQ inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorgql.f b/SRC/pdorgql.f index f423748a..bb732052 100644 --- a/SRC/pdorgql.f +++ b/SRC/pdorgql.f @@ -190,12 +190,7 @@ SUBROUTINE PDORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -217,7 +212,7 @@ SUBROUTINE PDORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGQL inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorgqr.f b/SRC/pdorgqr.f index 1f03c13c..c21d6275 100644 --- a/SRC/pdorgqr.f +++ b/SRC/pdorgqr.f @@ -192,12 +192,7 @@ SUBROUTINE PDORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -219,7 +214,7 @@ SUBROUTINE PDORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGQR inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorgr2.f b/SRC/pdorgr2.f index 499c0201..a0bf677c 100644 --- a/SRC/pdorgr2.f +++ b/SRC/pdorgr2.f @@ -188,12 +188,7 @@ SUBROUTINE PDORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -215,7 +210,7 @@ SUBROUTINE PDORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGR2 inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorgrq.f b/SRC/pdorgrq.f index 5e6fb586..916aab05 100644 --- a/SRC/pdorgrq.f +++ b/SRC/pdorgrq.f @@ -191,12 +191,7 @@ SUBROUTINE PDORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -218,7 +213,7 @@ SUBROUTINE PDORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, K, LWORK, M, N, + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORGRQ inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',K:',I5,',LWORK:',I5,',M:',I5, diff --git a/SRC/pdorm2l.f b/SRC/pdorm2l.f index fd1d189c..c2fd4b36 100644 --- a/SRC/pdorm2l.f +++ b/SRC/pdorm2l.f @@ -244,12 +244,7 @@ SUBROUTINE PDORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -271,7 +266,7 @@ SUBROUTINE PDORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORM2L inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdorm2r.f b/SRC/pdorm2r.f index 889d36bb..32942c73 100644 --- a/SRC/pdorm2r.f +++ b/SRC/pdorm2r.f @@ -244,12 +244,7 @@ SUBROUTINE PDORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -271,7 +266,7 @@ SUBROUTINE PDORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORM2R inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormbr.f b/SRC/pdormbr.f index 94e0b828..063a4299 100644 --- a/SRC/pdormbr.f +++ b/SRC/pdormbr.f @@ -316,12 +316,7 @@ SUBROUTINE PDORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -343,7 +338,7 @@ SUBROUTINE PDORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, VECT, IA, IC, INFO, + WRITE(LOG_BUF,102) SIDE, TRANS, VECT, IA, IC, INFO, $ JA, JC, K, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORMBR inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormhr.f b/SRC/pdormhr.f index efa53e69..6ca69cfb 100644 --- a/SRC/pdormhr.f +++ b/SRC/pdormhr.f @@ -253,12 +253,7 @@ SUBROUTINE PDORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -280,7 +275,7 @@ SUBROUTINE PDORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, IHI, ILO, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, IHI, ILO, $ INFO, JA, JC, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDORMHR inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdorml2.f b/SRC/pdorml2.f index 518c6a14..f08e19aa 100644 --- a/SRC/pdorml2.f +++ b/SRC/pdorml2.f @@ -242,12 +242,7 @@ SUBROUTINE PDORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -269,7 +264,7 @@ SUBROUTINE PDORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORML2 inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormlq.f b/SRC/pdormlq.f index bc445bad..cc312847 100644 --- a/SRC/pdormlq.f +++ b/SRC/pdormlq.f @@ -252,12 +252,7 @@ SUBROUTINE PDORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -279,7 +274,7 @@ SUBROUTINE PDORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMLQ inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormql.f b/SRC/pdormql.f index 24e90cba..a991311d 100644 --- a/SRC/pdormql.f +++ b/SRC/pdormql.f @@ -252,12 +252,7 @@ SUBROUTINE PDORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -279,7 +274,7 @@ SUBROUTINE PDORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMQL inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormqr.f b/SRC/pdormqr.f index d69246e9..2a5f3dc8 100644 --- a/SRC/pdormqr.f +++ b/SRC/pdormqr.f @@ -252,12 +252,7 @@ SUBROUTINE PDORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -279,7 +274,7 @@ SUBROUTINE PDORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMQR inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormr2.f b/SRC/pdormr2.f index 17d0aac3..c43c3dcd 100644 --- a/SRC/pdormr2.f +++ b/SRC/pdormr2.f @@ -241,12 +241,7 @@ SUBROUTINE PDORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -268,7 +263,7 @@ SUBROUTINE PDORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMR2 inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormr3.f b/SRC/pdormr3.f index bac4bb63..2480555f 100644 --- a/SRC/pdormr3.f +++ b/SRC/pdormr3.f @@ -244,12 +244,7 @@ SUBROUTINE PDORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -271,7 +266,7 @@ SUBROUTINE PDORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, L, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMR3 inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormrq.f b/SRC/pdormrq.f index 2b425bf7..cb5526b2 100644 --- a/SRC/pdormrq.f +++ b/SRC/pdormrq.f @@ -252,12 +252,7 @@ SUBROUTINE PDORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -279,7 +274,7 @@ SUBROUTINE PDORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMRQ inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormrz.f b/SRC/pdormrz.f index e21a91bc..ea8a5784 100644 --- a/SRC/pdormrz.f +++ b/SRC/pdormrz.f @@ -257,12 +257,7 @@ SUBROUTINE PDORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -284,7 +279,7 @@ SUBROUTINE PDORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, IA, IC, INFO, JA, + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, JA, $ JC, K, L, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMRZ inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdormtr.f b/SRC/pdormtr.f index 04182aec..5f4b6136 100644 --- a/SRC/pdormtr.f +++ b/SRC/pdormtr.f @@ -267,12 +267,7 @@ SUBROUTINE PDORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -294,7 +289,7 @@ SUBROUTINE PDORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) SIDE, TRANS, UPLO, IA, IC, INFO, + WRITE(LOG_BUF,102) SIDE, TRANS, UPLO, IA, IC, INFO, $ JA, JC, LWORK, M, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDORMTR inputs:,SIDE:',A5,',TRANS:',A5, diff --git a/SRC/pdpbsv.f b/SRC/pdpbsv.f index 577c6d3d..c2b7a6be 100644 --- a/SRC/pdpbsv.f +++ b/SRC/pdpbsv.f @@ -389,12 +389,7 @@ SUBROUTINE PDPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDPBTRF, PDPBTRS, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -441,7 +436,7 @@ SUBROUTINE PDPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, BW, IB, INFO, JA, LWORK, + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LWORK, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDPBSV inputs:,UPLO:',A5,',BW:',I5,',IB:',I5, diff --git a/SRC/pdpbtrf.f b/SRC/pdpbtrf.f index 131f4874..8e70d675 100644 --- a/SRC/pdpbtrf.f +++ b/SRC/pdpbtrf.f @@ -395,12 +395,7 @@ SUBROUTINE PDPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * .. Intrinsic Functions .. INTRINSIC ICHAR, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -449,7 +444,7 @@ SUBROUTINE PDPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, BW, INFO, JA, LAF, LWORK, + WRITE(LOG_BUF,102) UPLO, BW, INFO, JA, LAF, LWORK, $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPBTRF inputs:,UPLO:',A5,',BW:',I5,',INFO:',I5, $ ',JA:',I5,',LAF:',I5,',LWORK:',I5, diff --git a/SRC/pdpbtrs.f b/SRC/pdpbtrs.f index 784dfaed..5060c16a 100644 --- a/SRC/pdpbtrs.f +++ b/SRC/pdpbtrs.f @@ -398,12 +398,7 @@ SUBROUTINE PDPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -478,7 +473,7 @@ SUBROUTINE PDPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, BW, IB, INFO, JA, LAF, + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LAF, $ LWORK, N, NRHS, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDPBTRS inputs:,UPLO:',A5,',BW:',I5,',IB:',I5, diff --git a/SRC/pdpbtrsv.f b/SRC/pdpbtrsv.f index 5ce87c46..8226bbc6 100644 --- a/SRC/pdpbtrsv.f +++ b/SRC/pdpbtrsv.f @@ -412,12 +412,7 @@ SUBROUTINE PDPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -496,7 +491,7 @@ SUBROUTINE PDPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) TRANS, UPLO, BW, IB, INFO, JA, + WRITE(LOG_BUF,102) TRANS, UPLO, BW, IB, INFO, JA, $ LAF, LWORK, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDPBTRSV inputs:,TRANS:',A5,',UPLO:',A5, diff --git a/SRC/pdpocon.f b/SRC/pdpocon.f index f338027a..d401d261 100644 --- a/SRC/pdpocon.f +++ b/SRC/pdpocon.f @@ -210,12 +210,7 @@ SUBROUTINE PDPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -237,7 +232,7 @@ SUBROUTINE PDPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, LIWORK, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LIWORK, $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDPOCON inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, diff --git a/SRC/pdpoequ.f b/SRC/pdpoequ.f index 0f394dbc..6a94393e 100644 --- a/SRC/pdpoequ.f +++ b/SRC/pdpoequ.f @@ -185,12 +185,7 @@ SUBROUTINE PDPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -212,7 +207,7 @@ SUBROUTINE PDPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, N, AMAX, SCOND, + WRITE(LOG_BUF,102) IA, INFO, JA, N, AMAX, SCOND, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPOEQU inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',N:',I5,',AMAX:',F9.4,',SCOND:',F9.4, diff --git a/SRC/pdporfs.f b/SRC/pdporfs.f index cb4600de..a8b60730 100644 --- a/SRC/pdporfs.f +++ b/SRC/pdporfs.f @@ -304,12 +304,7 @@ SUBROUTINE PDPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -333,7 +328,7 @@ SUBROUTINE PDPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IAF, IB, INFO, IX, + WRITE(LOG_BUF,102) UPLO, IA, IAF, IB, INFO, IX, $ JA, JAF, JB, JX, LIWORK, $ LWORK, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdposv.f b/SRC/pdposv.f index 25e140f9..d09ed150 100644 --- a/SRC/pdposv.f +++ b/SRC/pdposv.f @@ -197,12 +197,7 @@ SUBROUTINE PDPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -224,7 +219,7 @@ SUBROUTINE PDPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, INFO, JA, JB, + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDPOSV inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdposvx.f b/SRC/pdposvx.f index 4908f8ad..29b1ea5d 100644 --- a/SRC/pdposvx.f +++ b/SRC/pdposvx.f @@ -394,12 +394,7 @@ SUBROUTINE PDPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * .. Intrinsic Functions .. INTRINSIC ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*512 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -421,7 +416,7 @@ SUBROUTINE PDPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) EQUED, FACT, UPLO, IA, IAF, + WRITE(LOG_BUF,102) EQUED, FACT, UPLO, IA, IAF, $ IB, INFO, IX, JA, JAF, JB, JX, LIWORK, $ LWORK, N, NRHS, $ RCOND, NPROW, NPCOL, MYROW, MYCOL, diff --git a/SRC/pdpotf2.f b/SRC/pdpotf2.f index 324025c0..ea8da3ef 100644 --- a/SRC/pdpotf2.f +++ b/SRC/pdpotf2.f @@ -171,12 +171,7 @@ SUBROUTINE PDPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) DOUBLE PRECISION DDOT EXTERNAL LSAME, DDOT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -198,7 +193,7 @@ SUBROUTINE PDPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, N, NPROW, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPOTF2 inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdpotrf.f b/SRC/pdpotrf.f index 01422d8a..670da6c5 100644 --- a/SRC/pdpotrf.f +++ b/SRC/pdpotrf.f @@ -185,12 +185,7 @@ SUBROUTINE PDPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * .. Intrinsic Functions .. INTRINSIC ICHAR, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -212,7 +207,7 @@ SUBROUTINE PDPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, N, NPROW, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPOTRF inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdpotri.f b/SRC/pdpotri.f index 54b2ebd0..4feafba5 100644 --- a/SRC/pdpotri.f +++ b/SRC/pdpotri.f @@ -150,12 +150,7 @@ SUBROUTINE PDPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -177,7 +172,7 @@ SUBROUTINE PDPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, N, NPROW, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPOTRI inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdpotrs.f b/SRC/pdpotrs.f index ce75ea8b..70fbd894 100644 --- a/SRC/pdpotrs.f +++ b/SRC/pdpotrs.f @@ -178,12 +178,7 @@ SUBROUTINE PDPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -205,7 +200,7 @@ SUBROUTINE PDPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, INFO, JA, JB, + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDPOTRS inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdptsv.f b/SRC/pdptsv.f index 8dc7be43..ea0d4810 100644 --- a/SRC/pdptsv.f +++ b/SRC/pdptsv.f @@ -390,12 +390,7 @@ SUBROUTINE PDPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * .. External Subroutines .. EXTERNAL PDPTTRF, PDPTTRS, PXERBLA * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -445,7 +440,7 @@ SUBROUTINE PDPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IB, INFO, JA, LWORK, N, NRHS, + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPTSV inputs:,IB:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',N:',I5,',NRHS:',I5, diff --git a/SRC/pdpttrf.f b/SRC/pdpttrf.f index 09e99034..7ad44d6b 100644 --- a/SRC/pdpttrf.f +++ b/SRC/pdpttrf.f @@ -391,12 +391,7 @@ SUBROUTINE PDPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -449,7 +444,7 @@ SUBROUTINE PDPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) INFO, JA, LAF, LWORK, N, NPROW, + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPTTRF inputs:,INFO:',I5,',JA:',I5,',LAF:',I5, $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, diff --git a/SRC/pdpttrs.f b/SRC/pdpttrs.f index 9821b9c1..dd629485 100644 --- a/SRC/pdpttrs.f +++ b/SRC/pdpttrs.f @@ -405,12 +405,7 @@ SUBROUTINE PDPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * .. Intrinsic Functions .. INTRINSIC DBLE, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -493,7 +488,7 @@ SUBROUTINE PDPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IB, INFO, JA, LAF, LWORK, N, + WRITE(LOG_BUF,102) IB, INFO, JA, LAF, LWORK, N, $ NRHS, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDPTTRS inputs:,IB:',I5,',INFO:',I5,',JA:',I5, $ ',LAF:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdpttrsv.f b/SRC/pdpttrsv.f index d10d7610..006bf17e 100644 --- a/SRC/pdpttrsv.f +++ b/SRC/pdpttrsv.f @@ -416,12 +416,7 @@ SUBROUTINE PDPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * .. Intrinsic Functions .. INTRINSIC ICHAR, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -504,7 +499,7 @@ SUBROUTINE PDPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IB, INFO, JA, LAF, LWORK, + WRITE(LOG_BUF,102) UPLO, IB, INFO, JA, LAF, LWORK, $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDPTTRSV inputs:,UPLO:',A5,',IB:',I5,',INFO:',I5, diff --git a/SRC/pdrot.f b/SRC/pdrot.f index 35d715dd..1a776ffb 100644 --- a/SRC/pdrot.f +++ b/SRC/pdrot.f @@ -207,12 +207,7 @@ SUBROUTINE PDROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * .. Local Functions .. INTEGER ICEIL * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -234,7 +229,7 @@ SUBROUTINE PDROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) N, IX, JX, INCX, IY, JY, INCY, + WRITE(LOG_BUF,102) N, IX, JX, INCX, IY, JY, INCY, $ LWORK, INFO, CS, SN, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDROT inputs:,N:',I5,',IX:',I5,',JX:',I5, diff --git a/SRC/pdrscl.f b/SRC/pdrscl.f index 7ec8d109..840efd65 100644 --- a/SRC/pdrscl.f +++ b/SRC/pdrscl.f @@ -148,12 +148,7 @@ SUBROUTINE PDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * .. Intrinsic Functions .. INTRINSIC ABS * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -175,7 +170,7 @@ SUBROUTINE PDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IX, INCX, JX, N, SA, NPROW, + WRITE(LOG_BUF,102) IX, INCX, JX, N, SA, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDRSCL inputs:,IX:',I5,',INCX:',I5,',JX:',I5, $ ',N:',I5,',SA:',F9.4,',NPROW:',I5, diff --git a/SRC/pdstedc.f b/SRC/pdstedc.f index 3ad94f38..47067e20 100644 --- a/SRC/pdstedc.f +++ b/SRC/pdstedc.f @@ -152,12 +152,7 @@ SUBROUTINE PDSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -188,7 +183,7 @@ SUBROUTINE PDSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) COMPZ, INFO, IQ, JQ, LIWORK, + WRITE(LOG_BUF,102) COMPZ, INFO, IQ, JQ, LIWORK, $ LWORK, N, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDSTEDC inputs:,COMPZ:',A5,',INFO:',I5, diff --git a/SRC/pdstein.f b/SRC/pdstein.f index 21024133..e28146cd 100644 --- a/SRC/pdstein.f +++ b/SRC/pdstein.f @@ -302,12 +302,7 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * .. Local Arrays .. INTEGER IDUM1( 1 ), IDUM2( 1 ) * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -335,7 +330,7 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) INFO, IZ, JZ, LIWORK, LWORK, + WRITE(LOG_BUF,102) INFO, IZ, JZ, LIWORK, LWORK, $ M, N, ORFAC, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDSTEIN inputs:,INFO:',I5,',IZ:',I5,',JZ:',I5, diff --git a/SRC/pdsyev.f b/SRC/pdsyev.f index f0ccd441..ad375068 100644 --- a/SRC/pdsyev.f +++ b/SRC/pdsyev.f @@ -285,12 +285,7 @@ SUBROUTINE PDSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MIN, MOD, SQRT, INT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -329,7 +324,7 @@ SUBROUTINE PDSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBZ, UPLO, IA, INFO, IZ, JA, + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, $ JZ, LWORK, N, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDSYEV inputs:,JOBZ:',A5,',UPLO:',A5,',IA:',I5, diff --git a/SRC/pdsyevd.f b/SRC/pdsyevd.f index 120b7d36..1a8a0155 100644 --- a/SRC/pdsyevd.f +++ b/SRC/pdsyevd.f @@ -195,12 +195,7 @@ SUBROUTINE PDSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -241,7 +236,7 @@ SUBROUTINE PDSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBZ, UPLO, IA, INFO, IZ, JA, + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, $ JZ, LIWORK, LWORK, N, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDSYEVD inputs:,JOBZ:',A5,',UPLO:',A5, diff --git a/SRC/pdsyevr.f b/SRC/pdsyevr.f index 9ad360d8..1822a218 100644 --- a/SRC/pdsyevr.f +++ b/SRC/pdsyevr.f @@ -345,12 +345,7 @@ SUBROUTINE PDSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*512 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -410,7 +405,7 @@ SUBROUTINE PDSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBZ, RANGE, UPLO, IA, IL, INFO, + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, INFO, $ IU, IZ, JA, JZ, LIWORK, LWORK, $ M, N, NZ, VL, VU, $ NPROW, NPCOL, MYROW, MYCOL, eos_str diff --git a/SRC/pdsyevx.f b/SRC/pdsyevx.f index 4592c77c..5a288891 100644 --- a/SRC/pdsyevx.f +++ b/SRC/pdsyevx.f @@ -515,12 +515,7 @@ SUBROUTINE PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*512 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -557,7 +552,7 @@ SUBROUTINE PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBZ, RANGE, UPLO, IA, IL, INFO, + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, INFO, $ IU, IZ, JA, JZ, LIWORK, LWORK, $ M, N, NZ, ABSTOL, $ ORFAC, VL, VU, NPROW, NPCOL, MYROW, diff --git a/SRC/pdsygs2.f b/SRC/pdsygs2.f index 06ca0ca1..23c445ba 100644 --- a/SRC/pdsygs2.f +++ b/SRC/pdsygs2.f @@ -195,12 +195,7 @@ SUBROUTINE PDSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTEGER INDXG2P EXTERNAL LSAME, INDXG2P * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -231,7 +226,7 @@ SUBROUTINE PDSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, IBTYPE, INFO, + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, $ JA, JB, N, NPROW, NPCOL, MYROW, MYCOL, $ eos_str 102 FORMAT('PDSYGS2 inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdsygst.f b/SRC/pdsygst.f index abec3670..dbe98b62 100644 --- a/SRC/pdsygst.f +++ b/SRC/pdsygst.f @@ -203,12 +203,7 @@ SUBROUTINE PDSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTEGER ICEIL, INDXG2P EXTERNAL LSAME, ICEIL, INDXG2P * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -241,7 +236,7 @@ SUBROUTINE PDSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, IBTYPE, INFO, + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, $ JA, JB, N, SCALE, NPROW, NPCOL, MYROW, $ MYCOL, eos_str 102 FORMAT('PDSYGST inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdsygvx.f b/SRC/pdsygvx.f index 4e598119..17c98961 100644 --- a/SRC/pdsygvx.f +++ b/SRC/pdsygvx.f @@ -532,12 +532,7 @@ SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*576 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -568,7 +563,7 @@ SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) JOBZ, RANGE, UPLO, IA, IB, IBTYPE, + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IB, IBTYPE, $ IL, INFO, IU, IZ, JA, JB, JZ, $ LIWORK, LWORK, M, $ N, NZ, ABSTOL, ORFAC, VL, VU, NPROW, diff --git a/SRC/pdsyngst.f b/SRC/pdsyngst.f index 43ca40c7..f8c80870 100644 --- a/SRC/pdsyngst.f +++ b/SRC/pdsyngst.f @@ -243,12 +243,7 @@ SUBROUTINE PDSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -267,7 +262,7 @@ SUBROUTINE PDSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, IB, IBTYPE, INFO, + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, $ JA, JB, LWORK, N, SCALE, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDSYNGST inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, diff --git a/SRC/pdsyntrd.f b/SRC/pdsyntrd.f index c143b613..48766fb8 100644 --- a/SRC/pdsyntrd.f +++ b/SRC/pdsyntrd.f @@ -293,12 +293,7 @@ SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -329,7 +324,7 @@ SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, LWORK, N, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDSYNTRD inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdsytd2.f b/SRC/pdsytd2.f index 5ae69ce1..9b707518 100644 --- a/SRC/pdsytd2.f +++ b/SRC/pdsytd2.f @@ -247,12 +247,7 @@ SUBROUTINE PDSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -274,7 +269,7 @@ SUBROUTINE PDSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, LWORK, N, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDSYTD2 inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdsytrd.f b/SRC/pdsytrd.f index 0dc5a882..d0d4df0d 100644 --- a/SRC/pdsytrd.f +++ b/SRC/pdsytrd.f @@ -258,12 +258,7 @@ SUBROUTINE PDSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -285,7 +280,7 @@ SUBROUTINE PDSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, LWORK, N, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDSYTRD inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdsyttrd.f b/SRC/pdsyttrd.f index 4d506ea0..725c4256 100644 --- a/SRC/pdsyttrd.f +++ b/SRC/pdsyttrd.f @@ -463,12 +463,7 @@ SUBROUTINE PDSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * * -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -517,7 +512,7 @@ SUBROUTINE PDSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) UPLO, IA, INFO, JA, LWORK, N, + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDSYTTRD inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, $ ',JA:',I5,',LWORK:',I5,',N:',I5, diff --git a/SRC/pdtrcon.f b/SRC/pdtrcon.f index 21d1b3b1..5fa38d70 100644 --- a/SRC/pdtrcon.f +++ b/SRC/pdtrcon.f @@ -224,12 +224,7 @@ SUBROUTINE PDTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -251,7 +246,7 @@ SUBROUTINE PDTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, NORM, UPLO, IA, JA, INFO, + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, INFO, $ LIWORK, LWORK, N, RCOND, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDTRCON inputs:,DIAG:',A5,',NORM:',A5, diff --git a/SRC/pdtrord.f b/SRC/pdtrord.f index 1f63fb76..aa8d3d40 100644 --- a/SRC/pdtrord.f +++ b/SRC/pdtrord.f @@ -326,7 +326,7 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, $ PITRAF, PDW, WINEIG, WINSIZ, LLDQ, $ RSRC, CSRC, ILILO, ILIHI, ILSEL, IRSRC, $ ICSRC, IPIW, IPW1, IPW2, IPW3, TIHI, TILO, - $ LIHI, WINDOW, LILO, LSEL, INT_BUFFER, + $ LIHI, WINDOW, LILO, LSEL, BUFFER, $ NMWIN2, BUFFLEN, LROWS, LCOLS, ILOC2, JLOC2, $ WNEICR, WINDOW0, RSRC4, CSRC4, LIHI4, RSRC3, $ CSRC3, RSRC2, CSRC2, LIHIC, LIHI1, ILEN4, @@ -361,12 +361,7 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * .. Local Functions .. INTEGER ICEIL * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -388,7 +383,7 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) COMPQ, INFO, LIWORK, LWORK, + WRITE(LOG_BUF,102) COMPQ, INFO, LIWORK, LWORK, $ M, N, IT, JT, IQ, $ JQ, NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDTRORD inputs:,COMPQ:',A5,',INFO:',I5, @@ -1034,41 +1029,41 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * BUFFLEN = 0. * IF( MYROW.EQ.RSRC .AND. MYCOL.EQ.CSRC ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( BUFFLEN.NE.0 ) THEN DO 180 INDX = 1, ILEN - WORK( INT_BUFFER+INDX-1 ) = + WORK( BUFFER+INDX-1 ) = $ DBLE( IWORK(IPIW+INDX-1) ) 180 CONTINUE CALL DLAMOV( 'All', DLEN, 1, WORK( IPW2 ), - $ DLEN, WORK(INT_BUFFER+ILEN), DLEN ) + $ DLEN, WORK(BUFFER+ILEN), DLEN ) IF( NPCOL.GT.1 .AND. DIR.EQ.1 ) THEN CALL DGEBS2D( ICTXT, 'Row', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN ) + $ WORK(BUFFER), BUFFLEN ) END IF IF( NPROW.GT.1 .AND. DIR.EQ.2 ) THEN CALL DGEBS2D( ICTXT, 'Col', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN ) + $ WORK(BUFFER), BUFFLEN ) END IF END IF ELSEIF( MYROW.EQ.RSRC .OR. MYCOL.EQ.CSRC ) THEN IF( NPCOL.GT.1 .AND. DIR.EQ.1 .AND. MYROW.EQ.RSRC ) $ THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( BUFFLEN.NE.0 ) THEN CALL DGEBR2D( ICTXT, 'Row', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC, CSRC ) + $ WORK(BUFFER), BUFFLEN, RSRC, CSRC ) END IF END IF IF( NPROW.GT.1 .AND. DIR.EQ.2 .AND. MYCOL.EQ.CSRC ) $ THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( BUFFLEN.NE.0 ) THEN CALL DGEBR2D( ICTXT, 'Col', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC, CSRC ) + $ WORK(BUFFER), BUFFLEN, RSRC, CSRC ) END IF END IF IF((NPCOL.GT.1.AND.DIR.EQ.1.AND.MYROW.EQ.RSRC).OR. @@ -1077,10 +1072,10 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, IF( BUFFLEN.NE.0 ) THEN DO 190 INDX = 1, ILEN IWORK(IPIW+INDX-1) = - $ INT(WORK( INT_BUFFER+INDX-1 )) + $ INT(WORK( BUFFER+INDX-1 )) 190 CONTINUE CALL DLAMOV( 'All', DLEN, 1, - $ WORK( INT_BUFFER+ILEN ), DLEN, + $ WORK( BUFFER+ILEN ), DLEN, $ WORK( IPW2 ), DLEN ) END IF END IF @@ -1125,7 +1120,7 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * Compute amount of work space necessary for performing * matrix-matrix multiplications. * - PDW = INT_BUFFER + PDW = BUFFER IPW3 = PDW + NWIN*NWIN ELSE FLOPS = 0 @@ -2305,107 +2300,107 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * Broadcast the orthogonal transformations. * IF( MYROW.EQ.RSRC1 .AND. MYCOL.EQ.CSRC1 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( (NPROW.GT.1 .AND. DIR.EQ.2) .OR. $ (NPCOL.GT.1 .AND. DIR.EQ.1) ) THEN DO 370 INDX = 1, ILEN - WORK( INT_BUFFER+INDX-1 ) = + WORK( BUFFER+INDX-1 ) = $ DBLE( IWORK(IPIW+INDX-1) ) 370 CONTINUE CALL DLAMOV( 'All', DLEN, 1, WORK( IPW3 ), - $ DLEN, WORK(INT_BUFFER+ILEN), DLEN ) + $ DLEN, WORK(BUFFER+ILEN), DLEN ) END IF IF( NPCOL.GT.1 .AND. DIR.EQ.1 ) THEN CALL DGEBS2D( ICTXT, 'Row', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN ) + $ WORK(BUFFER), BUFFLEN ) END IF IF( NPROW.GT.1 .AND. DIR.EQ.2 ) THEN CALL DGEBS2D( ICTXT, 'Col', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN ) + $ WORK(BUFFER), BUFFLEN ) END IF ELSEIF( MYROW.EQ.RSRC1 .OR. MYCOL.EQ.CSRC1 ) THEN IF( NPCOL.GT.1 .AND. DIR.EQ.1 .AND. $ MYROW.EQ.RSRC1 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN CALL DGEBR2D( ICTXT, 'Row', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC1, CSRC1 ) + $ WORK(BUFFER), BUFFLEN, RSRC1, CSRC1 ) END IF IF( NPROW.GT.1 .AND. DIR.EQ.2 .AND. $ MYCOL.EQ.CSRC1 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN CALL DGEBR2D( ICTXT, 'Col', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC1, CSRC1 ) + $ WORK(BUFFER), BUFFLEN, RSRC1, CSRC1 ) END IF IF( (NPCOL.GT.1.AND.DIR.EQ.1.AND.MYROW.EQ.RSRC1) $ .OR. (NPROW.GT.1.AND.DIR.EQ.2.AND. $ MYCOL.EQ.CSRC1) ) THEN DO 380 INDX = 1, ILEN IWORK(IPIW+INDX-1) = - $ INT( WORK( INT_BUFFER+INDX-1 ) ) + $ INT( WORK( BUFFER+INDX-1 ) ) 380 CONTINUE CALL DLAMOV( 'All', DLEN, 1, - $ WORK( INT_BUFFER+ILEN ), DLEN, + $ WORK( BUFFER+ILEN ), DLEN, $ WORK( IPW3 ), DLEN ) END IF END IF IF( RSRC1.NE.RSRC4 ) THEN IF( MYROW.EQ.RSRC4 .AND. MYCOL.EQ.CSRC4 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( NPCOL.GT.1 .AND. DIR.EQ.1 ) THEN DO 390 INDX = 1, ILEN - WORK( INT_BUFFER+INDX-1 ) = + WORK( BUFFER+INDX-1 ) = $ DBLE( IWORK(IPIW+INDX-1) ) 390 CONTINUE CALL DLAMOV( 'All', DLEN, 1, WORK( IPW3 ), - $ DLEN, WORK(INT_BUFFER+ILEN), DLEN ) + $ DLEN, WORK(BUFFER+ILEN), DLEN ) CALL DGEBS2D( ICTXT, 'Row', TOP, BUFFLEN, - $ 1, WORK(INT_BUFFER), BUFFLEN ) + $ 1, WORK(BUFFER), BUFFLEN ) END IF ELSEIF( MYROW.EQ.RSRC4 .AND. DIR.EQ.1 .AND. $ NPCOL.GT.1 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN - CALL DGEBR2D( ICTXT, 'Row', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC4, CSRC4 ) + CALL DGEBR2D( ICTXT, 'Row', TOP, BUFFLEN, + $ 1, WORK(BUFFER), BUFFLEN, RSRC4, CSRC4 ) DO 400 INDX = 1, ILEN IWORK(IPIW+INDX-1) = - $ INT( WORK( INT_BUFFER+INDX-1 ) ) + $ INT( WORK( BUFFER+INDX-1 ) ) 400 CONTINUE CALL DLAMOV( 'All', DLEN, 1, - $ WORK( INT_BUFFER+ILEN ), DLEN, + $ WORK( BUFFER+ILEN ), DLEN, $ WORK( IPW3 ), DLEN ) END IF END IF IF( CSRC1.NE.CSRC4 ) THEN IF( MYROW.EQ.RSRC4 .AND. MYCOL.EQ.CSRC4 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN IF( NPROW.GT.1 .AND. DIR.EQ.2 ) THEN DO 395 INDX = 1, ILEN - WORK( INT_BUFFER+INDX-1 ) = + WORK( BUFFER+INDX-1 ) = $ DBLE( IWORK(IPIW+INDX-1) ) 395 CONTINUE CALL DLAMOV( 'All', DLEN, 1, WORK( IPW3 ), - $ DLEN, WORK(INT_BUFFER+ILEN), DLEN ) + $ DLEN, WORK(BUFFER+ILEN), DLEN ) CALL DGEBS2D( ICTXT, 'Col', TOP, BUFFLEN, - $ 1, WORK(INT_BUFFER), BUFFLEN ) + $ 1, WORK(BUFFER), BUFFLEN ) END IF ELSEIF( MYCOL.EQ.CSRC4 .AND. DIR.EQ.2 .AND. $ NPROW.GT.1 ) THEN - INT_BUFFER = PDTRAF + BUFFER = PDTRAF BUFFLEN = DLEN + ILEN CALL DGEBR2D( ICTXT, 'Col', TOP, BUFFLEN, 1, - $ WORK(INT_BUFFER), BUFFLEN, RSRC4, CSRC4 ) + $ WORK(BUFFER), BUFFLEN, RSRC4, CSRC4 ) DO 402 INDX = 1, ILEN IWORK(IPIW+INDX-1) = - $ INT( WORK( INT_BUFFER+INDX-1 ) ) + $ INT( WORK( BUFFER+INDX-1 ) ) 402 CONTINUE CALL DLAMOV( 'All', DLEN, 1, - $ WORK( INT_BUFFER+ILEN ), DLEN, + $ WORK( BUFFER+ILEN ), DLEN, $ WORK( IPW3 ), DLEN ) END IF END IF @@ -2436,7 +2431,7 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, IF( ((MYCOL.EQ.CSRC1.OR.MYCOL.EQ.CSRC4).AND.DIR.EQ.2) $ .OR. ((MYROW.EQ.RSRC1.OR.MYROW.EQ.RSRC4).AND. $ DIR.EQ.1)) THEN - IPW4 = INT_BUFFER + IPW4 = BUFFER IF( DIR.EQ.2 ) THEN IF( WANTQ ) THEN QROWS = NUMROC( N, NB, MYROW, DESCQ( RSRC_ ), diff --git a/SRC/pdtrrfs.f b/SRC/pdtrrfs.f index 3995563e..b1796c41 100644 --- a/SRC/pdtrrfs.f +++ b/SRC/pdtrrfs.f @@ -288,12 +288,7 @@ SUBROUTINE PDTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -315,7 +310,7 @@ SUBROUTINE PDTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, TRANS, UPLO, INFO, IA, + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, INFO, IA, $ IB, IX, JA, JB, JX, LIWORK, LWORK, $ N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str diff --git a/SRC/pdtrsen.f b/SRC/pdtrsen.f index cce59220..77b8c9b5 100644 --- a/SRC/pdtrsen.f +++ b/SRC/pdtrsen.f @@ -386,12 +386,7 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*448 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -413,7 +408,7 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) COMPQ, JOB, INFO, LIWORK, LWORK, + WRITE(LOG_BUF,102) COMPQ, JOB, INFO, LIWORK, LWORK, $ M, N, IT, JT, $ IQ, JQ, S, SEP, NPROW, NPCOL, MYROW, $ MYCOL, eos_str diff --git a/SRC/pdtrti2.f b/SRC/pdtrti2.f index ac243b32..5060d7ed 100644 --- a/SRC/pdtrti2.f +++ b/SRC/pdtrti2.f @@ -154,12 +154,7 @@ SUBROUTINE PDTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) LOGICAL LSAME EXTERNAL LSAME * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -181,7 +176,7 @@ SUBROUTINE PDTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, UPLO, IA, INFO, JA, N, + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDTRTI2 inputs:,DIAG:',A5,',UPLO:',A5, $ ',IA:',I5,',INFO:',I5,',JA:',I5,',N:',I5, diff --git a/SRC/pdtrtri.f b/SRC/pdtrtri.f index 88fc4b00..0af58567 100644 --- a/SRC/pdtrtri.f +++ b/SRC/pdtrtri.f @@ -167,12 +167,7 @@ SUBROUTINE PDTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * .. Intrinsic Functions .. INTRINSIC ICHAR, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*320 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -194,7 +189,7 @@ SUBROUTINE PDTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, UPLO, IA, INFO, JA, N, + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDTRTRI inputs:,DIAG:',A5,',UPLO:',A5, $ ',IA:',I5,',INFO:',I5,',JA:',I5,',N:',I5, diff --git a/SRC/pdtrtrs.f b/SRC/pdtrtrs.f index 1e5ae630..17393aca 100644 --- a/SRC/pdtrtrs.f +++ b/SRC/pdtrtrs.f @@ -197,12 +197,7 @@ SUBROUTINE PDTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. Intrinsic Functions .. INTRINSIC ICHAR, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*384 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -224,7 +219,7 @@ SUBROUTINE PDTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) DIAG, TRANS, UPLO, IA, IB, INFO, + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, IA, IB, INFO, $ JA, JB, N, NRHS, NPROW, NPCOL, $ MYROW, MYCOL, eos_str 102 FORMAT('PDTRTRS inputs:,DIAG:',A5,',TRANS:',A5, diff --git a/SRC/pdtzrzf.f b/SRC/pdtzrzf.f index 9c9727ef..1640a7f0 100644 --- a/SRC/pdtzrzf.f +++ b/SRC/pdtzrzf.f @@ -218,12 +218,7 @@ SUBROUTINE PDTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -245,7 +240,7 @@ SUBROUTINE PDTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IA, INFO, JA, LWORK, M, N, NPROW, + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDTZRZF inputs:,IA:',I5,',INFO:',I5,',JA:',I5, $ ',LWORK:',I5,',M:',I5,',N:',I5, diff --git a/SRC/pdzsum1.f b/SRC/pdzsum1.f index 23950091..00bfecbd 100644 --- a/SRC/pdzsum1.f +++ b/SRC/pdzsum1.f @@ -170,12 +170,7 @@ SUBROUTINE PDZSUM1( N, ASUM, X, IX, JX, DESCX, INCX ) * .. Intrinsic Functions .. INTRINSIC ABS, MOD * .. -* .. LOG variables declaration .. * .. -* BUFFER size: Function name and Process grid info (128 Bytes) + -* Variable names + Variable values(num_vars *10) - CHARACTER BUFFER*256 - CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -195,7 +190,7 @@ SUBROUTINE PDZSUM1( N, ASUM, X, IX, JX, DESCX, INCX ) * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(BUFFER,102) IX, INCX, JX, N, ASUM, NPROW, + WRITE(LOG_BUF,102) IX, INCX, JX, N, ASUM, NPROW, $ NPCOL, MYROW, MYCOL, eos_str 102 FORMAT('PDZSUM1 inputs:,IX:',I5,',INCX:',I5,',JX:',I5, $ ',N:',I5,',ASUM:',F9.4,',NPROW:',I5, From 6a2804ba94fe4d8255b4d9dcf98272937e39f5b5 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Sat, 2 Sep 2023 12:20:57 +0530 Subject: [PATCH 12/29] Trace and Logging feature enabled for 40 float data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: I8c8269240b6ebb8fef444b671895d53783065c97 --- SRC/psdbsv.f | 48 ++++++++++++++++++++++++++++++++++ SRC/psdbtrf.f | 65 +++++++++++++++++++++++++++++++++++++++++++-- SRC/psdbtrs.f | 71 +++++++++++++++++++++++++++++++++++++++++++++++--- SRC/psdbtrsv.f | 71 +++++++++++++++++++++++++++++++++++++++++++++++--- SRC/psdtsv.f | 46 ++++++++++++++++++++++++++++++++ SRC/psdttrf.f | 63 ++++++++++++++++++++++++++++++++++++++++++-- SRC/psdttrs.f | 70 ++++++++++++++++++++++++++++++++++++++++++++++--- SRC/psdttrsv.f | 70 ++++++++++++++++++++++++++++++++++++++++++++++--- SRC/psgbsv.f | 48 ++++++++++++++++++++++++++++++++++ SRC/psgbtrf.f | 65 +++++++++++++++++++++++++++++++++++++++++++-- SRC/psgbtrs.f | 71 +++++++++++++++++++++++++++++++++++++++++++++++--- SRC/psgebal.f | 42 +++++++++++++++++++++++++++++ SRC/psgebd2.f | 46 ++++++++++++++++++++++++++++++++ SRC/psgebrd.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgecon.f | 56 +++++++++++++++++++++++++++++++++++++++ SRC/psgeequ.f | 62 ++++++++++++++++++++++++++++++++++++++++--- SRC/psgehd2.f | 43 ++++++++++++++++++++++++++++++ SRC/psgehrd.f | 52 ++++++++++++++++++++++++++++++++++-- SRC/psgelq2.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgelqf.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgels.f | 48 ++++++++++++++++++++++++++++++++++ SRC/psgeql2.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgeqlf.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgeqpf.f | 55 +++++++++++++++++++++++++++++++++++--- SRC/psgeqr2.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgeqrf.f | 55 +++++++++++++++++++++++++++++++++++--- SRC/psgerfs.f | 51 ++++++++++++++++++++++++++++++++++++ SRC/psgerq2.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgerqf.f | 51 ++++++++++++++++++++++++++++++++++-- SRC/psgesv.f | 38 +++++++++++++++++++++++++++ SRC/psgesvd.f | 45 ++++++++++++++++++++++++++++++++ SRC/psgesvx.f | 57 ++++++++++++++++++++++++++++++++++++++++ SRC/psgetf2.f | 47 +++++++++++++++++++++++++++++++-- SRC/psgetrf.f | 39 +++++++++++++++++++++++++-- SRC/psgetri.f | 70 ++++++++++++++++++++++++++++++++++++++++++------- SRC/psgetrs.f | 49 ++++++++++++++++++++++++++++++++-- SRC/psggqrf.f | 44 +++++++++++++++++++++++++++++++ SRC/psggrqf.f | 44 +++++++++++++++++++++++++++++++ SRC/pslabad.f | 21 +++++++++++++++ SRC/pslabrd.f | 44 +++++++++++++++++++++++++++++-- 40 files changed, 2032 insertions(+), 72 deletions(-) diff --git a/SRC/psdbsv.f b/SRC/psdbsv.f index 9dd591ee..55f59008 100644 --- a/SRC/psdbsv.f +++ b/SRC/psdbsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -384,6 +391,16 @@ SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PSDBTRF and PSDBTRS. @@ -405,11 +422,30 @@ SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PSDBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSDBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * * Size needed for AF in factorization * @@ -427,6 +463,10 @@ SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PSDBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -440,9 +480,17 @@ SUBROUTINE PSDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSDBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDBSV diff --git a/SRC/psdbtrf.f b/SRC/psdbtrf.f index be99d856..cc32e22d 100644 --- a/SRC/psdbtrf.f +++ b/SRC/psdbtrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -383,6 +390,16 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -415,6 +432,21 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, MBW2 = MAX_BW*MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSDBTRF inputs: ,BWL:',I5,', BWU:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -461,12 +493,20 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, INFO = -( 1 ) CALL PXERBLA( ICTXT, 'PSDBTRF, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*MAX( BWL, BWU ) ) ) THEN INFO = -( 6*100+4 ) CALL PXERBLA( ICTXT, 'PSDBTRF, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -481,6 +521,10 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, AF( 1 ) = LAF_MIN CALL PXERBLA( ICTXT, 'PSDBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -495,6 +539,10 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, INFO = -10 CALL PXERBLA( ICTXT, 'PSDBTRF: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -550,13 +598,22 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1244,6 +1301,10 @@ SUBROUTINE PSDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, END IF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDBTRF diff --git a/SRC/psdbtrs.f b/SRC/psdbtrs.f index f2c3fe14..382150e6 100644 --- a/SRC/psdbtrs.f +++ b/SRC/psdbtrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -397,6 +404,16 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -454,6 +471,22 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSDBTRS inputs: ,TRANS:',A5,', BWL:',I5, + $ ', BWU:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -528,12 +561,20 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, INFO = -( 2 ) CALL PXERBLA( ICTXT, 'PSDBTRS, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*MAX( BWL, BWU ) ) ) THEN INFO = -( 8*100+4 ) CALL PXERBLA( ICTXT, 'PSDBTRS, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -547,6 +588,10 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, INFO = -15 CALL PXERBLA( ICTXT, 'PSDBTRS: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -618,16 +663,30 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -740,6 +799,10 @@ SUBROUTINE PSDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDBTRS diff --git a/SRC/psdbtrsv.f b/SRC/psdbtrsv.f index 370fda3c..163d0611 100644 --- a/SRC/psdbtrsv.f +++ b/SRC/psdbtrsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -411,6 +418,16 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -473,6 +490,22 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, MBW2 = MAX_BW*MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, BWL, BWU, IB, + $ INFO, JA, LAF, LWORK, N, NRHS, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSDBTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -556,6 +589,10 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PSDBTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -563,6 +600,10 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, INFO = -( 9*100+4 ) CALL PXERBLA( ICTXT, 'PSDBTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -576,6 +617,10 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, INFO = -16 CALL PXERBLA( ICTXT, 'PSDBTRSV: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -649,16 +694,30 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDBTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1542,6 +1601,10 @@ SUBROUTINE PSDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDBTRSV diff --git a/SRC/psdtsv.f b/SRC/psdtsv.f index 44b1b115..622d2d07 100644 --- a/SRC/psdtsv.f +++ b/SRC/psdtsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IB, INFO, JA, LWORK, N, NRHS * .. @@ -394,6 +401,16 @@ SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PSDTTRF and PSDTTRS. @@ -418,11 +435,28 @@ SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PSDTSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSDTSV inputs: ,IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * * Size needed for AF in factorization * @@ -440,6 +474,10 @@ SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PSDTSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -453,9 +491,17 @@ SUBROUTINE PSDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSDTSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDTSV diff --git a/SRC/psdttrf.f b/SRC/psdttrf.f index 67f58079..29b2d28a 100644 --- a/SRC/psdttrf.f +++ b/SRC/psdttrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, JA, LAF, LWORK, N * .. @@ -393,6 +400,16 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -428,6 +445,19 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSDTTRF inputs: ,INFO:',I5,', JA:',I5, + $ ', LAF:',I5,', LWORK:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -458,12 +488,20 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, INFO = -( 1 ) CALL PXERBLA( ICTXT, 'PSDTTRF, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*INT_ONE ) ) THEN INFO = -( 6*100+4 ) CALL PXERBLA( ICTXT, 'PSDTTRF, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -478,6 +516,10 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, AF( 1 ) = LAF_MIN CALL PXERBLA( ICTXT, 'PSDTTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -492,6 +534,10 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, INFO = -10 CALL PXERBLA( ICTXT, 'PSDTTRF: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -543,13 +589,22 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDTTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1036,6 +1091,10 @@ SUBROUTINE PSDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, END IF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDTTRF diff --git a/SRC/psdttrs.f b/SRC/psdttrs.f index a8b21f24..3b57bb5c 100644 --- a/SRC/psdttrs.f +++ b/SRC/psdttrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -412,6 +419,16 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -477,6 +494,21 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IB, INFO, JA, LAF, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSDTTRS inputs: ,TRANS:',A5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -535,12 +567,20 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, INFO = -( 2 ) CALL PXERBLA( ICTXT, 'PSDTTRS, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*INT_ONE ) ) THEN INFO = -( 8*100+4 ) CALL PXERBLA( ICTXT, 'PSDTTRS, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -554,6 +594,10 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, INFO = -15 CALL PXERBLA( ICTXT, 'PSDTTRS: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -621,16 +665,30 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDTTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -772,6 +830,10 @@ SUBROUTINE PSDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDTTRS diff --git a/SRC/psdttrsv.f b/SRC/psdttrsv.f index ee7a46e9..8d9bd01c 100644 --- a/SRC/psdttrsv.f +++ b/SRC/psdttrsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -424,6 +431,16 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -489,6 +506,21 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, IB, INFO, JA, + $ LAF, LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSDTTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LAF:',I5,', LWORK:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -556,6 +588,10 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PSDTTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -563,6 +599,10 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, INFO = -( 9*100+4 ) CALL PXERBLA( ICTXT, 'PSDTTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -576,6 +616,10 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, INFO = -16 CALL PXERBLA( ICTXT, 'PSDTTRSV: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -645,16 +689,30 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSDTTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1483,6 +1541,10 @@ SUBROUTINE PSDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSDTTRSV diff --git a/SRC/psgbsv.f b/SRC/psgbsv.f index febb6ba6..341fcbc7 100644 --- a/SRC/psgbsv.f +++ b/SRC/psgbsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, $ DESCB, WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -389,6 +396,16 @@ SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PSGBTRF and PSGBTRS. @@ -410,11 +427,30 @@ SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, CALL PXERBLA( ICTXT, $ 'PSGBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * * Size needed for AF in factorization * @@ -432,6 +468,10 @@ SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PSGBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -445,9 +485,17 @@ SUBROUTINE PSGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGBSV diff --git a/SRC/psgbtrf.f b/SRC/psgbtrf.f index 338d79bc..3dbb9608 100644 --- a/SRC/psgbtrf.f +++ b/SRC/psgbtrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, $ WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -397,6 +404,16 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -425,6 +442,21 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGBTRF inputs: ,BWL:',I5,', BWU:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -473,12 +505,20 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, INFO = -( 1 ) CALL PXERBLA( ICTXT, 'PSGBTRF, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.( BWL+BWU+1 ) ) ) THEN INFO = -( 6*100+4 ) CALL PXERBLA( ICTXT, 'PSGBTRF, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -493,6 +533,10 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, AF( 1 ) = LAF_MIN CALL PXERBLA( ICTXT, 'PSGBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -509,6 +553,10 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, WORK( 1 ) = WORK_SIZE_MIN CALL PXERBLA( ICTXT, 'PSGBTRF: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -564,13 +612,22 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSGBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1093,6 +1150,10 @@ SUBROUTINE PSGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, END IF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGBTRF diff --git a/SRC/psgbtrs.f b/SRC/psgbtrs.f index e0edcf56..16034e64 100644 --- a/SRC/psgbtrs.f +++ b/SRC/psgbtrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -409,6 +416,16 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -467,6 +484,22 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSGBTRS inputs: ,TRANS:',A5,', BWL:',I5, + $ ', BWU:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -543,12 +576,20 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, INFO = -( 2 ) CALL PXERBLA( ICTXT, 'PSGBTRS, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.( BWL+BWU+1 ) ) ) THEN INFO = -( 8*100+4 ) CALL PXERBLA( ICTXT, 'PSGBTRS, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -564,6 +605,10 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, INFO = -16 CALL PXERBLA( ICTXT, 'PSGBTRS: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -635,16 +680,30 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSGBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1165,6 +1224,10 @@ SUBROUTINE PSGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * WORK( 1 ) = WORK_SIZE_MIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGBTRS diff --git a/SRC/psgebal.f b/SRC/psgebal.f index 66323236..e847edbb 100644 --- a/SRC/psgebal.f +++ b/SRC/psgebal.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) * * Contribution from the Department of Computing Science and HPC2N, @@ -8,6 +14,7 @@ SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -207,10 +214,33 @@ SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) INTRINSIC ABS, MAX, MIN * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F INFO = 0 ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOB, IHI, ILO, INFO, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEBAL inputs: ,JOB:',A5,', IHI:',I5, + $ ', ILO:',I5,', INFO:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. @@ -223,6 +253,10 @@ SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEBAL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -384,6 +418,10 @@ SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) * INFO = -3 CALL PXERBLA( ICTXT, 'PDGEBAL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF F = F*SCLFAC @@ -436,6 +474,10 @@ SUBROUTINE PSGEBAL( JOB, N, A, DESCA, ILO, IHI, SCALE, INFO ) ILO = K IHI = L * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEBAL diff --git a/SRC/psgebd2.f b/SRC/psgebd2.f index 89222ab6..2ed2cc83 100644 --- a/SRC/psgebd2.f +++ b/SRC/psgebd2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -267,11 +274,34 @@ SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEBD2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -305,8 +335,16 @@ SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEBD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -332,6 +370,10 @@ SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, END IF IF( MYROW.EQ.IAROW ) $ TAUP( II ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -437,6 +479,10 @@ SUBROUTINE PSGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEBD2 diff --git a/SRC/psgebrd.f b/SRC/psgebrd.f index 2c6d9e05..762652fd 100644 --- a/SRC/psgebrd.f +++ b/SRC/psgebrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -269,11 +276,34 @@ SUBROUTINE PSGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEBRD inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -312,16 +342,29 @@ SUBROUTINE PSGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEBRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * MN = MIN( M, N ) - IF( MN.EQ.0 ) - $ RETURN + IF( MN.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Initialize parameters. * @@ -405,6 +448,10 @@ SUBROUTINE PSGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEBRD diff --git a/SRC/psgecon.f b/SRC/psgecon.f index 5a0ff152..0c5a0006 100644 --- a/SRC/psgecon.f +++ b/SRC/psgecon.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ LWORK, IWORK, LIWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM INTEGER IA, INFO, JA, LIWORK, LWORK, N @@ -210,11 +217,36 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, INFO, JA, LIWORK, + $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSGECON inputs: ,NORM:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', ANORM:',I5, + $ ', RCOND:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -277,8 +309,16 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGECON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -287,11 +327,23 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, RCOND = ZERO IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( ANORM.EQ.ZERO ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( N.EQ.1 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -406,6 +458,10 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGECON diff --git a/SRC/psgeequ.f b/SRC/psgeequ.f index af6e4b5f..591a5559 100644 --- a/SRC/psgeequ.f +++ b/SRC/psgeequ.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, $ AMAX, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N REAL AMAX, COLCND, ROWCND @@ -187,11 +194,36 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, AMAX, COLCND, + $ ROWCND, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSGEEQU inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', AMAX:',I5, + $ ', COLCND:',I5,', ROWCND:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -205,6 +237,10 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEEQU', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -214,6 +250,10 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, ROWCND = ONE COLCND = ONE AMAX = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -285,8 +325,13 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 50 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -344,8 +389,13 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 110 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -360,6 +410,10 @@ SUBROUTINE PSGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEEQU diff --git a/SRC/psgehd2.f b/SRC/psgehd2.f index a6c95a1e..0f0b2468 100644 --- a/SRC/psgehd2.f +++ b/SRC/psgehd2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -216,11 +223,35 @@ SUBROUTINE PSGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEHD2 inputs: ,IA:',I5,', IHI:',I5,', ILO:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,8 +287,16 @@ SUBROUTINE PSGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEHD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -287,6 +326,10 @@ SUBROUTINE PSGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEHD2 diff --git a/SRC/psgehrd.f b/SRC/psgehrd.f index 47ad2960..a2aa4ff3 100644 --- a/SRC/psgehrd.f +++ b/SRC/psgehrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -229,11 +236,35 @@ SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEHRD inputs: ,IA:',I5,', IHI:',I5,', ILO:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -288,8 +319,16 @@ SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEHRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -310,8 +349,13 @@ SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * * Quick return if possible * - IF( IHI-ILO.LE.0 ) - $ RETURN + IF( IHI-ILO.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) @@ -375,6 +419,10 @@ SUBROUTINE PSGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = FLOAT( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEHRD diff --git a/SRC/psgelq2.f b/SRC/psgelq2.f index 156fee6c..e13c3460 100644 --- a/SRC/psgelq2.f +++ b/SRC/psgelq2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -189,11 +196,34 @@ SUBROUTINE PSGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGELQ2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -222,15 +252,28 @@ SUBROUTINE PSGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGELQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -264,6 +307,10 @@ SUBROUTINE PSGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGELQ2 diff --git a/SRC/psgelqf.f b/SRC/psgelqf.f index 645e2d26..cd0b5fbd 100644 --- a/SRC/psgelqf.f +++ b/SRC/psgelqf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PSGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGELQF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -230,15 +260,28 @@ SUBROUTINE PSGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGELQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -305,6 +348,10 @@ SUBROUTINE PSGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGELQF diff --git a/SRC/psgels.f b/SRC/psgels.f index 75c7490b..326e458a 100644 --- a/SRC/psgels.f +++ b/SRC/psgels.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, NRHS @@ -265,11 +272,36 @@ SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ LWORK, M, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSGELS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5,', JB:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -375,8 +407,16 @@ SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGELS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -385,6 +425,10 @@ SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, IF( MIN( M, N, NRHS ).EQ.0 ) THEN CALL PSLASET( 'Full', MAX( M, N ), NRHS, ZERO, ZERO, B, $ IB, JB, DESCB ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -583,6 +627,10 @@ SUBROUTINE PSGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGELS diff --git a/SRC/psgeql2.f b/SRC/psgeql2.f index 91d50351..cbfb7d93 100644 --- a/SRC/psgeql2.f +++ b/SRC/psgeql2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PSGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEQL2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -225,15 +255,28 @@ SUBROUTINE PSGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEQL2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -302,6 +345,10 @@ SUBROUTINE PSGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEQL2 diff --git a/SRC/psgeqlf.f b/SRC/psgeqlf.f index ebc54b78..0d95f733 100644 --- a/SRC/psgeqlf.f +++ b/SRC/psgeqlf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PSGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEQLF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,15 +262,28 @@ SUBROUTINE PSGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEQLF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -304,6 +347,10 @@ SUBROUTINE PSGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEQLF diff --git a/SRC/psgeqpf.f b/SRC/psgeqpf.f index dc9d2791..d688b615 100644 --- a/SRC/psgeqpf.f +++ b/SRC/psgeqpf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * and University of California, Berkeley. * November 20, 2019 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, INFO, LWORK, M, N * .. @@ -172,9 +179,9 @@ SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * * References * ========== -* +* * For modifications introduced in Scalapack 2.1 -* LAWN 295 +* LAWN 295 * New robust ScaLAPACK routine for computing the QR factorization with column pivoting * Zvonimir Bujanovic, Zlatko Drmac * http://www.netlib.org/lapack/lawnspdf/lawn295.pdf @@ -221,11 +228,34 @@ SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, INFO, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEQPF inputs: ,IA:',I5,', JA:',I5,', INFO:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -263,15 +293,28 @@ SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEQPF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) @@ -544,6 +587,10 @@ SUBROUTINE PSGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEQPF diff --git a/SRC/psgeqr2.f b/SRC/psgeqr2.f index 47594ba0..a2e57402 100644 --- a/SRC/psgeqr2.f +++ b/SRC/psgeqr2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PSGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEQR2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -224,15 +254,28 @@ SUBROUTINE PSGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEQR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -301,6 +344,10 @@ SUBROUTINE PSGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEQR2 diff --git a/SRC/psgeqrf.f b/SRC/psgeqrf.f index cfcfdcf2..65d07e37 100644 --- a/SRC/psgeqrf.f +++ b/SRC/psgeqrf.f @@ -1,8 +1,13 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 20, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) @@ -14,6 +19,7 @@ SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -182,6 +188,9 @@ SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -216,11 +225,34 @@ SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGEQRF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,15 +288,28 @@ SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGEQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -355,6 +400,10 @@ SUBROUTINE PSGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGEQRF diff --git a/SRC/psgerfs.f b/SRC/psgerfs.f index 5a9de957..3e4d0374 100644 --- a/SRC/psgerfs.f +++ b/SRC/psgerfs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, $ JAF, DESCAF, IPIV, B, IB, JB, DESCB, X, IX, $ JX, DESCX, FERR, BERR, WORK, LWORK, IWORK, @@ -8,6 +14,7 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IAF, IB, IX, INFO, JA, JAF, JB, JX, @@ -302,6 +309,16 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * .. Initialize EST EST = (0.0, 0.0) @@ -311,6 +328,24 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IAF, IB, IX, INFO, + $ JA, JAF, JB, JX, LIWORK, + $ LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSGERFS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IAF:',I5,', IB:',I5,', IX:',I5,', INFO:',I5, + $ ', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * NOTRAN = LSAME( TRANS, 'N' ) @@ -431,8 +466,16 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGERFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -447,6 +490,10 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -883,6 +930,10 @@ SUBROUTINE PSGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGERFS diff --git a/SRC/psgerq2.f b/SRC/psgerq2.f index 0a52d545..37768d41 100644 --- a/SRC/psgerq2.f +++ b/SRC/psgerq2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGERQ2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -223,15 +253,28 @@ SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGERQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -262,6 +305,10 @@ SUBROUTINE PSGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGERQ2 diff --git a/SRC/psgerqf.f b/SRC/psgerqf.f index b1a6ffbf..d22e1197 100644 --- a/SRC/psgerqf.f +++ b/SRC/psgerqf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PSGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGERQF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -230,15 +260,28 @@ SUBROUTINE PSGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGERQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -302,6 +345,10 @@ SUBROUTINE PSGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGERQF diff --git a/SRC/psgesv.f b/SRC/psgesv.f index 14664451..dc80c787 100644 --- a/SRC/psgesv.f +++ b/SRC/psgesv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * and University of California, Berkeley. * Jan 30, 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, N, NRHS * .. @@ -179,11 +186,34 @@ SUBROUTINE PSGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, N, NRHS, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGESV inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,6 +250,10 @@ SUBROUTINE PSGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGESV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -237,6 +271,10 @@ SUBROUTINE PSGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGESV diff --git a/SRC/psgesvd.f b/SRC/psgesvd.f index 43179fdf..df73302e 100644 --- a/SRC/psgesvd.f +++ b/SRC/psgesvd.f @@ -1,4 +1,10 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, + VT,IVT,JVT,DESCVT,WORK,LWORK,INFO) * @@ -8,6 +14,7 @@ SUBROUTINE PSGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * Jan 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBU,JOBVT INTEGER IA,INFO,IU,IVT,JA,JU,JVT,LWORK,M,N @@ -321,10 +328,40 @@ SUBROUTINE PSGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, INTRINSIC MAX,MIN,SQRT,REAL * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * This is just to keep ftnchek happy +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF (BLOCK_CYCLIC_2D*DTYPE_*LLD_*MB_*M_*NB_*N_.LT.0) RETURN * CALL BLACS_GRIDINFO(DESCA(CTXT_),NPROW,NPCOL,MYPROW,MYPCOL) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBU,JOBVT, IA,INFO,IU,IVT, + $ JA,JU,JVT,LWORK,M,N, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSGESVD inputs: ,JOBU:',A5,', JOBVT:',A5, + $ ', IA:',I5,', INFO:',I5,', IU:',I5, + $ ', IVT:',I5,', JA:',I5,', JU:',I5, + $ ', JVT:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF ISCALE = 0 INFO = 0 * @@ -472,6 +509,10 @@ SUBROUTINE PSGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * IF (INFO.NE.0) THEN CALL PXERBLA(DESCA(CTXT_),'PSGESVD',-INFO) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF (LWORK.EQ.-1) THEN GO TO 40 @@ -636,5 +677,9 @@ SUBROUTINE PSGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * * End of PSGESVD * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END diff --git a/SRC/psgesvx.f b/SRC/psgesvx.f index dba94419..3a7e270a 100644 --- a/SRC/psgesvx.f +++ b/SRC/psgesvx.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, $ IAF, JAF, DESCAF, IPIV, EQUED, R, C, B, IB, $ JB, DESCB, X, IX, JX, DESCX, RCOND, FERR, @@ -8,6 +14,7 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, FACT, TRANS INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, LIWORK, @@ -448,11 +455,41 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, FACT, TRANS, IA, IAF, + $ IB, INFO, IX, JA, JAF, JB, JX, LIWORK, + $ LWORK, N, NRHS, + $ RCOND, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGESVX inputs: ,EQUED:',A5,', FACT:',A5, + $ ', TRANS:',A5,', IA:',I5,', IAF:',I5, + $ ', IB:',I5,', INFO:',I5,', IX:',I5, + $ ', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', RCOND:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -651,8 +688,16 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGESVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -729,6 +774,10 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, IF( INFO.NE.0 ) THEN IF( INFO.GT.0 ) $ RCOND = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF END IF @@ -751,6 +800,10 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( RCOND.LT.PSLAMCH( ICTXT, 'Epsilon' ) ) THEN INFO = IA + N +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -822,6 +875,10 @@ SUBROUTINE PSGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGESVX diff --git a/SRC/psgetf2.f b/SRC/psgetf2.f index 4b1847a0..0add0d3d 100644 --- a/SRC/psgetf2.f +++ b/SRC/psgetf2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -159,11 +166,34 @@ SUBROUTINE PSGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGETF2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -189,13 +219,22 @@ SUBROUTINE PSGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGETF2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * MN = MIN( M, N ) CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, @@ -245,6 +284,10 @@ SUBROUTINE PSGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGETF2 diff --git a/SRC/psgetrf.f b/SRC/psgetrf.f index 3732d156..8fc55f6e 100644 --- a/SRC/psgetrf.f +++ b/SRC/psgetrf.f @@ -12,6 +12,7 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -160,6 +161,7 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -181,18 +183,35 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) INTRINSIC MIN, MOD * .. * -* Initialize framework context structure if not initialized +* .. Executable Statements .. * +* Initialize framework context structure if not initialized * CALL AOCL_SCALAPACK_INIT( ) * -* .. Executable Statements .. +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGETRF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -217,6 +236,10 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGETRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -224,8 +247,16 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( DESCA( M_ ).EQ.1 ) THEN IPIV( 1 ) = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -353,6 +384,10 @@ SUBROUTINE PSGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGETRF diff --git a/SRC/psgetri.f b/SRC/psgetri.f index f42b0057..2488ff85 100644 --- a/SRC/psgetri.f +++ b/SRC/psgetri.f @@ -1,12 +1,19 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, $ IWORK, LIWORK, INFO ) * * -- ScaLAPACK routine (version 1.7.4) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* v1.7.4: May 10, 2006 +* v1.7.4: May 10, 2006 * v1.7: May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LIWORK, LWORK, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PSGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LIWORK, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSGETRI inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -226,21 +256,21 @@ SUBROUTINE PSGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * LDW = LOCc( M_P + MOD(IP-1, MB_P) ) + * MB_P * CEIL( CEIL(LOCr(M_P)/MB_P) / (LCM/NPROW) ) * -* where +* where * M_P is the global length of the pivot vector * MP = DESCA( M_ ) + DESCA( MB_ ) * NPROW * I_P is IA * I_P = IA -* MB_P is the block size use for the block cyclic distribution of the +* MB_P is the block size use for the block cyclic distribution of the * pivot vector * MB_P = DESCA (MB_ ) -* LOCc ( . ) +* LOCc ( . ) * NUMROC ( . , DESCA ( NB_ ), MYCOL, DESCA ( CSRC_ ), NPCOL ) * LOCr ( . ) * NUMROC ( . , DESCA ( MB_ ), MYROW, DESCA ( RSRC_ ), NPROW ) * CEIL ( X / Y ) * ICEIL( X, Y ) -* LCM +* LCM * LCM = ILCM( NPROW, NPCOL ) * LCM = ILCM( NPROW, NPCOL ) @@ -285,22 +315,40 @@ SUBROUTINE PSGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGETRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Form inv(U). If INFO > 0 from PSTRTRI, then U is singular, * and the inverse is not computed. * CALL PSTRTRI( 'Upper', 'Non-unit', N, A, IA, JA, DESCA, INFO ) - IF( INFO.GT.0 ) - $ RETURN + IF( INFO.GT.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Define array descriptor for working array WORK * @@ -367,6 +415,10 @@ SUBROUTINE PSGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGETRI diff --git a/SRC/psgetrs.f b/SRC/psgetrs.f index 2b0cc68d..041b38d3 100644 --- a/SRC/psgetrs.f +++ b/SRC/psgetrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, $ IB, JB, DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -179,11 +186,36 @@ SUBROUTINE PSGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGETRS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5, + $ ', JB:',I5,', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,13 +264,22 @@ SUBROUTINE PSGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGETRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL DESCSET( DESCIP, DESCA( M_ ) + DESCA( MB_ )*NPROW, 1, $ DESCA( MB_ ), 1, DESCA( RSRC_ ), MYCOL, ICTXT, @@ -284,6 +325,10 @@ SUBROUTINE PSGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGETRS diff --git a/SRC/psggqrf.f b/SRC/psggqrf.f index a7770a56..d6641a90 100644 --- a/SRC/psggqrf.f +++ b/SRC/psggqrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -282,11 +289,36 @@ SUBROUTINE PSGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGGQRF inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', P:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -342,8 +374,16 @@ SUBROUTINE PSGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGGQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -363,6 +403,10 @@ SUBROUTINE PSGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PSGERQF( N, P, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = REAL( MAX( LWMIN, INT( WORK( 1 ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGGQRF diff --git a/SRC/psggrqf.f b/SRC/psggrqf.f index 5728a2f0..f504f8bc 100644 --- a/SRC/psggrqf.f +++ b/SRC/psggrqf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -282,11 +289,36 @@ SUBROUTINE PSGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSGGRQF inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', P:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -342,8 +374,16 @@ SUBROUTINE PSGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSGGRQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -364,6 +404,10 @@ SUBROUTINE PSGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PSGEQRF( P, N, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = REAL( MAX( LWMIN, INT( WORK( 1 ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSGGRQF diff --git a/SRC/pslabad.f b/SRC/pslabad.f index 31e6d011..9dc27610 100644 --- a/SRC/pslabad.f +++ b/SRC/pslabad.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLABAD( ICTXT, SMALL, LARGE ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLABAD( ICTXT, SMALL, LARGE ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER ICTXT REAL LARGE, SMALL @@ -55,6 +62,16 @@ SUBROUTINE PSLABAD( ICTXT, SMALL, LARGE ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * If it looks like we're on a Cray, take the square root of * SMALL and LARGE to avoid overflow and underflow problems. * @@ -69,6 +86,10 @@ SUBROUTINE PSLABAD( ICTXT, SMALL, LARGE ) CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, LARGE, 1, IDUMM, $ IDUMM, -1, -1, IDUMM ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLABAD diff --git a/SRC/pslabrd.f b/SRC/pslabrd.f index 7f01eac5..0c4893b0 100644 --- a/SRC/pslabrd.f +++ b/SRC/pslabrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ X, IX, JX, DESCX, Y, IY, JY, DESCY, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IX, IY, JA, JX, JY, M, N, NB * .. @@ -271,13 +278,42 @@ SUBROUTINE PSLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, + $ N, NB, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLABRD inputs: ,IA:',I5,', IX:',I5,', IY:',I5, + $ ', JA:',I5,', JX:',I5,', JY:',I5, + $ ', M:',I5,', N:',I5,', NB:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, JJ, $ IAROW, IACOL ) IPY = DESCA( MB_ ) + 1 @@ -487,6 +523,10 @@ SUBROUTINE PSLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, 20 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLABRD From 6e3dbacb3e815ca0a53d5fc51cfc0331cdb91c2c Mon Sep 17 00:00:00 2001 From: nprasadm Date: Tue, 12 Sep 2023 10:51:42 +0530 Subject: [PATCH 13/29] TESTING/README.txt updated with prerequisites for running the test-suite. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3509] Change-Id: Ic2aebf6ad9321c8adeb2da076e2b51e276c2f772 --- TESTING/README.txt | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/TESTING/README.txt b/TESTING/README.txt index 7e92a360..6b5e9fe6 100644 --- a/TESTING/README.txt +++ b/TESTING/README.txt @@ -5,8 +5,13 @@ To execute AOCL-ScaLAPACK test suite against different MPI configurations (ranks, binding, etc) you can use the script called '/scalapack_test.sh' -Upon running scalapack_test.sh the results will be saved in the -directory $HOME/aocl_scalapack_testing_results. The script provides +Ensure that the run time environment is configured for the maximum stack size: + +Eg: For Linux, execute the below command before running the tests: +"ulimit -s unlimited" + +Upon running 'scalapack_test.sh' the results will be saved in the +directory '$HOME/aocl_scalapack_testing_results'. The script provides several command line options, and if no arguments are given, the following default options will be used: @@ -25,6 +30,9 @@ Eg: To test only single precision cholesky transformation for all the MPI mapping for ranks between 4 to 16 use $ scalapack_test.sh -t xsllt -s 4 -i 1 -e 16 -c all +Eg: To test all the programs on a machine with 'n' cores + $ scalapack_test.sh -t all -s + Eg: To test all the programs with maximum avialable ranks with MPI mapping "map-by l3cache" $ scalapack_test.sh -t all -c map_l3cache From e0bedcf8ceb01179e00215c9e278769c229b59d2 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Mon, 11 Sep 2023 15:05:10 +0530 Subject: [PATCH 14/29] Trace and Logging feature enabled for 55 float data type APIs. Corrected Trace call in 'pdlamch' API. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: Ia58e31ce2d94ddd0223e5a0a9eb4770ea781ea57 --- SRC/pdlamch.f | 4 +++ SRC/psgecon.f | 4 +-- SRC/pslacon.f | 62 +++++++++++++++++++++++++++++++++-- SRC/pslaconsb.f | 37 +++++++++++++++++++++ SRC/pslacp2.f | 60 ++++++++++++++++++++++++++++++---- SRC/pslacp3.f | 44 ++++++++++++++++++++++--- SRC/pslacpy.f | 42 ++++++++++++++++++++++-- SRC/pslaed0.f | 47 ++++++++++++++++++++++++++- SRC/pslaed1.f | 54 +++++++++++++++++++++++++++++-- SRC/pslaed2.f | 46 ++++++++++++++++++++++++-- SRC/pslaed3.f | 43 +++++++++++++++++++++++-- SRC/pslaedz.f | 39 +++++++++++++++++++++- SRC/pslaevswp.f | 37 ++++++++++++++++++++- SRC/pslahqr.f | 55 +++++++++++++++++++++++++++++-- SRC/pslahrd.f | 41 +++++++++++++++++++++-- SRC/pslamch.f | 30 +++++++++++++++++ SRC/pslamr1d.f | 48 +++++++++++++++++++++++++-- SRC/pslamve.f | 34 +++++++++++++++++++ SRC/pslange.f | 34 +++++++++++++++++++ SRC/pslanhs.f | 33 +++++++++++++++++++ SRC/pslansy.f | 34 +++++++++++++++++++ SRC/pslantr.f | 34 +++++++++++++++++++ SRC/pslapiv.f | 54 ++++++++++++++++++++++++++++--- SRC/pslapv2.f | 51 ++++++++++++++++++++++++++--- SRC/pslaqge.f | 37 +++++++++++++++++++++ SRC/pslaqr0.f | 46 ++++++++++++++++++++++++++ SRC/pslaqr1.f | 83 +++++++++++++++++++++++++++++++++++++++++------ SRC/pslaqr2.f | 45 ++++++++++++++++++++++++-- SRC/pslaqr3.f | 81 ++++++++++++++++++++++++++++++++++++++++------ SRC/pslaqr4.f | 45 ++++++++++++++++++++++++-- SRC/pslaqr5.f | 86 ++++++++++++++++++++++++++++++++++++++++++++----- SRC/pslaqsy.f | 37 +++++++++++++++++++++ SRC/pslared1d.f | 39 +++++++++++++++++++++- SRC/pslared2d.f | 39 +++++++++++++++++++++- SRC/pslarf.f | 42 ++++++++++++++++++++++-- SRC/pslarfb.f | 43 +++++++++++++++++++++++-- SRC/pslarfg.f | 57 +++++++++++++++++++++++++++++--- SRC/pslarft.f | 42 ++++++++++++++++++++++-- SRC/pslarz.f | 42 ++++++++++++++++++++++-- SRC/pslarzb.f | 49 ++++++++++++++++++++++++++-- SRC/pslarzt.f | 37 +++++++++++++++++++++ SRC/pslascl.f | 49 ++++++++++++++++++++++++++-- SRC/pslase2.f | 60 ++++++++++++++++++++++++++++++---- SRC/pslaset.f | 42 ++++++++++++++++++++++-- SRC/pslasmsub.f | 40 ++++++++++++++++++++++- SRC/pslasrt.f | 56 +++++++++++++++++++++++++++++--- SRC/pslassq.f | 52 +++++++++++++++++++++++++++--- SRC/pslaswp.f | 42 ++++++++++++++++++++++-- SRC/pslatra.f | 37 +++++++++++++++++++++ SRC/pslatrd.f | 42 ++++++++++++++++++++++-- SRC/pslatrs.f | 46 ++++++++++++++++++++++++-- SRC/pslatrz.f | 40 +++++++++++++++++++++-- SRC/pslauu2.f | 40 +++++++++++++++++++++-- SRC/pslauum.f | 40 +++++++++++++++++++++-- SRC/pslawil.f | 43 +++++++++++++++++++++++-- 55 files changed, 2324 insertions(+), 122 deletions(-) diff --git a/SRC/pdlamch.f b/SRC/pdlamch.f index 29819bc4..260ea25c 100644 --- a/SRC/pdlamch.f +++ b/SRC/pdlamch.f @@ -104,6 +104,10 @@ DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH ) * PDLAMCH = TEMP * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDLAMCH * END diff --git a/SRC/psgecon.f b/SRC/psgecon.f index 0c5a0006..49107a0d 100644 --- a/SRC/psgecon.f +++ b/SRC/psgecon.f @@ -241,8 +241,8 @@ SUBROUTINE PSGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ MYROW, MYCOL, eos_str 102 FORMAT('PSGECON inputs: ,NORM:',A5,', IA:',I5, $ ', INFO:',I5,', JA:',I5,', LIWORK:',I5, - $ ', LWORK:',I5,', N:',I5,', ANORM:',I5, - $ ', RCOND:',I5,', NPROW: ', I5, + $ ', LWORK:',I5,', N:',I5,', ANORM:',F9.4, + $ ', RCOND:',F9.4,', NPROW: ', I5, $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) AOCL_DTL_LOG_ENTRY_F END IF diff --git a/SRC/pslacon.f b/SRC/pslacon.f index 673bf1a9..62bc9572 100644 --- a/SRC/pslacon.f +++ b/SRC/pslacon.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, $ EST, KASE ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IV, IX, JV, JX, KASE, N REAL EST @@ -184,6 +191,28 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IV, IX, JV, JX, KASE, N, EST, + $ eos_str + 102 FORMAT('PSLACON inputs: ,IV:',I5,', IX:',I5,', JV:',I5, + $ ', JX:',I5,', KASE:',I5,', N:',I5, + $ ', EST:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Get grid parameters. * ESTWORK( 1 ) = EST @@ -192,8 +221,13 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIVX, JJVX, IVXROW, IVXCOL ) - IF( MYCOL.NE.IVXCOL ) - $ RETURN + IF( MYCOL.NE.IVXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFF = MOD( IX-1, DESCX( MB_ ) ) NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IVXROW, NPROW ) IF( MYROW.EQ.IVXROW ) @@ -206,6 +240,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, 10 CONTINUE KASE = 1 JUMP = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -243,6 +281,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, 30 CONTINUE KASE = 2 JUMP = 2 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 2) @@ -277,6 +319,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, END IF KASE = 1 JUMP = 3 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 3) @@ -317,6 +363,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, 100 CONTINUE KASE = 2 JUMP = 4 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 4) @@ -358,6 +408,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, 130 CONTINUE KASE = 1 JUMP = 5 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 5) @@ -383,6 +437,10 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, KASE = 0 * EST = ESTWORK( 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLACON diff --git a/SRC/pslaconsb.f b/SRC/pslaconsb.f index 9aa7fd24..66fe05f4 100644 --- a/SRC/pslaconsb.f +++ b/SRC/pslaconsb.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, $ LWORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, L, LWORK, M REAL H33, H43H34, H44 @@ -182,6 +189,28 @@ SUBROUTINE PSLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, INTRINSIC ABS, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, L, LWORK, M, H33, H43H34, + $ H44, eos_str + 102 FORMAT('PSLACONSB inputs: ,I:',I5,', L:',I5,', LWORK:',I5, + $ ', M:',I5,', H33:',F9.4, + $ ', H43H34:',F9.4,', H44:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) @@ -212,6 +241,10 @@ SUBROUTINE PSLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, END IF IF( LWORK.LT.7*ISTR2 ) THEN CALL PXERBLA( CONTXT, 'PSLACONSB', 10 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ISTR3 = 3*ISTR2 @@ -567,6 +600,10 @@ SUBROUTINE PSLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * CALL IGAMX2D( CONTXT, 'ALL', ' ', 1, 1, M, 1, L, L, -1, -1, -1 ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLACONSB diff --git a/SRC/pslacp2.f b/SRC/pslacp2.f index f30317ae..0252e455 100644 --- a/SRC/pslacp2.f +++ b/SRC/pslacp2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -5,6 +11,7 @@ SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -168,8 +175,35 @@ SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PSLACP2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -228,8 +262,13 @@ SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYCOL.EQ.IACOL ) THEN * MP = NUMROC( M+IROFFA, MBA, MYROW, IAROW, NPROW ) - IF( MP.LE.0 ) - $ RETURN + IF( MP.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYROW.EQ.IAROW ) $ MP = MP - IROFFA MYDIST = MOD( MYROW-IAROW+NPROW, NPROW ) @@ -326,8 +365,13 @@ SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYROW.EQ.IAROW ) THEN * NQ = NUMROC( N+ICOFFA, NBA, MYCOL, IACOL, NPCOL ) - IF( NQ.LE.0 ) - $ RETURN + IF( NQ.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYCOL.EQ.IACOL ) $ NQ = NQ - ICOFFA MYDIST = MOD( MYCOL-IACOL+NPCOL, NPCOL ) @@ -398,6 +442,10 @@ SUBROUTINE PSLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLACP2 diff --git a/SRC/pslacp3.f b/SRC/pslacp3.f index 0207f840..a5059d8b 100644 --- a/SRC/pslacp3.f +++ b/SRC/pslacp3.f @@ -1,4 +1,11 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK routine (version 1.7) -- @@ -109,7 +116,7 @@ SUBROUTINE PSLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * II (global input) INTEGER * By using REV 0 & 1, data can be sent out and returned again. * If REV=0, then II is destination row index for the node(s) -* receiving the replicated B. +* receiving the replicated B. * If II>=0,JJ>=0, then node (II,JJ) receives the data * If II=-1,JJ>=0, then all rows in column JJ receive the * data @@ -122,7 +129,7 @@ SUBROUTINE PSLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * Similar description as II above * * REV (global input) INTEGER -* Use REV = 0 to send global A into locally replicated B +* Use REV = 0 to send global A into locally replicated B * (on node (II,JJ)). * Use REV <> 0 to send locally replicated B from node (II,JJ) * to its owner (which changes depending on its location in @@ -160,8 +167,33 @@ SUBROUTINE PSLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * .. * .. Executable Statements .. * - IF( M.LE.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, eos_str + 102 FORMAT('PSLACP3 inputs: ,I:',I5,', II:',I5,', JJ:',I5, + $ ', LDB:',I5,', M:',I5,', REV:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) @@ -306,6 +338,10 @@ SUBROUTINE PSLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) IF( IDJ.LE.IFIN ) $ GO TO 30 END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLACP3 diff --git a/SRC/pslacpy.f b/SRC/pslacpy.f index 4c68c7e9..ab0019da 100644 --- a/SRC/pslacpy.f +++ b/SRC/pslacpy.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -162,8 +169,35 @@ SUBROUTINE PSLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PSLACPY inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) @@ -224,6 +258,10 @@ SUBROUTINE PSLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLACPY diff --git a/SRC/pslaed0.f b/SRC/pslaed0.f index 534dc803..543b2074 100644 --- a/SRC/pslaed0.f +++ b/SRC/pslaed0.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, IQ, JQ, N * .. @@ -99,9 +106,35 @@ SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, IQ, JQ, N, eos_str + 102 FORMAT('PSLAED0 inputs: ,INFO:',I5,', IQ:',I5, + $ ', JQ:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Test the input parameters. * @@ -111,6 +144,10 @@ SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) $ INFO = -1 IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCQ( CTXT_ ), 'PSLAED0', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -160,6 +197,10 @@ SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) $ WORK, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCQ( CTXT_ ), 'SSTEQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF IF( MYROW.NE.IQROW .OR. MYCOL.NE.IQCOL ) THEN @@ -224,6 +265,10 @@ SUBROUTINE PSLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * end while * 90 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAED0 diff --git a/SRC/pslaed1.f b/SRC/pslaed1.f index 6b78603b..dcc10cea 100644 --- a/SRC/pslaed1.f +++ b/SRC/pslaed1.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, $ IWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER ID, INFO, IQ, JQ, N, N1 REAL RHO @@ -138,9 +145,37 @@ SUBROUTINE PSLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, N, N1, RHO, + $ eos_str + 102 FORMAT('PSLAED1 inputs: ,ID:',I5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', N:',I5,', N1:',I5, + $ ', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Test the input parameters. @@ -158,13 +193,22 @@ SUBROUTINE PSLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCQ( CTXT_ ), 'PSLAED1', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * The following values are integer pointers which indicate * the portion of the workspace used by a particular array @@ -264,6 +308,10 @@ SUBROUTINE PSLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, END IF * 20 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAED1 diff --git a/SRC/pslaed2.f b/SRC/pslaed2.f index b764b9d0..e980ccac 100644 --- a/SRC/pslaed2.f +++ b/SRC/pslaed2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, $ RHO, Z, W, DLAMDA, Q2, LDQ2, QBUF, CTOT, PSM, $ NPCOL, INDX, INDXC, INDXP, INDCOL, COLTYP, NN, @@ -8,6 +14,7 @@ SUBROUTINE PSLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER DCOL, DROW, IB1, IB2, ICTXT, K, LDQ, LDQ2, N, $ N1, NB, NN, NN1, NN2, NPCOL @@ -179,10 +186,41 @@ SUBROUTINE PSLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DCOL, DROW, IB1, IB2, ICTXT, + $ K, LDQ, LDQ2, N, N1, + $ NB, NN, NN1, NN2, NPCOL, RHO, eos_str + 102 FORMAT('PSLAED2 inputs: ,DCOL:',I5,', DROW:',I5, + $ ', IB1:',I5,', IB2:',I5,', ICTXT:',I5, + $ ', K:',I5,', LDQ:',I5,', LDQ2:',I5, + $ ', N:',I5,', N1:',I5,', NB:',I5,', NN:',I5, + $ ', NN1:',I5,', NN2:',I5,', NPCOL:',I5, + $ ', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_PINFO( IAM, NPROCS ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -446,6 +484,10 @@ SUBROUTINE PSLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, NN2 = IE2 - IB2 + 1 NN = MAX( IE1, IE2 ) - MIN( IB1, IB2 ) + 1 220 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAED2 diff --git a/SRC/pslaed3.f b/SRC/pslaed3.f index a4854760..ec58a5ae 100644 --- a/SRC/pslaed3.f +++ b/SRC/pslaed3.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, $ W, Z, U, LDU, BUF, INDX, INDCOL, INDROW, $ INDXR, INDXC, CTOT, NPCOL, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PSLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER DCOL, DROW, ICTXT, INFO, K, LDU, N, NB, NPCOL REAL RHO @@ -150,14 +157,42 @@ SUBROUTINE PSLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DCOL, DROW, ICTXT, INFO, K, + $ LDU, N, NB, NPCOL, RHO, eos_str + 102 FORMAT('PSLAED3 inputs: ,DCOL:',I5,', DROW:',I5, + $ ', ICTXT:',I5,', INFO:',I5,', K:',I5, + $ ', LDU:',I5,', N:',I5,', NB:',I5, + $ ', NPCOL:',I5,', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * IINFO = 0 * * Quick return if possible * - IF( K.EQ.0 ) - $ RETURN + IF( K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * @@ -340,6 +375,10 @@ SUBROUTINE PSLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, END IF * 190 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAED3 diff --git a/SRC/pslaedz.f b/SRC/pslaedz.f index 68357d62..50093ee1 100644 --- a/SRC/pslaedz.f +++ b/SRC/pslaedz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER ID, IQ, JQ, LDQ, N, N1 * .. @@ -48,9 +55,35 @@ SUBROUTINE PSLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, IQ, JQ, LDQ, N, N1, eos_str + 102 FORMAT('PSLAEDZ inputs: ,ID:',I5,', IQ:',I5,', JQ:',I5, + $ ', LDQ:',I5,', N:',I5,', N1:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCQ( CTXT_ ) NB = DESCQ( NB_ ) @@ -145,6 +178,10 @@ SUBROUTINE PSLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) CALL SGEBR2D( ICTXT, 'All', ' ', N, 1, Z, N, IQROW, IQCOL ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAEDZ diff --git a/SRC/pslaevswp.f b/SRC/pslaevswp.f index eacc83b8..2eb22c77 100644 --- a/SRC/pslaevswp.f +++ b/SRC/pslaevswp.f @@ -1,4 +1,8 @@ * +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PSLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, $ WORK, LWORK ) @@ -8,6 +12,7 @@ SUBROUTINE PSLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * and University of California, Berkeley. * April 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IZ, JZ, LDZI, LWORK, N * .. @@ -153,9 +158,35 @@ SUBROUTINE PSLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, INTRINSIC MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IZ, JZ, LDZI, LWORK, N, eos_str + 102 FORMAT('PSLAEVSWP inputs: ,IZ:',I5,', JZ:',I5, + $ ', LDZI:',I5,', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) IAM = MYROW + MYCOL*NPROW IAM = MYROW*NPCOL + MYCOL @@ -279,6 +310,10 @@ SUBROUTINE PSLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, 100 CONTINUE * 110 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAEVSWP diff --git a/SRC/pslahqr.f b/SRC/pslahqr.f index 0753f513..acd292d9 100644 --- a/SRC/pslahqr.f +++ b/SRC/pslahqr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, $ ILOZ, IHIZ, Z, DESCZ, WORK, LWORK, IWORK, $ ILWORK, INFO ) @@ -6,6 +12,7 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. LOGICAL WANTT, WANTZ INTEGER IHI, IHIZ, ILO, ILOZ, ILWORK, INFO, LWORK, N @@ -280,13 +287,41 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, INTRINSIC ABS, MAX, MIN, MOD, SIGN, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, ILWORK, INFO, LWORK, N, eos_str + 102 FORMAT('PSLAHQR inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', ILWORK:',I5,', INFO:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * ITERMAX = 30*( IHI-ILO+1 ) * ITERMAX = 0 - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * NODE (IAFIRST,JAFIRST) OWNS A(1,1) * @@ -346,6 +381,10 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, $ -1, -1 ) IF( INFO.LT.0 ) THEN CALL PXERBLA( CONTXT, 'PSLAHQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -373,6 +412,10 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, WR( ILO ) = ZERO END IF WI( ILO ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -2002,6 +2045,10 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * Failure to converge in remaining number of iterations * INFO = I +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * 430 CONTINUE @@ -2070,6 +2117,10 @@ SUBROUTINE PSLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, 450 CONTINUE CALL SGSUM2D( CONTXT, 'All', ' ', N, 1, WR, N, -1, -1 ) CALL SGSUM2D( CONTXT, 'All', ' ', N, 1, WI, N, -1, -1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * END OF PSLAHQR diff --git a/SRC/pslahrd.f b/SRC/pslahrd.f index e54237d1..e68ae787 100644 --- a/SRC/pslahrd.f +++ b/SRC/pslahrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, $ DESCY, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * and University of California, Berkeley. * January 30, 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IY, JA, JY, K, N, NB * .. @@ -160,10 +167,36 @@ SUBROUTINE PSLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IY, JA, JY, K, N, NB, eos_str + 102 FORMAT('PSLAHRD inputs: ,IA:',I5,', IY:',I5,', JA:',I5, + $ ', JY:',I5,', K:',I5,', N:',I5, + $ ', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.1 ) - $ RETURN + IF( N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -280,6 +313,10 @@ SUBROUTINE PSLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * CALL PSELSET( A, K+NB+IA-1, J, DESCA, EI ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAHRD diff --git a/SRC/pslamch.f b/SRC/pslamch.f index cddd7654..6d929f45 100644 --- a/SRC/pslamch.f +++ b/SRC/pslamch.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLAMCH( ICTXT, CMACH ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ REAL FUNCTION PSLAMCH( ICTXT, CMACH ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER CMACH INTEGER ICTXT @@ -63,6 +70,25 @@ REAL FUNCTION PSLAMCH( ICTXT, CMACH ) EXTERNAL LSAME, SLAMCH * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) CMACH, ICTXT, eos_str + 102 FORMAT('PSLAMCH inputs: ,CMACH:',A5,', ICTXT:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * TEMP = SLAMCH( CMACH ) IDUMM = 0 @@ -78,6 +104,10 @@ REAL FUNCTION PSLAMCH( ICTXT, CMACH ) * PSLAMCH = TEMP * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSLAMCH * END diff --git a/SRC/pslamr1d.f b/SRC/pslamr1d.f index a1f5dddc..d5ab6f9f 100644 --- a/SRC/pslamr1d.f +++ b/SRC/pslamr1d.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, JA, JB, N * .. @@ -106,14 +113,45 @@ SUBROUTINE PSLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) EXTERNAL NUMROC * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, JA, JB, N, eos_str + 102 FORMAT('PSLAMR1D inputs: ,IA:',I5,', IB:',I5,', JA:',I5, + $ ', JB:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * DO 10 I = 1, DLEN_ DESCAA( I ) = DESCA( I ) @@ -137,6 +175,10 @@ SUBROUTINE PSLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) CALL SGEBR2D( ICTXT, 'C', ' ', NQ, 1, B, NQ, 0, MYCOL ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAMR1D diff --git a/SRC/pslamve.f b/SRC/pslamve.f index 11247cd3..fddddbb4 100644 --- a/SRC/pslamve.f +++ b/SRC/pslamve.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, DWORK ) * @@ -8,6 +14,7 @@ SUBROUTINE PSLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -167,11 +174,34 @@ SUBROUTINE PSLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Find underlying mesh properties. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLAMVE inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Decode input parameters. * UPPER = LSAME( UPLO, 'U' ) @@ -198,6 +228,10 @@ SUBROUTINE PSLAMVE( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAMVE diff --git a/SRC/pslange.f b/SRC/pslange.f index 00cb5fbf..5f8fe278 100644 --- a/SRC/pslange.f +++ b/SRC/pslange.f @@ -1,5 +1,12 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLANGE( NORM, M, N, A, IA, JA, DESCA, $ WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -177,10 +184,33 @@ REAL FUNCTION PSLANGE( NORM, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', IA:',I5,', JA:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, JJ, $ IAROW, IACOL ) @@ -332,6 +362,10 @@ REAL FUNCTION PSLANGE( NORM, M, N, A, IA, JA, DESCA, * PSLANGE = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLANGE diff --git a/SRC/pslanhs.f b/SRC/pslanhs.f index 715dedaa..67888cb3 100644 --- a/SRC/pslanhs.f +++ b/SRC/pslanhs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLANHS( NORM, N, A, IA, JA, DESCA, $ WORK ) * @@ -6,6 +12,7 @@ REAL FUNCTION PSLANHS( NORM, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM INTEGER IA, JA, N @@ -171,10 +178,32 @@ REAL FUNCTION PSLANHS( NORM, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, JA, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', IA:',I5,', JA:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) @@ -733,6 +762,10 @@ REAL FUNCTION PSLANHS( NORM, N, A, IA, JA, DESCA, * PSLANHS = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLANHS diff --git a/SRC/pslansy.f b/SRC/pslansy.f index bfe1d9e1..a629243b 100644 --- a/SRC/pslansy.f +++ b/SRC/pslansy.f @@ -1,5 +1,12 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLANSY( NORM, UPLO, N, A, IA, JA, $ DESCA, WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -194,10 +201,33 @@ REAL FUNCTION PSLANSY( NORM, UPLO, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters and local indexes. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, UPLO, IA, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, $ IIA, JJA, IAROW, IACOL ) * @@ -856,6 +886,10 @@ REAL FUNCTION PSLANSY( NORM, UPLO, N, A, IA, JA, * PSLANSY = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLANSY diff --git a/SRC/pslantr.f b/SRC/pslantr.f index 2f97388c..945c37ce 100644 --- a/SRC/pslantr.f +++ b/SRC/pslantr.f @@ -1,5 +1,12 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLANTR( NORM, UPLO, DIAG, M, N, A, $ IA, JA, DESCA, WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -193,10 +200,33 @@ REAL FUNCTION PSLANTR( NORM, UPLO, DIAG, M, N, A, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,DIAG:',A5,', NORM:',A5,', UPLO:',A5, + $ ', IA:',I5,', JA:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * UDIAG = LSAME( DIAG, 'U' ) CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, @@ -1097,6 +1127,10 @@ REAL FUNCTION PSLANTR( NORM, UPLO, DIAG, M, N, A, * PSLANTR = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLANTR diff --git a/SRC/pslapiv.f b/SRC/pslapiv.f index df6f2abc..ac0220ff 100644 --- a/SRC/pslapiv.f +++ b/SRC/pslapiv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, $ DESCA, IPIV, IP, JP, DESCIP, IWORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER*1 DIREC, PIVROC, ROWCOL INTEGER IA, IP, JA, JP, M, N @@ -224,17 +231,47 @@ SUBROUTINE PSLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, PIVROC, ROWCOL, IA, + $ IP, JA, JP, M, N, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSLAPIV inputs: ,DIREC:',A2,', PIVROC:',A2, + $ ', ROWCOL:',A2,', IA:',I5,', IP:',I5, + $ ', JA:',I5,', JP:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF ROWPVT = LSAME( ROWCOL, 'R' ) * * If we're pivoting the rows of sub( A ) * IF( ROWPVT ) THEN - IF( M.LE.1 .OR. N.LT.1 ) - $ RETURN + IF( M.LE.1 .OR. N.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * If the pivot vector is already distributed correctly * @@ -293,8 +330,13 @@ SUBROUTINE PSLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * Otherwise, we're pivoting the columns of sub( A ) * ELSE - IF( M.LT.1 .OR. N.LE.1 ) - $ RETURN + IF( M.LT.1 .OR. N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * If the pivot vector is already distributed correctly * @@ -349,6 +391,10 @@ SUBROUTINE PSLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAPIV diff --git a/SRC/pslapv2.f b/SRC/pslapv2.f index a2ef95db..f6cb237d 100644 --- a/SRC/pslapv2.f +++ b/SRC/pslapv2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, $ IP, JP, DESCIP ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIREC, ROWCOL INTEGER IA, IP, JA, JP, M, N @@ -168,14 +175,46 @@ SUBROUTINE PSLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, INTRINSIC MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, IP, JA, + $ JP, M, N, eos_str + 102 FORMAT('PSLAPV2 inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I5,', IP:',I5,', JA:',I5, + $ ', JP:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * ROWPVT = LSAME( ROWCOL, 'R' ) IF( ROWPVT ) THEN - IF( M.LE.1 .OR. N.LT.1 ) - $ RETURN + IF( M.LE.1 .OR. N.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE - IF( M.LT.1 .OR. N.LE.1 ) - $ RETURN + IF( M.LT.1 .OR. N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF FORWRD = LSAME( DIREC, 'F' ) * @@ -406,6 +445,10 @@ SUBROUTINE PSLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PSLAPV2 diff --git a/SRC/pslaqge.f b/SRC/pslaqge.f index 2b74aba1..d4298bd0 100644 --- a/SRC/pslaqge.f +++ b/SRC/pslaqge.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, $ AMAX, EQUED ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED INTEGER IA, JA, M, N @@ -179,10 +186,36 @@ SUBROUTINE PSLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, IA, JA, M, N, AMAX, + $ COLCND, ROWCND, eos_str + 102 FORMAT('PSLAQGE inputs: ,EQUED:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', AMAX:',F9.4, + $ ', COLCND:',F9.4,', ROWCND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN EQUED = 'N' +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -263,6 +296,10 @@ SUBROUTINE PSLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAQGE diff --git a/SRC/pslaqr0.f b/SRC/pslaqr0.f index 663cccb6..de0f45c9 100644 --- a/SRC/pslaqr0.f +++ b/SRC/pslaqr0.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, $ DESCH, WR, WI, ILOZ, IHIZ, Z, DESCZ, WORK, LWORK, $ IWORK, LIWORK, INFO, RECLEVEL ) @@ -10,6 +16,7 @@ RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -291,9 +298,36 @@ RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, INTRINSIC ABS, FLOAT, INT, MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F INFO = 0 ICTXT = DESCH( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IHI, IHIZ, ILO, ILOZ, INFO, + $ LIWORK, LWORK, N, RECLEVEL, + $ WANTT, WANTZ, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSLAQR0 inputs: ,IHI:',I5,', IHIZ:',I5, + $ ', ILO:',I5,', ILOZ:',I5,', INFO:',I5, + $ ', LIWORK:',I5,', LWORK:',I5,', N:',I5, + $ ', RECLEVEL:',I5,', WANTT:',L1, + $ ', WANTZ:',L1,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL RECURSION = RECLEVEL .LT. RECMAX * @@ -302,6 +336,10 @@ RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, IF( N.EQ.0 ) THEN WORK( 1 ) = ONE IWORK( 1 ) = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -425,6 +463,10 @@ RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, IF( LQUERY ) THEN WORK( 1 ) = FLOAT( LWKOPT ) IWORK( 1 ) = LIWKOPT +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -922,6 +964,10 @@ RECURSIVE SUBROUTINE PSLAQR0( WANTT, WANTZ, N, ILO, IHI, H, IWORK( 2 ) = SWEEP IWORK( 3 ) = TOTNS END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAQR0 diff --git a/SRC/pslaqr1.f b/SRC/pslaqr1.f index a4d560a9..312bded3 100644 --- a/SRC/pslaqr1.f +++ b/SRC/pslaqr1.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, $ DESCA, WR, WI, ILOZ, IHIZ, Z, $ DESCZ, WORK, LWORK, IWORK, @@ -11,6 +17,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -302,12 +309,40 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, INTRINSIC ABS, FLOAT, MAX, MIN, MOD, SIGN, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, ILWORK, INFO, LWORK, N, eos_str + 102 FORMAT('PSLAQR1 inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', ILWORK:',I5,', INFO:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * ITERMAX = 30*( IHI-ILO+1 ) - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * NODE (IAFIRST,JAFIRST) OWNS A(1,1) * @@ -341,6 +376,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, IF( LWORK.EQ.-1 .OR. ILWORK.EQ.-1 ) THEN WORK( 1 ) = FLOAT( LWKOPT ) IWORK( 1 ) = 3 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSEIF( LWORK.LT.LWKOPT ) THEN INFO = -15 @@ -371,6 +410,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, IF( INFO.LT.0 ) THEN CALL PXERBLA( CONTXT, 'PSLAQR1', -INFO ) WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -400,6 +443,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, END IF WI( ILO ) = ZERO WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -415,6 +462,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, $ WORK( S2+1 ), NH, WORK( S3+1 ), 4*LDS*LDS, $ INFO ) WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1326,7 +1377,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, $ ( MOD( ISTART-1, HBL ).LT.HBL-2 ) .AND. $ ( ICURROW( KI ).EQ.MYROW ) ) THEN IROW1 = MIN( K2( KI )+1, I-1 ) + 1 - CALL INFOG1L( IROW1, HBL, NPCOL, MYCOL, DESCA(CSRC_), + CALL INFOG1L( IROW1, HBL, NPCOL, MYCOL, DESCA(CSRC_), $ ITMP1, ITMP2 ) ITMP2 = NUMROC( I2, HBL, MYCOL, DESCA(CSRC_), NPCOL ) II = KROW( KI ) @@ -1373,7 +1424,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * IROW1 = KROW( KI ) IROW2 = KP2ROW( KI ) - CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, + CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, $ DESCA(CSRC_), ICOL1, ICOL2 ) ICOL2 = NUMROC(I2,HBL,MYCOL,DESCA(CSRC_),NPCOL ) IF( ( MOD( K-1, HBL ).LT.HBL-2 ) .OR. @@ -1441,7 +1492,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * IROW1 = KROW( KI ) + K - ISTART IROW2 = KP2ROW( KI ) + K - ISTART - CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, + CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, $ DESCA(CSRC_),ICOL1, ICOL2 ) ICOL2 = NUMROC(I2,HBL,MYCOL,DESCA(CSRC_),NPCOL ) IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND. @@ -1531,7 +1582,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * IROW1 = KROW( KI ) + K - ISTART IROW2 = KP2ROW( KI ) + K - ISTART - CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, + CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, $ DESCA(CSRC_), ICOL1, ICOL2 ) ICOL2 = NUMROC(I2,HBL,MYCOL,DESCA(CSRC_),NPCOL ) IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND. @@ -1972,9 +2023,9 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, CALL SGESD2D( CONTXT, LIHIH-LILOH+1, 1, $ A( ( ITMP1-1 )*LDA+LILOH ), $ LDA, MYROW, RIGHT ) - CALL INFOG1L( K, HBL, NPCOL, MYCOL, + CALL INFOG1L( K, HBL, NPCOL, MYCOL, $ DESCA(CSRC_), ITMP1, ITMP2 ) - ITMP2 = NUMROC( K+1, HBL, MYCOL, + ITMP2 = NUMROC( K+1, HBL, MYCOL, $ DESCA(CSRC_), NPCOL ) CALL SGERV2D( CONTXT, LIHIH-LILOH+1, 1, $ A( ( ITMP1-1 )*LDA+LILOH ), @@ -2090,7 +2141,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, IF( ( MOD( K1( KI )-1, HBL ).GE.HBL-2 ) .AND. $ ( ( MYCOL.EQ.ICURCOL( KI ) ) .OR. ( RIGHT.EQ. $ ICURCOL( KI ) ) ) .AND. ( NPCOL.GT.1 ) ) THEN - CALL INFOG1L( K2( KI )+1, HBL, NPCOL, MYCOL, + CALL INFOG1L( K2( KI )+1, HBL, NPCOL, MYCOL, $ DESCA(CSRC_), KCOL( KI ), ITMP2 ) ITMP2 = NUMROC( N, HBL, MYCOL, DESCA(CSRC_), NPCOL ) END IF @@ -2099,7 +2150,7 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, $ ICURCOL( KI ) ) ) .AND. ( NPCOL.GT.1 ) ) THEN CALL INFOG1L( 1, HBL, NPCOL, MYCOL,DESCA(CSRC_),ITMP2, $ KP2COL( KI ) ) - KP2COL( KI ) = NUMROC( K2( KI )+3, HBL, MYCOL, + KP2COL( KI ) = NUMROC( K2( KI )+3, HBL, MYCOL, $ DESCA(CSRC_), NPCOL ) END IF K1( KI ) = K2( KI ) + 1 @@ -2131,6 +2182,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * INFO = I WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * 430 CONTINUE @@ -2200,6 +2255,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, $ INFO ) IF( INFO.NE.0 ) THEN WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF IF( NODE.NE.0 ) THEN @@ -2239,6 +2298,10 @@ RECURSIVE SUBROUTINE PSLAQR1( WANTT, WANTZ, N, ILO, IHI, A, IWORK( 1 ) = TOTIT IWORK( 2 ) = TOTSW IWORK( 3 ) = TOTNS +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * END OF PSLAQR1 diff --git a/SRC/pslaqr2.f b/SRC/pslaqr2.f index 20a2afc3..ffce75aa 100644 --- a/SRC/pslaqr2.f +++ b/SRC/pslaqr2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, $ ILOZ, IHIZ, Z, DESCZ, NS, ND, SR, SI, T, LDT, $ V, LDV, WR, WI, WORK, LWORK ) @@ -9,6 +15,7 @@ SUBROUTINE PSLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -242,11 +249,41 @@ SUBROUTINE PSLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, INTRINSIC MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LDT, + $ LDV, LWORK, N, ND, NS, + $ NW, WANTT, WANTZ, eos_str + 102 FORMAT('PSLAQR2 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KBOT:',I5,', KTOP:',I5,', LDT:',I5, + $ ', LDV:',I5,', LWORK:',I5,', N:',I5, + $ ', ND:',I5,', NS:',I5,', NW:',I5, + $ ', WANTT:',L1,', WANTZ:',L1, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * NODE (IAFIRST,JAFIRST) OWNS A(1,1) * @@ -666,6 +703,10 @@ SUBROUTINE PSLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, IF( II .LT. ND ) GOTO 160 END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * END OF PSLAQR2 * END diff --git a/SRC/pslaqr3.f b/SRC/pslaqr3.f index 5b875278..abb4f4c9 100644 --- a/SRC/pslaqr3.f +++ b/SRC/pslaqr3.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, $ DESCH, ILOZ, IHIZ, Z, DESCZ, NS, ND, $ SR, SI, V, DESCV, NH, T, DESCT, NV, @@ -12,6 +18,7 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -174,7 +181,7 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * are stored in SR(KBOT-ND+1) through SR(KBOT) and * SI(KBOT-ND+1) through SI(KBOT), respectively. * -* V (global workspace) REAL array, dimension +* V (global workspace) REAL array, dimension * (DESCV(LLD_),*) * An NW-by-NW distributed work array. * @@ -184,7 +191,7 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * NH (input) INTEGER scalar * The number of columns of T. NH.GE.NW. * -* T (global workspace) REAL array, dimension +* T (global workspace) REAL array, dimension * (DESCV(LLD_),*) * * DESCT (global and local input) INTEGER array of dimension DLEN_. @@ -194,7 +201,7 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * The number of rows of work array WV available for * workspace. NV.GE.NW. * -* WV (global workspace) REAL array, dimension +* WV (global workspace) REAL array, dimension * (DESCW(LLD_),*) * * DESCW (global and local input) INTEGER array of dimension DLEN_. @@ -283,8 +290,37 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, INTRINSIC ABS, FLOAT, INT, MAX, MIN, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F ICTXT = DESCH( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LWORK, + $ N, ND, NH, NS, NV, + $ NW, LIWORK, RECLEVEL, WANTT, WANTZ, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLAQR3 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KBOT:',I5,', KTOP:',I5,', LWORK:',I5, + $ ', N:',I5,', ND:',I5,', NH:',I5, + $ ', NS:',I5,', NV:',I5,', NW:',I5,', LIWORK:',I5, + $ ', RECLEVEL:',I5,', WANTT:',L1, + $ ', WANTZ:',L1,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL * * Extract local leading dimensions, blockfactors, offset for @@ -412,18 +448,33 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * IWORK(1:NSEL) is used as the array SELECT for PSTRORD. * IWORK( 1 ) = ILWKOPT + NSEL - IF( LQUERY ) - $ RETURN + IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Nothing to do for an empty active block ... NS = 0 ND = 0 - IF( KTOP.GT.KBOT ) - $ RETURN + IF( KTOP.GT.KBOT ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ... nor for an empty deflation window. * - IF( NW.LT.1 ) - $ RETURN + IF( NW.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Machine constants. * @@ -459,6 +510,10 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, IF( KWTOP.GT.KTOP ) $ CALL PSELSET( H, KWTOP, KWTOP-1 , DESCH, ZERO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -491,6 +546,10 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, CALL PSELSET( H, I+1, I+1, DESCH, DD ) END IF WORK( 1 ) = FLOAT( LWKOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1151,6 +1210,10 @@ RECURSIVE SUBROUTINE PSLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, WORK( 1 ) = FLOAT( LWKOPT ) IWORK( 1 ) = ILWKOPT + NSEL * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSLAQR3 * END diff --git a/SRC/pslaqr4.f b/SRC/pslaqr4.f index f47a5b4c..a1bb78bf 100644 --- a/SRC/pslaqr4.f +++ b/SRC/pslaqr4.f @@ -1,3 +1,11 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, $ ILOZ, IHIZ, Z, DESCZ, T, LDT, V, LDV, WORK, $ LWORK, INFO ) @@ -9,6 +17,7 @@ SUBROUTINE PSLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -227,13 +236,41 @@ SUBROUTINE PSLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, INTRINSIC MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, INFO, LDT, LDV, LWORK, N, eos_str + 102 FORMAT('PSLAQR4 inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', INFO:',I5,', LDT:',I5, + $ ', LDV:',I5,', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * NH = IHI - ILO + 1 NZ = IHIZ - ILOZ + 1 - IF( N.EQ.0 .OR. NH.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NH.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * NODE (IAFIRST,JAFIRST) OWNS A(1,1) * @@ -628,6 +665,10 @@ SUBROUTINE PSLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, END IF END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * END OF PSLAQR4 * END diff --git a/SRC/pslaqr5.f b/SRC/pslaqr5.f index 200cc05e..fa4af8f7 100644 --- a/SRC/pslaqr5.f +++ b/SRC/pslaqr5.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, $ SR, SI, H, DESCH, ILOZ, IHIZ, Z, DESCZ, WORK, $ LWORK, IWORK, LIWORK ) @@ -9,6 +15,7 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -69,7 +76,7 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * parts of the NSHFTS shifts of origin that define the * multi-shift QR sweep. * -* H (local input/output) REAL array of size +* H (local input/output) REAL array of size * (DESCH(LLD_),*) * On input H contains a Hessenberg matrix. On output a * multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied @@ -180,10 +187,37 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, $ STRMM, SLAQR6 * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * INFO = 0 ICTXT = DESCH( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IHIZ, ILOZ, KACC22, KBOT, KTOP, + $ N, NSHFTS, LWORK, + $ LIWORK, WANTT, WANTZ, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSLAQR5 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KACC22:',I5,', KBOT:',I5,', KTOP:',I5, + $ ', N:',I5,', NSHFTS:',I5,', LWORK:',I5, + $ ', LIWORK:',I5,', WANTT:',L1, + $ ', WANTZ:',L1,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL LLDH = DESCH( LLD_ ) LLDZ = DESCZ( LLD_ ) @@ -193,14 +227,24 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * * If there are no shifts, then there is nothing to do. * - IF( .NOT. LQUERY .AND. NSHFTS.LT.2 ) - $ RETURN + IF( .NOT. LQUERY .AND. NSHFTS.LT.2 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * If the active block is empty or 1-by-1, then there * is nothing to do. * - IF( .NOT. LQUERY .AND. KTOP.GE.KBOT ) - $ RETURN + IF( .NOT. LQUERY .AND. KTOP.GE.KBOT ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Shuffle shifts into pairs of real shifts and pairs of * complex conjugate shifts assuming complex conjugate @@ -307,12 +351,22 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, $ MAX( HROWS*NB, HCOLS*NB ) WORK(1) = FLOAT(LWKOPT) IWORK(1) = 5*NUMWIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Check if KTOP and KBOT are valid. * - IF( KTOP.LT.1 .OR. KBOT.GT.N ) RETURN + IF( KTOP.LT.1 .OR. KBOT.GT.N ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Create and chase NUMWIN chains of NBMPS bulges. * @@ -941,7 +995,13 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * * If we have no more windows, return. * - IF( ANMWIN.LT.1 ) RETURN + IF( ANMWIN.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ELSE * @@ -2247,7 +2307,13 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * * If we have no more windows, return. * - IF( ANMWIN.LT.1 ) RETURN + IF( ANMWIN.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Check for any more windows to bring over the border. * @@ -2270,6 +2336,10 @@ SUBROUTINE PSLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * GO TO 20 * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSLAQR5 * END diff --git a/SRC/pslaqsy.f b/SRC/pslaqsy.f index 1cd5c041..d3ed5560 100644 --- a/SRC/pslaqsy.f +++ b/SRC/pslaqsy.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, $ AMAX, EQUED ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, UPLO INTEGER IA, JA, N @@ -181,10 +188,36 @@ SUBROUTINE PSLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, UPLO, IA, JA, N, AMAX, + $ SCOND, eos_str + 102 FORMAT('PSLAQSY inputs: ,EQUED:',A5,', UPLO:',A5, + $ ', IA:',I5,', JA:',I5,', N:',I5,', AMAX:',F9.4, + $ ', SCOND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.0 ) THEN EQUED = 'N' +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -352,6 +385,10 @@ SUBROUTINE PSLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAQSY diff --git a/SRC/pslared1d.f b/SRC/pslared1d.f index 40ba037b..c8556036 100644 --- a/SRC/pslared1d.f +++ b/SRC/pslared1d.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * and University of California, Berkeley. * December 12, 2005 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, LWORK, N * .. @@ -139,9 +146,35 @@ SUBROUTINE PSLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) INTRINSIC MIN * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, LWORK, N, eos_str + 102 FORMAT('PSLARED1D inputs: ,IA:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESC( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) NB = DESC( MB_ ) @@ -165,6 +198,10 @@ SUBROUTINE PSLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) 20 CONTINUE 30 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARED1D diff --git a/SRC/pslared2d.f b/SRC/pslared2d.f index c1cc2457..49983766 100644 --- a/SRC/pslared2d.f +++ b/SRC/pslared2d.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * and University of California, Berkeley. * December 12, 2005 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, LWORK, N * .. @@ -136,9 +143,35 @@ SUBROUTINE PSLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) INTRINSIC MIN * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, LWORK, N, eos_str + 102 FORMAT('PSLARED2D inputs: ,IA:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESC( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) MB = DESC( MB_ ) @@ -163,6 +196,10 @@ SUBROUTINE PSLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) 20 CONTINUE 30 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARED2D diff --git a/SRC/pslarf.f b/SRC/pslarf.f index 39de0ed5..0106d0f6 100644 --- a/SRC/pslarf.f +++ b/SRC/pslarf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, $ C, IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, M, N @@ -259,10 +266,37 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ M, N, eos_str + 102 FORMAT('PSLARF inputs: ,SIDE:',A5,', IC:',I5,', INCV:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -805,6 +839,10 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARF diff --git a/SRC/pslarfb.f b/SRC/pslarfb.f index 2bf4e08f..9faea88f 100644 --- a/SRC/pslarfb.f +++ b/SRC/pslarfb.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, $ JV, DESCV, T, C, IC, JC, DESCC, WORK ) * @@ -5,6 +11,7 @@ SUBROUTINE PSLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, DIRECT, STOREV INTEGER IC, IV, JC, JV, K, M, N @@ -249,10 +256,38 @@ SUBROUTINE PSLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, DIRECT, STOREV, + $ IC, IV, JC, JV, K, M, N, eos_str + 102 FORMAT('PSLARFB inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', DIRECT:',A5,', STOREV:',A5,', IC:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', K:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -878,6 +913,10 @@ SUBROUTINE PSLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARFB diff --git a/SRC/pslarfg.f b/SRC/pslarfg.f index 0ca8a72b..78d641f7 100644 --- a/SRC/pslarfg.f +++ b/SRC/pslarfg.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, $ TAU ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IAX, INCX, IX, JAX, JX, N REAL ALPHA @@ -168,10 +175,34 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IAX, INCX, IX, JAX, JX, N, + $ ALPHA, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLARFG inputs: ,IAX:',I5,', INCX:',I5, + $ ', IX:',I5,', JAX:',I5,', JX:',I5,', N:',I5, + $ ', ALPHA:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( INCX.EQ.DESCX( M_ ) ) THEN * @@ -180,8 +211,13 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, CALL INFOG2L( IX, JAX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIAX, JJAX, IXROW, IXCOL ) * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Broadcast X(IAX,JAX) across the process row. * @@ -203,8 +239,13 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, CALL INFOG2L( IAX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIAX, JJAX, IXROW, IXCOL ) * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Broadcast X(IAX,JAX) across the process column. * @@ -223,6 +264,10 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * IF( N.LE.0 ) THEN TAU( INDXTAU ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -274,6 +319,10 @@ SUBROUTINE PSLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARFG diff --git a/SRC/pslarft.f b/SRC/pslarft.f index 238677ca..88edd319 100644 --- a/SRC/pslarft.f +++ b/SRC/pslarft.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, $ T, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, STOREV INTEGER IV, JV, K, N @@ -199,10 +206,37 @@ SUBROUTINE PSLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, + $ N, eos_str + 102 FORMAT('PSLARFT inputs: ,DIRECT:',A5,', STOREV:',A5, + $ ', IV:',I5,', JV:',I5,', K:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCV( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -531,6 +565,10 @@ SUBROUTINE PSLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARFT diff --git a/SRC/pslarz.f b/SRC/pslarz.f index 89015306..89c2cc36 100644 --- a/SRC/pslarz.f +++ b/SRC/pslarz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, $ IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, L, M, N @@ -268,10 +275,37 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ L, M, N, eos_str + 102 FORMAT('PSLARZ inputs: ,SIDE:',A5,', IC:',I5,', INCV:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', L:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -907,6 +941,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARZ diff --git a/SRC/pslarzb.f b/SRC/pslarzb.f index 3a4544ae..ae487e69 100644 --- a/SRC/pslarzb.f +++ b/SRC/pslarzb.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, $ IV, JV, DESCV, T, C, IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * and University of California, Berkeley. * March 14, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS INTEGER IC, IV, JC, JV, K, L, M, N @@ -256,10 +263,38 @@ SUBROUTINE PSLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, SIDE, STOREV, TRANS, + $ IC, IV, JC, JV, K, L, M, N, eos_str + 102 FORMAT('PSLARZB inputs: ,DIRECT:',A5,', SIDE:',A5, + $ ', STOREV:',A5,', TRANS:',A5,', IC:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', K:',I5,', L:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -277,6 +312,10 @@ SUBROUTINE PSLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSLARZB', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -599,13 +638,17 @@ SUBROUTINE PSLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * C( IOFFC ) = C( IOFFC ) - WORK( IPW ) * WORK( IPV ) * MPC2 x NQC2 MPC2 x K K x NQC2 * - IF( IOFFC2.GT.0 ) + IF( IOFFC2.GT.0 ) $ CALL SGEMM( 'No transpose', 'No transpose', MPC2, NQC2, K, $ -ONE, WORK( IPW ), LW, WORK( IPV ), LV, ONE, $ C( IOFFC2 ), LDC ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARZB diff --git a/SRC/pslarzt.f b/SRC/pslarzt.f index a6a368f6..d911254a 100644 --- a/SRC/pslarzt.f +++ b/SRC/pslarzt.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, $ T, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, STOREV INTEGER IV, JV, K, N @@ -211,6 +218,28 @@ SUBROUTINE PSLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, + $ N, eos_str + 102 FORMAT('PSLARZT inputs: ,DIRECT:',A5,', STOREV:',A5, + $ ', IV:',I5,', JV:',I5,', K:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Get grid parameters * ICTXT = DESCV( CTXT_ ) @@ -227,6 +256,10 @@ SUBROUTINE PSLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSLARZT', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -292,6 +325,10 @@ SUBROUTINE PSLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLARZT diff --git a/SRC/pslascl.f b/SRC/pslascl.f index 08116663..49aa5e2d 100644 --- a/SRC/pslascl.f +++ b/SRC/pslascl.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TYPE INTEGER IA, INFO, JA, M, N @@ -163,11 +170,36 @@ SUBROUTINE PSLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TYPE, IA, INFO, JA, M, N, CFROM, + $ CTO, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSLASCL inputs: ,TYPE:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', M:',I5,', N:',I5, + $ ', CFROM:',F9.4,', CTO:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * IF( NPROW.EQ.-1 ) THEN @@ -199,13 +231,22 @@ SUBROUTINE PSLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSLASCL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. M.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get machine parameters * @@ -521,6 +562,10 @@ SUBROUTINE PSLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, IF( .NOT.DONE ) $ GO TO 10 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLASCL diff --git a/SRC/pslase2.f b/SRC/pslase2.f index d62dbb59..9bf3a0f8 100644 --- a/SRC/pslase2.f +++ b/SRC/pslase2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, M, N @@ -156,8 +163,35 @@ SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PSLASE2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', ALPHA:',F9.4, + $ ', BETA:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -212,8 +246,13 @@ SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) IF( MYCOL.EQ.IACOL ) THEN * MPA = NUMROC( M+IROFFA, MBA, MYROW, IAROW, NPROW ) - IF( MPA.LE.0 ) - $ RETURN + IF( MPA.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYROW.EQ.IAROW ) $ MPA = MPA - IROFFA MYDIST = MOD( MYROW-IAROW+NPROW, NPROW ) @@ -321,8 +360,13 @@ SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) IF( MYROW.EQ.IAROW ) THEN * NQA = NUMROC( N+ICOFFA, NBA, MYCOL, IACOL, NPCOL ) - IF( NQA.LE.0 ) - $ RETURN + IF( NQA.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYCOL.EQ.IACOL ) $ NQA = NQA - ICOFFA MYDIST = MOD( MYCOL-IACOL+NPCOL, NPCOL ) @@ -404,6 +448,10 @@ SUBROUTINE PSLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLASE2 diff --git a/SRC/pslaset.f b/SRC/pslaset.f index b62cd6a4..5a2bf5a0 100644 --- a/SRC/pslaset.f +++ b/SRC/pslaset.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, M, N @@ -151,8 +158,35 @@ SUBROUTINE PSLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PSLASET inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', ALPHA:',F9.4, + $ ', BETA:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( M.LE.( DESCA( MB_ ) - MOD( IA-1, DESCA( MB_ ) ) ) .OR. $ N.LE.( DESCA( NB_ ) - MOD( JA-1, DESCA( NB_ ) ) ) ) THEN @@ -213,6 +247,10 @@ SUBROUTINE PSLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLASET diff --git a/SRC/pslasmsub.f b/SRC/pslasmsub.f index 9872651c..5eee20db 100644 --- a/SRC/pslasmsub.f +++ b/SRC/pslasmsub.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, K, L, LWORK REAL SMLNUM @@ -100,7 +107,7 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * On exit, this yields the bottom portion of the unreduced * submatrix. This will satisfy: L <= M <= I-1. * -* SMLNUM (global input) REAL +* SMLNUM (global input) REAL * On entry, a "small number" for the given matrix. * Unchanged on exit. * @@ -166,6 +173,16 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) INTRINSIC ABS, MAX, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) @@ -174,6 +191,19 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) JAFIRST = DESCA( CSRC_ ) ULP = PSLAMCH( CONTXT, 'PRECISION' ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, K, L, LWORK, SMLNUM, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLASMSUB inputs: ,I:',I5,', K:',I5,', L:',I5, + $ ', LWORK:',I5,', SMLNUM:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -197,6 +227,10 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * * Error! * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF CALL INFOG2L( I, I, DESCA, NPROW, NPCOL, MYROW, MYCOL, IROW1, @@ -363,6 +397,10 @@ SUBROUTINE PSLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) 50 CONTINUE CALL IGAMX2D( CONTXT, 'ALL', ' ', 1, 1, K, 1, ITMP1, ITMP2, -1, $ -1, -1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLASMSUB diff --git a/SRC/pslasrt.f b/SRC/pslasrt.f index 7648f679..2ff211ee 100644 --- a/SRC/pslasrt.f +++ b/SRC/pslasrt.f @@ -1,10 +1,17 @@ - SUBROUTINE PSLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* + SUBROUTINE PSLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * * -- ScaLAPACK auxiliary routine (version 2.0.2) -- * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER ID INTEGER INFO, IQ, JQ, LIWORK, LWORK, N @@ -103,12 +110,45 @@ SUBROUTINE PSLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, LIWORK, LWORK, + $ N, eos_str + 102 FORMAT('PSLASRT inputs: ,ID:',A5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN * - IF( N.EQ.0 ) - $ RETURN +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCQ( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -141,6 +181,10 @@ SUBROUTINE PSLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSLASRT', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -249,6 +293,10 @@ SUBROUTINE PSLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, END IF CALL SLAMOV( 'Full', NP, NQ, WORK, NP, Q( IIQ ), LDQ ) * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSLASRT * END diff --git a/SRC/pslassq.f b/SRC/pslassq.f index 46fb1012..61f7bd23 100644 --- a/SRC/pslassq.f +++ b/SRC/pslassq.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IX, INCX, JX, N REAL SCALE, SUMSQ @@ -163,11 +170,34 @@ SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IX, INCX, JX, N, SCALE, SUMSQ, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLASSQ inputs: ,IX:',I5,', INCX:',I5, + $ ', JX:',I5,', N:',I5,', SCALE:',F9.4, + $ ', SUMSQ:',F9.4,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Figure local indexes * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, IIX, JJX, @@ -178,8 +208,13 @@ SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * X is rowwise distributed. * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ICOFF = MOD( JX, DESCX( NB_ ) ) NQ = NUMROC( N+ICOFF, DESCX( NB_ ), MYCOL, IXCOL, NPCOL ) IF( MYCOL.EQ.IXCOL ) @@ -218,8 +253,13 @@ SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * X is columnwise distributed. * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFF = MOD( IX, DESCX( MB_ ) ) NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IXROW, NPROW ) IF( MYROW.EQ.IXROW ) @@ -256,6 +296,10 @@ SUBROUTINE PSLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLASSQ diff --git a/SRC/pslaswp.f b/SRC/pslaswp.f index 1b3a3f3c..c7b1eecc 100644 --- a/SRC/pslaswp.f +++ b/SRC/pslaswp.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, $ IPIV ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIREC, ROWCOL INTEGER IA, JA, K1, K2, N @@ -152,10 +159,37 @@ SUBROUTINE PSLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, JA, K1, + $ K2, N, eos_str + 102 FORMAT('PSLASWP inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I5,', JA:',I5,', K1:',I5, + $ ', K2:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) * @@ -201,6 +235,10 @@ SUBROUTINE PSLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PSLASWP diff --git a/SRC/pslatra.f b/SRC/pslatra.f index 7237b26c..3cabdfce 100644 --- a/SRC/pslatra.f +++ b/SRC/pslatra.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* REAL FUNCTION PSLATRA( N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ REAL FUNCTION PSLATRA( N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, N * .. @@ -125,13 +132,39 @@ REAL FUNCTION PSLATRA( N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, N, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT(' inputs: ,IA:',I5,', JA:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * TRACE = ZERO IF( N.EQ.0 ) THEN PSLATRA = TRACE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -180,6 +213,10 @@ REAL FUNCTION PSLATRA( N, A, IA, JA, DESCA ) * PSLATRA = TRACE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLATRA diff --git a/SRC/pslatrd.f b/SRC/pslatrd.f index e628aa66..aaf8c1a7 100644 --- a/SRC/pslatrd.f +++ b/SRC/pslatrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, $ IW, JW, DESCW, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PSLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IW, JA, JW, N, NB @@ -251,10 +258,37 @@ SUBROUTINE PSLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IW, JA, JW, N, NB, + $ eos_str + 102 FORMAT('PSLATRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', IW:',I5,', JA:',I5,', JW:',I5,', N:',I5, + $ ', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -408,6 +442,10 @@ SUBROUTINE PSLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLATRD diff --git a/SRC/pslatrs.f b/SRC/pslatrs.f index adbeebed..76d35726 100644 --- a/SRC/pslatrs.f +++ b/SRC/pslatrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, $ JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM, $ WORK ) @@ -7,6 +13,7 @@ SUBROUTINE PSLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, NORMIN, TRANS, UPLO INTEGER IA, IX, JA, JX, N @@ -49,15 +56,46 @@ SUBROUTINE PSLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORMIN, TRANS, UPLO, + $ IA, IX, JA, JX, N, SCALE, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSLATRS inputs: ,DIAG:',A5,', NORMIN:',A5, + $ ', TRANS:',A5,', UPLO:',A5,', IA:',I5, + $ ', IX:',I5,', JA:',I5,', JX:',I5, + $ ', N:',I5,', SCALE:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * ***** NO SCALING ***** Call PSTRSV for all cases ***** * @@ -80,6 +118,10 @@ SUBROUTINE PSLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, $ LDX, MYROW, IXCOL ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLATRS diff --git a/SRC/pslatrz.f b/SRC/pslatrz.f index 53ed8e0c..d7a617e2 100644 --- a/SRC/pslatrz.f +++ b/SRC/pslatrz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, L, M, N * .. @@ -187,10 +194,35 @@ SUBROUTINE PSLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, L, M, N, eos_str + 102 FORMAT('PSLATRZ inputs: ,IA:',I5,', JA:',I5,', L:',I5, + $ ', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -230,6 +262,10 @@ SUBROUTINE PSLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLATRZ diff --git a/SRC/pslauu2.f b/SRC/pslauu2.f index 99262f82..dd8cbd13 100644 --- a/SRC/pslauu2.f +++ b/SRC/pslauu2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAUU2( UPLO, N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAUU2( UPLO, N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, N @@ -142,10 +149,35 @@ SUBROUTINE PSLAUU2( UPLO, N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PSLAUU2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters and compute local indexes * @@ -198,6 +230,10 @@ SUBROUTINE PSLAUU2( UPLO, N, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAUU2 diff --git a/SRC/pslauum.f b/SRC/pslauum.f index feca9758..a066796b 100644 --- a/SRC/pslauum.f +++ b/SRC/pslauum.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAUUM( UPLO, N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAUUM( UPLO, N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, N @@ -141,10 +148,35 @@ SUBROUTINE PSLAUUM( UPLO, N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PSLAUUM inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) IF( LSAME( UPLO, 'U' ) ) THEN @@ -208,6 +240,10 @@ SUBROUTINE PSLAUUM( UPLO, N, A, IA, JA, DESCA ) 20 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAUUM diff --git a/SRC/pslawil.f b/SRC/pslawil.f index 671e08ed..d96f2db2 100644 --- a/SRC/pslawil.f +++ b/SRC/pslawil.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER II, JJ, M REAL H33, H43H34, H44 @@ -136,11 +143,34 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) INTRINSIC ABS, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) LDA = DESCA( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) II, JJ, M, H33, H43H34, H44, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSLAWIL inputs: ,II:',I5,', JJ:',I5,', M:',I5, + $ ', H33:',F9.4,', H43H34:',F9.4, + $ ', H44:',F9.4,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -234,8 +264,13 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) END IF END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) - $ RETURN + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( MODKM1.GT.1 ) THEN CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, @@ -259,6 +294,10 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) V( 2 ) = V2 V( 3 ) = V3( 1 ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAWIL From 5d53c266e49136cac5b8f28fd03cc184851a0494 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Tue, 12 Sep 2023 18:36:06 +0530 Subject: [PATCH 15/29] Trace and Logging feature enabled for 63 float data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: I8fce6b7eb270a8efcdc3058fde95453962e0b8b8 --- SRC/psorg2l.f | 51 +++++++++- SRC/psorg2r.f | 51 +++++++++- SRC/psorgl2.f | 51 +++++++++- SRC/psorglq.f | 51 +++++++++- SRC/psorgql.f | 51 +++++++++- SRC/psorgqr.f | 51 +++++++++- SRC/psorgr2.f | 51 +++++++++- SRC/psorgrq.f | 51 +++++++++- SRC/psorm2l.f | 56 +++++++++- SRC/psorm2r.f | 54 +++++++++- SRC/psormbr.f | 54 +++++++++- SRC/psormhr.f | 54 +++++++++- SRC/psorml2.f | 54 +++++++++- SRC/psormlq.f | 54 +++++++++- SRC/psormql.f | 54 +++++++++- SRC/psormqr.f | 54 +++++++++- SRC/psormr2.f | 54 +++++++++- SRC/psormr3.f | 54 +++++++++- SRC/psormrq.f | 54 +++++++++- SRC/psormrz.f | 54 +++++++++- SRC/psormtr.f | 54 +++++++++- SRC/pspbsv.f | 45 +++++++++ SRC/pspbtrf.f | 65 +++++++++++- SRC/pspbtrs.f | 70 ++++++++++++- SRC/pspbtrsv.f | 71 ++++++++++++- SRC/pspocon.f | 57 +++++++++++ SRC/pspoequ.f | 46 +++++++++ SRC/psporfs.f | 51 ++++++++++ SRC/psposv.f | 40 ++++++++ SRC/psposvx.f | 57 +++++++++++ SRC/pspotf2.f | 47 ++++++++- SRC/pspotrf.f | 51 +++++++++- SRC/pspotri.f | 56 +++++++++- SRC/pspotrs.f | 49 ++++++++- SRC/psptsv.f | 44 ++++++++ SRC/pspttrf.f | 63 +++++++++++- SRC/pspttrs.f | 70 ++++++++++++- SRC/pspttrsv.f | 70 ++++++++++++- SRC/psrot.f | 57 ++++++++++- SRC/psrscl.f | 43 +++++++- SRC/psstebz.f | 154 +++++++++++++++++++++++++++- SRC/psstedc.f | 49 ++++++++- SRC/psstein.f | 58 ++++++++++- SRC/pssyev.f | 76 +++++++++++--- SRC/pssyevd.f | 59 ++++++++++- SRC/pssyevr.f | 270 ++++++++++++++++++++++++++++++++----------------- SRC/pssyevx.f | 69 ++++++++++++- SRC/pssygs2.f | 54 +++++++++- SRC/pssygst.f | 54 +++++++++- SRC/pssygvx.f | 60 ++++++++++- SRC/pssyngst.f | 58 ++++++++++- SRC/pssyntrd.f | 58 ++++++++++- SRC/pssytd2.f | 51 +++++++++- SRC/pssytrd.f | 51 +++++++++- SRC/pssyttrd.f | 58 ++++++++++- SRC/pstrcon.f | 49 +++++++++ SRC/pstrord.f | 45 +++++++++ SRC/pstrrfs.f | 51 ++++++++++ SRC/pstrsen.f | 47 +++++++++ SRC/pstrti2.f | 38 +++++++ SRC/pstrtri.f | 56 +++++++++- SRC/pstrtrs.f | 59 ++++++++++- SRC/pstzrzf.f | 51 +++++++++- 63 files changed, 3514 insertions(+), 225 deletions(-) diff --git a/SRC/psorg2l.f b/SRC/psorg2l.f index 5b7e1df5..2b1879d6 100644 --- a/SRC/psorg2l.f +++ b/SRC/psorg2l.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -183,11 +190,34 @@ SUBROUTINE PSORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORG2L inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,15 +250,28 @@ SUBROUTINE PSORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORG2L', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -271,6 +314,10 @@ SUBROUTINE PSORG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORG2L diff --git a/SRC/psorg2r.f b/SRC/psorg2r.f index 8820a1bc..15b07c8b 100644 --- a/SRC/psorg2r.f +++ b/SRC/psorg2r.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -184,11 +191,34 @@ SUBROUTINE PSORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORG2R inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -221,15 +251,28 @@ SUBROUTINE PSORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORG2R', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -274,6 +317,10 @@ SUBROUTINE PSORG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORG2R diff --git a/SRC/psorgl2.f b/SRC/psorgl2.f index 6d0c694b..52f0ad39 100644 --- a/SRC/psorgl2.f +++ b/SRC/psorgl2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -183,11 +190,34 @@ SUBROUTINE PSORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGL2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,15 +250,28 @@ SUBROUTINE PSORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGL2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -280,6 +323,10 @@ SUBROUTINE PSORGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGL2 diff --git a/SRC/psorglq.f b/SRC/psorglq.f index 64c4617c..d062e3b6 100644 --- a/SRC/psorglq.f +++ b/SRC/psorglq.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -186,11 +193,34 @@ SUBROUTINE PSORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGLQ inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -233,15 +263,28 @@ SUBROUTINE PSORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGLQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+K-1 ) @@ -326,6 +369,10 @@ SUBROUTINE PSORGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGLQ diff --git a/SRC/psorgql.f b/SRC/psorgql.f index 6a8c2929..d6c87cef 100644 --- a/SRC/psorgql.f +++ b/SRC/psorgql.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -185,11 +192,34 @@ SUBROUTINE PSORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGQL inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -231,15 +261,28 @@ SUBROUTINE PSORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGQL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( NB_ )*DESCA( NB_ ) + 1 JN = MIN( ICEIL( JA+N-K, DESCA( NB_ ) )*DESCA( NB_ ), JA+N-1 ) @@ -293,6 +336,10 @@ SUBROUTINE PSORGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGQL diff --git a/SRC/psorgqr.f b/SRC/psorgqr.f index 59ed839c..c9b98419 100644 --- a/SRC/psorgqr.f +++ b/SRC/psorgqr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -187,11 +194,34 @@ SUBROUTINE PSORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGQR inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -234,15 +264,28 @@ SUBROUTINE PSORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( NB_ )*DESCA( NB_ ) + 1 JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+K-1 ) @@ -329,6 +372,10 @@ SUBROUTINE PSORGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGQR diff --git a/SRC/psorgr2.f b/SRC/psorgr2.f index 90a5371e..cf1fa3f3 100644 --- a/SRC/psorgr2.f +++ b/SRC/psorgr2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -183,11 +190,34 @@ SUBROUTINE PSORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGR2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,15 +250,28 @@ SUBROUTINE PSORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -274,6 +317,10 @@ SUBROUTINE PSORGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGR2 diff --git a/SRC/psorgrq.f b/SRC/psorgrq.f index a9925377..1320a1a9 100644 --- a/SRC/psorgrq.f +++ b/SRC/psorgrq.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -186,11 +193,34 @@ SUBROUTINE PSORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORGRQ inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', K:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -233,15 +263,28 @@ SUBROUTINE PSORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORGRQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( MB_ )*DESCA( MB_ ) + 1 IN = MIN( ICEIL( IA+M-K, DESCA( MB_ ) )*DESCA( MB_ ), IA+M-1 ) @@ -295,6 +338,10 @@ SUBROUTINE PSORGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORGRQ diff --git a/SRC/psorm2l.f b/SRC/psorm2l.f index e055c87d..168c450b 100644 --- a/SRC/psorm2l.f +++ b/SRC/psorm2l.f @@ -1,11 +1,18 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* May 25, 2001 +* May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PSORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORM2L inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -314,15 +347,28 @@ SUBROUTINE PSORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORM2L', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( DESCA( M_ ).EQ.1 ) THEN CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, @@ -425,6 +471,10 @@ SUBROUTINE PSORM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORM2L diff --git a/SRC/psorm2r.f b/SRC/psorm2r.f index dac173e7..8d91cf37 100644 --- a/SRC/psorm2r.f +++ b/SRC/psorm2r.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PSORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORM2R inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -315,15 +348,28 @@ SUBROUTINE PSORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORM2R', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( DESCA( M_ ).EQ.1 ) THEN CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, @@ -429,6 +475,10 @@ SUBROUTINE PSORM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORM2R diff --git a/SRC/psormbr.f b/SRC/psormbr.f index e6bc40c4..09a3cb10 100644 --- a/SRC/psormbr.f +++ b/SRC/psormbr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, VECT INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -311,11 +318,37 @@ SUBROUTINE PSORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, VECT, IA, IC, + $ INFO, JA, JC, K, LWORK, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORMBR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', VECT:',A5,', IA:',I5,', IC:',I5, + $ ', INFO:',I5,', JA:',I5,', JC:',I5, + $ ', K:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -530,15 +563,28 @@ SUBROUTINE PSORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMBR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( APPLYQ ) THEN * @@ -584,6 +630,10 @@ SUBROUTINE PSORMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMBR diff --git a/SRC/psormhr.f b/SRC/psormhr.f index ca74cea9..bded4eb8 100644 --- a/SRC/psormhr.f +++ b/SRC/psormhr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, IHI, ILO, INFO, JA, JC, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PSORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, IHI, ILO, + $ INFO, JA, JC, LWORK, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSORMHR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', IHI:',I5, + $ ', ILO:',I5,', INFO:',I5,', JA:',I5, + $ ', JC:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -375,21 +408,38 @@ SUBROUTINE PSORMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMHR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PSORMQR( SIDE, TRANS, MI, NI, NH, A, IAA, JAA, DESCA, TAU, $ C, ICC, JCC, DESCC, WORK, LWORK, IINFO ) * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMHR diff --git a/SRC/psorml2.f b/SRC/psorml2.f index 2f4a3d40..da21f83d 100644 --- a/SRC/psorml2.f +++ b/SRC/psorml2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -237,11 +244,37 @@ SUBROUTINE PSORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORML2 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -317,15 +350,28 @@ SUBROUTINE PSORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORML2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -383,6 +429,10 @@ SUBROUTINE PSORML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORML2 diff --git a/SRC/psormlq.f b/SRC/psormlq.f index 60091851..2b87e6e0 100644 --- a/SRC/psormlq.f +++ b/SRC/psormlq.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -247,11 +254,37 @@ SUBROUTINE PSORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMLQ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -355,15 +388,28 @@ SUBROUTINE PSORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMLQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -444,6 +490,10 @@ SUBROUTINE PSORMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMLQ diff --git a/SRC/psormql.f b/SRC/psormql.f index 160fb75f..7261ecd7 100644 --- a/SRC/psormql.f +++ b/SRC/psormql.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -247,11 +254,37 @@ SUBROUTINE PSORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMQL inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -356,15 +389,28 @@ SUBROUTINE PSORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMQL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -451,6 +497,10 @@ SUBROUTINE PSORMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMQL diff --git a/SRC/psormqr.f b/SRC/psormqr.f index 3bf29e9a..d2cd19aa 100644 --- a/SRC/psormqr.f +++ b/SRC/psormqr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -247,11 +254,37 @@ SUBROUTINE PSORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMQR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -356,15 +389,28 @@ SUBROUTINE PSORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -443,6 +489,10 @@ SUBROUTINE PSORMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMQR diff --git a/SRC/psormr2.f b/SRC/psormr2.f index be8eb0e5..09e63648 100644 --- a/SRC/psormr2.f +++ b/SRC/psormr2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -236,11 +243,37 @@ SUBROUTINE PSORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMR2 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -312,15 +345,28 @@ SUBROUTINE PSORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -374,6 +420,10 @@ SUBROUTINE PSORMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMR2 diff --git a/SRC/psormr3.f b/SRC/psormr3.f index 0a11b3df..66ab5b0a 100644 --- a/SRC/psormr3.f +++ b/SRC/psormr3.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, L, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PSORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, L, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMR3 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', L:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -317,15 +350,28 @@ SUBROUTINE PSORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMR3', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -383,6 +429,10 @@ SUBROUTINE PSORMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMR3 diff --git a/SRC/psormrq.f b/SRC/psormrq.f index d4b574f2..90a00a6a 100644 --- a/SRC/psormrq.f +++ b/SRC/psormrq.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -247,11 +254,37 @@ SUBROUTINE PSORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMRQ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -367,15 +400,28 @@ SUBROUTINE PSORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMRQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -468,6 +514,10 @@ SUBROUTINE PSORMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMRQ diff --git a/SRC/psormrz.f b/SRC/psormrz.f index 84622c39..3082de5b 100644 --- a/SRC/psormrz.f +++ b/SRC/psormrz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, L, LWORK, M, N @@ -252,11 +259,37 @@ SUBROUTINE PSORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, L, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMRZ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I5,', IC:',I5,', INFO:',I5, + $ ', JA:',I5,', JC:',I5,', K:',I5,', L:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -364,15 +397,28 @@ SUBROUTINE PSORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMRZ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -471,6 +517,10 @@ SUBROUTINE PSORMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMRZ diff --git a/SRC/psormtr.f b/SRC/psormtr.f index 1d805f0c..7d675583 100644 --- a/SRC/psormtr.f +++ b/SRC/psormtr.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, UPLO INTEGER IA, IC, INFO, JA, JC, LWORK, M, N @@ -262,11 +269,37 @@ SUBROUTINE PSORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, UPLO, IA, IC, + $ INFO, JA, JC, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSORMTR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', IA:',I5,', IC:',I5, + $ ', INFO:',I5,', JA:',I5,', JC:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -402,15 +435,28 @@ SUBROUTINE PSORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSORMTR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( UPPER ) THEN * @@ -430,6 +476,10 @@ SUBROUTINE PSORMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSORMTR diff --git a/SRC/pspbsv.f b/SRC/pspbsv.f index b5bd5330..e099688b 100644 --- a/SRC/pspbsv.f +++ b/SRC/pspbsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, IB, INFO, JA, LWORK, N, NRHS @@ -384,6 +391,28 @@ SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PSPBSV inputs: ,UPLO:',A5,', BW:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PSPBTRF and PSPBTRS. @@ -405,6 +434,10 @@ SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PSPBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -427,6 +460,10 @@ SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PSPBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -440,9 +477,17 @@ SUBROUTINE PSPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPBSV diff --git a/SRC/pspbtrf.f b/SRC/pspbtrf.f index 5eea78ff..0ae9f1aa 100644 --- a/SRC/pspbtrf.f +++ b/SRC/pspbtrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, INFO, JA, LAF, LWORK, N @@ -390,6 +397,16 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -421,6 +438,21 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, MBW2 = BW*BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPBTRF inputs: ,UPLO:',A5,', BW:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -471,12 +503,20 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, INFO = -( 2 ) CALL PXERBLA( ICTXT, 'PSPBTRF, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*BW ) ) THEN INFO = -( 6*100+4 ) CALL PXERBLA( ICTXT, 'PSPBTRF, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -491,6 +531,10 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, AF( 1 ) = LAF_MIN CALL PXERBLA( ICTXT, 'PSPBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -505,6 +549,10 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, INFO = -10 CALL PXERBLA( ICTXT, 'PSPBTRF: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -560,13 +608,22 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1467,6 +1524,10 @@ SUBROUTINE PSPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, END IF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPBTRF diff --git a/SRC/pspbtrs.f b/SRC/pspbtrs.f index 7e7ca909..c28b829e 100644 --- a/SRC/pspbtrs.f +++ b/SRC/pspbtrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, $ AF, LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -393,6 +400,16 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -450,6 +467,21 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LAF, + $ LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSPBTRS inputs: ,UPLO:',A5,', BW:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -518,12 +550,20 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, INFO = -( 2 ) CALL PXERBLA( ICTXT, 'PSPBTRS, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*BW ) ) THEN INFO = -( 7*100+4 ) CALL PXERBLA( ICTXT, 'PSPBTRS, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -537,6 +577,10 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, INFO = -14 CALL PXERBLA( ICTXT, 'PSPBTRS: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -606,16 +650,30 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -728,6 +786,10 @@ SUBROUTINE PSPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPBTRS diff --git a/SRC/pspbtrsv.f b/SRC/pspbtrsv.f index 0f4e4103..6d752d86 100644 --- a/SRC/pspbtrsv.f +++ b/SRC/pspbtrsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, $ IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER BW, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -406,6 +413,16 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -467,6 +484,22 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, MBW2 = BW*BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, BW, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSPBTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', BW:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -546,6 +579,10 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, CALL PXERBLA( ICTXT, $ 'PSPBTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -553,6 +590,10 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, INFO = -( 8*100+4 ) CALL PXERBLA( ICTXT, 'PSPBTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -566,6 +607,10 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, INFO = -14 CALL PXERBLA( ICTXT, 'PSPBTRSV: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -637,16 +682,30 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPBTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1503,6 +1562,10 @@ SUBROUTINE PSPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPBTRSV diff --git a/SRC/pspocon.f b/SRC/pspocon.f index 4ea767f8..563e3dcc 100644 --- a/SRC/pspocon.f +++ b/SRC/pspocon.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ LWORK, IWORK, LIWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LIWORK, LWORK, N @@ -205,11 +212,37 @@ SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LIWORK, + $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSPOCON inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', ANORM:',F9.4, + $ ', RCOND:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -273,8 +306,16 @@ SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOCON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -283,11 +324,23 @@ SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, RCOND = ZERO IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( ANORM.EQ.ZERO ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( N.EQ.1 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -398,6 +451,10 @@ SUBROUTINE PSPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOCON diff --git a/SRC/pspoequ.f b/SRC/pspoequ.f index e869e2b9..3d086371 100644 --- a/SRC/pspoequ.f +++ b/SRC/pspoequ.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, N REAL AMAX, SCOND @@ -180,11 +187,34 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, N, AMAX, SCOND, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSPOEQU inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', N:',I5,', AMAX:',F9.4, + $ ', SCOND:',F9.4,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -198,6 +228,10 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOEQU', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -206,6 +240,10 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, IF( N.EQ.0 ) THEN SCOND = ONE AMAX = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -329,6 +367,10 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * CALL IGAMN2D( ICTXT, 'All', ALLCTOP, 1, 1, INFO, 1, II, JJ, -1, $ -1, MYCOL ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * ELSE @@ -350,6 +392,10 @@ SUBROUTINE PSPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOEQU diff --git a/SRC/psporfs.f b/SRC/psporfs.f index 34a228c5..3f30a372 100644 --- a/SRC/psporfs.f +++ b/SRC/psporfs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, $ DESCAF, B, IB, JB, DESCB, X, IX, JX, DESCX, $ FERR, BERR, WORK, LWORK, IWORK, LIWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, @@ -298,6 +305,16 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, INTRINSIC ABS, ICHAR, MAX, MIN, MOD, REAL * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * .. Initialize EST EST = 0.0 * @@ -306,6 +323,24 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IAF, IB, INFO, IX, + $ JA, JAF, JB, JX, LIWORK, + $ LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSPORFS inputs: ,UPLO:',A5,', IA:',I5, + $ ', IAF:',I5,', IB:',I5,', INFO:',I5, + $ ', IX:',I5,', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -422,8 +457,16 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPORFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -438,6 +481,10 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -856,6 +903,10 @@ SUBROUTINE PSPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPORFS diff --git a/SRC/psposv.f b/SRC/psposv.f index 2a58a042..f3b4771d 100644 --- a/SRC/psposv.f +++ b/SRC/psposv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -192,11 +199,36 @@ SUBROUTINE PSPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPOSV inputs: ,UPLO:',A5,', IA:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', JB:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -239,6 +271,10 @@ SUBROUTINE PSPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -256,6 +292,10 @@ SUBROUTINE PSPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOSV diff --git a/SRC/psposvx.f b/SRC/psposvx.f index cdac89a3..ff3ed891 100644 --- a/SRC/psposvx.f +++ b/SRC/psposvx.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, $ IAF, JAF, DESCAF, EQUED, SR, SC, B, IB, JB, $ DESCB, X, IX, JX, DESCX, RCOND, FERR, BERR, @@ -8,6 +14,7 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, FACT, UPLO INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, LIWORK, @@ -389,11 +396,41 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, FACT, UPLO, IA, IAF, + $ IB, INFO, IX, JA, JAF, JB, JX, LIWORK, + $ LWORK, N, NRHS, + $ RCOND, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPOSVX inputs: ,EQUED:',A5,', FACT:',A5, + $ ', UPLO:',A5,', IA:',I5,', IAF:',I5, + $ ', IB:',I5,', INFO:',I5,', IX:',I5, + $ ', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', RCOND:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -546,8 +583,16 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOSVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -601,6 +646,10 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, IF( INFO.NE.0 ) THEN IF( INFO.GT.0 ) $ RCOND = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF END IF @@ -618,6 +667,10 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * IF( RCOND.LT.PSLAMCH( ICTXT, 'Epsilon' ) ) THEN INFO = IA + N +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -661,6 +714,10 @@ SUBROUTINE PSPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOSVX diff --git a/SRC/pspotf2.f b/SRC/pspotf2.f index 238f4afd..d30dcca6 100644 --- a/SRC/pspotf2.f +++ b/SRC/pspotf2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -166,11 +173,34 @@ SUBROUTINE PSPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSPOTF2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -199,13 +229,22 @@ SUBROUTINE PSPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOTF2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -344,6 +383,10 @@ SUBROUTINE PSPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOTF2 diff --git a/SRC/pspotrf.f b/SRC/pspotrf.f index 461ae517..8b94aea5 100644 --- a/SRC/pspotrf.f +++ b/SRC/pspotrf.f @@ -1,8 +1,13 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 20, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * @@ -13,6 +18,7 @@ SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -163,6 +169,9 @@ SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -192,11 +201,34 @@ SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSPOTRF inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -230,13 +262,22 @@ SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * #ifdef AOCL_PROGRESS * Set the AOCL progress variables related to rank, processes @@ -416,6 +457,10 @@ SUBROUTINE PSPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOTRF diff --git a/SRC/pspotri.f b/SRC/pspotri.f index d40243e5..f1ecb8d0 100644 --- a/SRC/pspotri.f +++ b/SRC/pspotri.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -145,11 +152,34 @@ SUBROUTINE PSPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSPOTRI inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -182,25 +212,43 @@ SUBROUTINE PSPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOTRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Invert the triangular Cholesky factor U or L. * CALL PSTRTRI( UPLO, 'Non-unit', N, A, IA, JA, DESCA, INFO ) * - IF( INFO.GT.0 ) - $ RETURN + IF( INFO.GT.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Form inv(U)*inv(U)' or inv(L)'*inv(L). * CALL PSLAUUM( UPLO, N, A, IA, JA, DESCA ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOTRI diff --git a/SRC/pspotrs.f b/SRC/pspotrs.f index 70f521b2..a127a67c 100644 --- a/SRC/pspotrs.f +++ b/SRC/pspotrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -173,11 +180,36 @@ SUBROUTINE PSPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPOTRS inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5,', JB:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -221,13 +253,22 @@ SUBROUTINE PSPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPOTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( UPPER ) THEN * @@ -257,6 +298,10 @@ SUBROUTINE PSPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ ONE, A, IA, JA, DESCA, B, IB, JB, DESCB ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPOTRS diff --git a/SRC/psptsv.f b/SRC/psptsv.f index 667c7dab..1b0b9796 100644 --- a/SRC/psptsv.f +++ b/SRC/psptsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, $ LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IB, INFO, JA, LWORK, N, NRHS * .. @@ -385,6 +392,27 @@ SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ eos_str + 102 FORMAT('PSPTSV inputs: ,IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PSPTTRF and PSPTTRS. @@ -409,6 +437,10 @@ SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, CALL PXERBLA( ICTXT, $ 'PSPTSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -430,6 +462,10 @@ SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PSPTSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -443,9 +479,17 @@ SUBROUTINE PSPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSPTSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPTSV diff --git a/SRC/pspttrf.f b/SRC/pspttrf.f index 9ea43ae5..6e294741 100644 --- a/SRC/pspttrf.f +++ b/SRC/pspttrf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, JA, LAF, LWORK, N * .. @@ -386,6 +393,16 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -421,6 +438,19 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSPTTRF inputs: ,INFO:',I5,', JA:',I5, + $ ', LAF:',I5,', LWORK:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -451,12 +481,20 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, INFO = -( 1 ) CALL PXERBLA( ICTXT, 'PSPTTRF, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*INT_ONE ) ) THEN INFO = -( 5*100+4 ) CALL PXERBLA( ICTXT, 'PSPTTRF, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -471,6 +509,10 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, AF( 1 ) = LAF_MIN CALL PXERBLA( ICTXT, 'PSPTTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -485,6 +527,10 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, INFO = -9 CALL PXERBLA( ICTXT, 'PSPTTRF: worksize error ', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -536,13 +582,22 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPTTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1010,6 +1065,10 @@ SUBROUTINE PSPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, END IF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPTTRF diff --git a/SRC/pspttrs.f b/SRC/pspttrs.f index 197e5ce2..6d7ef0e0 100644 --- a/SRC/pspttrs.f +++ b/SRC/pspttrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, $ LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS * .. @@ -400,6 +407,16 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -465,6 +482,21 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LAF, LWORK, N, + $ NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPTTRS inputs: ,IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -513,12 +545,20 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, INFO = -( 1 ) CALL PXERBLA( ICTXT, 'PSPTTRS, D&C alg.: only 1 block per proc' $ , -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * IF( ( JA+N-1.GT.NB ) .AND. ( NB.LT.2*INT_ONE ) ) THEN INFO = -( 5*100+4 ) CALL PXERBLA( ICTXT, 'PSPTTRS, D&C alg.: NB too small', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -532,6 +572,10 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, INFO = -12 CALL PXERBLA( ICTXT, 'PSPTTRS: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -597,16 +641,30 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPTTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -741,6 +799,10 @@ SUBROUTINE PSPTTRS( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, AF, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPTTRS diff --git a/SRC/pspttrsv.f b/SRC/pspttrsv.f index 6b3c6eb1..9e288333 100644 --- a/SRC/pspttrsv.f +++ b/SRC/pspttrsv.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, $ AF, LAF, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * April 3, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -411,6 +418,16 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -476,6 +493,21 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IB, INFO, JA, LAF, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PSPTTRSV inputs: ,UPLO:',A5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW*NPCOL * * @@ -533,6 +565,10 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PSPTTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -540,6 +576,10 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, INFO = -( 7*100+4 ) CALL PXERBLA( ICTXT, 'PSPTTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -553,6 +593,10 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, INFO = -14 CALL PXERBLA( ICTXT, 'PSPTTRSV: worksize error', -INFO ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -620,16 +664,30 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PSPTTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1081,6 +1139,10 @@ SUBROUTINE PSPTTRSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSPTTRSV diff --git a/SRC/psrot.f b/SRC/psrot.f index af8ee204..e3c9b8d7 100644 --- a/SRC/psrot.f +++ b/SRC/psrot.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, $ INCY, CS, SN, WORK, LWORK, INFO ) * @@ -9,6 +15,7 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -202,10 +209,36 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) N, IX, JX, INCX, IY, JY, INCY, + $ LWORK, INFO, CS, SN, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSROT inputs: ,N:',I5,', IX:',I5,', JX:',I5, + $ ', INCX:',I5,', IY:',I5,', JY:',I5, + $ ', INCY:',I5,', LWORK:',I5,', INFO:',I5, + $ ', CS:',F9.4,', SN:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL * * Test and decode parameters @@ -268,7 +301,7 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, IF( LEFT ) THEN RSRC1 = INDXG2P( IX, MB, MYROW, DESCX(RSRC_), NPROW ) RSRC2 = INDXG2P( IY, MB, MYROW, DESCY(RSRC_), NPROW ) - CSRC = INDXG2P( JX, NB, MYCOL, DESCX(CSRC_), NPCOL ) + CSRC = INDXG2P( JX, NB, MYCOL, DESCX(CSRC_), NPCOL ) ICOFFXY = MOD( JX - 1, NB ) XYCOLS = NUMROC( N+ICOFFXY, NB, MYCOL, CSRC, NPCOL ) IF( ( MYROW.EQ.RSRC1 .OR. MYROW.EQ.RSRC2 ) .AND. @@ -281,7 +314,7 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, ELSEIF( RIGHT ) THEN CSRC1 = INDXG2P( JX, NB, MYCOL, DESCX(CSRC_), NPCOL ) CSRC2 = INDXG2P( JY, NB, MYCOL, DESCY(CSRC_), NPCOL ) - RSRC = INDXG2P( IX, MB, MYROW, DESCX(RSRC_), NPROW ) + RSRC = INDXG2P( IX, MB, MYROW, DESCX(RSRC_), NPROW ) IROFFXY = MOD( IX - 1, MB ) XYROWS = NUMROC( N+IROFFXY, MB, MYROW, RSRC, NPROW ) IF( ( MYCOL.EQ.CSRC1 .OR. MYCOL.EQ.CSRC2 ) .AND. @@ -300,15 +333,27 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSROT', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSEIF( LQUERY ) THEN WORK( 1 ) = FLOAT(MNWRK) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -328,6 +373,10 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, CALL SROT( N, X((JX-1)*LLDX+IX), 1, Y((JY-1)*LLDY+IY), $ 1, CS, SN ) END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -435,6 +484,10 @@ SUBROUTINE PSROT( N, X, IX, JX, DESCX, INCX, Y, IY, JY, DESCY, * Store minimum workspace requirements in WORK-array and return * WORK( 1 ) = FLOAT(MNWRK) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSROT diff --git a/SRC/psrscl.f b/SRC/psrscl.f index 2b3e8b25..ae01685f 100644 --- a/SRC/psrscl.f +++ b/SRC/psrscl.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IX, INCX, JX, N REAL SA @@ -143,15 +150,43 @@ SUBROUTINE PSRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IX, INCX, JX, N, SA, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSRSCL inputs: ,IX:',I5,', INCX:',I5,', JX:',I5, + $ ', N:',I5,', SA:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get machine parameters * @@ -198,6 +233,10 @@ SUBROUTINE PSRSCL( N, SA, SX, IX, JX, DESCX, INCX ) IF( .NOT.DONE ) $ GO TO 10 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSRSCL diff --git a/SRC/psstebz.f b/SRC/psstebz.f index 7e588a99..288561c1 100644 --- a/SRC/psstebz.f +++ b/SRC/psstebz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, $ ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, $ WORK, LWORK, IWORK, LIWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER ORDER, RANGE INTEGER ICTXT, IL, INFO, IU, LIWORK, LWORK, M, N, @@ -254,14 +261,46 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, INTEGER TORECV( 1, 1 ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ORDER, RANGE, ICTXT, IL, INFO, + $ IU, LIWORK, LWORK, M, N, NSPLIT, + $ ABSTOL, VL, VU, eos_str + 102 FORMAT('PSSTEBZ inputs: ,ORDER:',A5,', RANGE:',A5, + $ ', ICTXT:',I5,', IL:',I5,', INFO:',I5, + $ ', IU:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NSPLIT:',I5, + $ ', ABSTOL:',F9.4,', VL:',F9.4, + $ ', VU:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Set up process grid * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* INFO = 0 M = 0 * @@ -375,16 +414,29 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSTEBZ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK.EQ.-1 .AND. LIWORK.EQ.-1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = 1 DO 20 I = 0, NPROW - 1 @@ -864,6 +916,10 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, 230 CONTINUE CALL BLACS_FREEBUFF( ONEDCONTEXT, 1 ) CALL BLACS_GRIDEXIT( ONEDCONTEXT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSTEBZ @@ -880,6 +936,7 @@ SUBROUTINE PSLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IEFLAG, IJOB, INFO, MINP, MMAX, MOUT, N REAL ABSTOL, LSAVE, PIVMIN, RELTOL @@ -1020,6 +1077,30 @@ SUBROUTINE PSLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, REAL ALPHA, BETA, MID * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IEFLAG, IJOB, INFO, MINP, MMAX, + $ MOUT, N, ABSTOL, LSAVE, PIVMIN, + $ RELTOL, eos_str + 102 FORMAT('PSLAEBZ inputs: ,IEFLAG:',I5,', IJOB:',I5, + $ ', INFO:',I5,', MINP:',I5,', MMAX:',I5, + $ ', MOUT:',I5,', N:',I5,', ABSTOL:',F9.4, + $ ', LSAVE:',F9.4,', PIVMIN:',F9.4, + $ ', RELTOL:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * KF = 1 KL = MINP + 1 @@ -1027,6 +1108,10 @@ SUBROUTINE PSLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, IF( INTVL( 2 )-INTVL( 1 ).LE.ZERO ) THEN INFO = MINP MOUT = KF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF IF( IJOB.EQ.0 ) THEN @@ -1176,6 +1261,10 @@ SUBROUTINE PSLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, KLNEW = KLNEW + 1 ELSE INFO = MMAX + 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF 40 CONTINUE @@ -1189,12 +1278,17 @@ SUBROUTINE PSLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, 60 CONTINUE INFO = MAX( KL-KF, 0 ) MOUT = KL - 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAEBZ * END * +* * SUBROUTINE PSLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, $ RELTOL ) @@ -1205,6 +1299,7 @@ SUBROUTINE PSLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IJOB, KF, KL REAL ABSTOL, RELTOL @@ -1296,6 +1391,27 @@ SUBROUTINE PSLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, REAL TMP1, TMP2, TMP3, TMP4 * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IJOB, KF, KL, ABSTOL, RELTOL, + $ eos_str + 102 FORMAT('PSLAECV inputs: ,IJOB:',I5,', KF:',I5, + $ ', KL:',I5,', ABSTOL:',F9.4,', RELTOL:',F9.4, + $ A1) + AOCL_DTL_LOG_ENTRY_F + END IF * KFNEW = KF DO 10 I = KF, KL - 1 @@ -1339,11 +1455,16 @@ SUBROUTINE PSLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, END IF 10 CONTINUE KF = KFNEW +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAECV * END +* * SUBROUTINE PSLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) * @@ -1353,6 +1474,7 @@ SUBROUTINE PSLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER COUNT, N REAL PIVMIN, SIGMA @@ -1420,6 +1542,26 @@ SUBROUTINE PSLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) REAL TMP * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COUNT, N, PIVMIN, SIGMA, + $ eos_str + 102 FORMAT('PSLAPDCT inputs: ,COUNT:',I5,', N:',I5, + $ ', PIVMIN:',F9.4,', SIGMA:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * TMP = D( 1 ) - SIGMA IF( ABS( TMP ).LE.PIVMIN ) @@ -1435,6 +1577,10 @@ SUBROUTINE PSLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) $ COUNT = COUNT + 1 10 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSLAPDCT diff --git a/SRC/psstedc.f b/SRC/psstedc.f index 54be9846..a425f552 100644 --- a/SRC/psstedc.f +++ b/SRC/psstedc.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * and University of California, Berkeley. * March 13, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER COMPZ INTEGER INFO, IQ, JQ, LIWORK, LWORK, N @@ -147,9 +154,37 @@ SUBROUTINE PSSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COMPZ, INFO, IQ, JQ, LIWORK, + $ LWORK, N, eos_str + 102 FORMAT('PSSTEDC inputs: ,COMPZ:',A5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Test the input parameters. * @@ -191,8 +226,16 @@ SUBROUTINE PSSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCQ( CTXT_ ), 'PSSTEDC', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -260,6 +303,10 @@ SUBROUTINE PSSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, $ WORK( 1 ) = REAL( LWMIN ) IF( LIWORK.GT.0 ) $ IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSTEDC diff --git a/SRC/psstein.f b/SRC/psstein.f index e1261fde..f2c3df6a 100644 --- a/SRC/psstein.f +++ b/SRC/psstein.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, $ JZ, DESCZ, WORK, LWORK, IWORK, LIWORK, IFAIL, $ ICLUSTR, GAP, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, IZ, JZ, LIWORK, LWORK, M, N REAL ORFAC @@ -296,9 +303,37 @@ SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, INTEGER IDUM1( 1 ), IDUM2( 1 ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, IZ, JZ, LIWORK, LWORK, + $ M, N, ORFAC, eos_str + 102 FORMAT('PSSTEIN inputs: ,INFO:',I5,', IZ:',I5, + $ ', JZ:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', ORFAC:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) SELF = MYROW*NPCOL + MYCOL @@ -376,8 +411,16 @@ SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCZ( CTXT_ ), 'PSSTEIN', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -396,8 +439,13 @@ SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * * Quick return if possible * - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. M.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( ORFAC.GE.ZERO ) THEN TMPFAC = ORFAC @@ -638,6 +686,10 @@ SUBROUTINE PSSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, WORK( 1 ) = ( LGCLSIZ+LOAD-1 )*N + INDRW IWORK( 1 ) = 3*N + P + 1 * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSSTEIN * END diff --git a/SRC/pssyev.f b/SRC/pssyev.f index c709feb8..ed25c807 100644 --- a/SRC/pssyev.f +++ b/SRC/pssyev.f @@ -1,11 +1,18 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, $ Z, IZ, JZ, DESCZ, WORK, LWORK, INFO ) * * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* May 25, 2001 +* May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, UPLO INTEGER IA, INFO, IZ, JA, JZ, LWORK, N @@ -248,15 +255,15 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * .. * .. Local Scalars .. LOGICAL LOWER, WANTZ - INTEGER CONTEXTC, CSRC_A, I, IACOL, IAROW, ICOFFA, - $ IINFO, INDD, INDD2, INDE, INDE2, INDTAU, - $ INDWORK, INDWORK2, IROFFA, IROFFZ, ISCALE, - $ IZROW, J, K, LDC, LLWORK, LWMIN, MB_A, MB_Z, + INTEGER CONTEXTC, CSRC_A, I, IACOL, IAROW, ICOFFA, + $ IINFO, INDD, INDD2, INDE, INDE2, INDTAU, + $ INDWORK, INDWORK2, IROFFA, IROFFZ, ISCALE, + $ IZROW, J, K, LDC, LLWORK, LWMIN, MB_A, MB_Z, $ MYCOL, MYPCOLC, MYPROWC, MYROW, NB, NB_A, NB_Z, - $ NP, NPCOL, NPCOLC, NPROCS, NPROW, NPROWC, NQ, - $ NRC, QRMEM, RSRC_A, RSRC_Z, SIZEMQRLEFT, + $ NP, NPCOL, NPCOLC, NPROCS, NPROW, NPROWC, NQ, + $ NRC, QRMEM, RSRC_A, RSRC_Z, SIZEMQRLEFT, $ SIZESYTRD - REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, + REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, $ SMLNUM * .. * .. Local Arrays .. @@ -279,12 +286,45 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, INTRINSIC ABS, ICHAR, INT, MAX, MIN, MOD, REAL, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LWORK, N, eos_str + 102 FORMAT('PSSYEV inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Quick return * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF( N.EQ.0 ) RETURN * * Test the input arguments. @@ -452,9 +492,17 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCA( CTXT_ ), 'PSSYEV', -INFO ) IF( WANTZ ) CALL BLACS_GRIDEXIT( CONTEXTC ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK .EQ. -1 ) THEN IF( WANTZ ) CALL BLACS_GRIDEXIT( CONTEXTC ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -491,7 +539,7 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, 10 CONTINUE IF( LSAME( UPLO, 'U') ) THEN DO 20 I=1,N-1 - CALL PSELGET( 'A', ' ', WORK(INDE2+I-1), A, + CALL PSELGET( 'A', ' ', WORK(INDE2+I-1), A, $ I+IA-1, I+JA, DESCA ) 20 CONTINUE ELSE @@ -511,7 +559,7 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * to matrix Q. * CALL SSTEQR2( 'I', N, WORK( INDD2 ), WORK( INDE2 ), - $ WORK( INDWORK ), LDC, NRC, WORK( INDWORK2 ), + $ WORK( INDWORK ), LDC, NRC, WORK( INDWORK2 ), $ INFO ) * CALL PSGEMR2D( N, N, WORK( INDWORK ), 1, 1, DESCQR, Z, IA, JA, @@ -567,11 +615,15 @@ SUBROUTINE PSSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * DO 50 I = 1, J IF( INFO.EQ.0 .AND. ( WORK( I+INDTAU )-WORK( I+INDE ) - $ .NE. ZERO ) )THEN + $ .NE. ZERO ) )THEN INFO = N+1 END IF 50 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYEV diff --git a/SRC/pssyevd.f b/SRC/pssyevd.f index f3a92fee..a13c815d 100644 --- a/SRC/pssyevd.f +++ b/SRC/pssyevd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, $ DESCZ, WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * and University of California, Berkeley. * March 14, 2000 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, UPLO INTEGER IA, INFO, IZ, JA, JZ, LIWORK, LWORK, N @@ -188,14 +195,48 @@ SUBROUTINE PSSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, INTRINSIC ICHAR, MAX, MIN, MOD, REAL, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LIWORK, LWORK, N, eos_str + 102 FORMAT('PSSYEVD inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Quick return * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Test the input arguments. * @@ -271,8 +312,16 @@ SUBROUTINE PSSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYEVD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -345,6 +394,10 @@ SUBROUTINE PSSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, CALL SSCAL( N, ONE / SIGMA, W, 1 ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYEVD diff --git a/SRC/pssyevr.f b/SRC/pssyevr.f index 146df0fa..588767a8 100644 --- a/SRC/pssyevr.f +++ b/SRC/pssyevr.f @@ -1,8 +1,15 @@ - SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* + SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ DESCA, VL, VU, IL, IU, M, NZ, W, Z, IZ, $ JZ, DESCZ, WORK, LWORK, IWORK, LIWORK, $ INFO ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK routine (version 2.0.2) -- @@ -25,14 +32,14 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * PSSYEVR computes selected eigenvalues and, optionally, eigenvectors * of a real symmetric matrix A distributed in 2D blockcyclic format -* by calling the recommended sequence of ScaLAPACK routines. +* by calling the recommended sequence of ScaLAPACK routines. * * First, the matrix A is reduced to real symmetric tridiagonal form. * Then, the eigenproblem is solved using the parallel MRRR algorithm. * Last, if eigenvectors have been computed, a backtransformation is done. * * Upon successful completion, each processor stores a copy of all computed -* eigenvalues in W. The eigenvector matrix Z is stored in +* eigenvalues in W. The eigenvector matrix Z is stored in * 2D blockcyclic format distributed over all processors. * * Note that subsets of eigenvalues/vectors can be selected by @@ -67,7 +74,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * A (local input/workspace) 2D block cyclic REAL array, * global dimension (N, N), * local dimension ( LLD_A, LOCc(JA+N-1) ), -* (see Notes below for more detailed explanation of 2d arrays) +* (see Notes below for more detailed explanation of 2d arrays) * * On entry, the symmetric matrix A. If UPLO = 'U', only the * upper triangular part of A is used to define the elements of @@ -81,7 +88,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * IA (global input) INTEGER * A's global row index, which points to the beginning of the -* submatrix which is to be operated on. +* submatrix which is to be operated on. * It should be set to 1 when operating on a full matrix. * * JA (global input) INTEGER @@ -91,17 +98,17 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * DESCA (global and local input) INTEGER array of dimension DLEN=9. * The array descriptor for the distributed matrix A. -* The descriptor stores details about the 2D block-cyclic +* The descriptor stores details about the 2D block-cyclic * storage, see the notes below. * If DESCA is incorrect, PSSYEVR cannot guarantee * correct error reporting. * Also note the array alignment requirements specified below. * -* VL (global input) REAL +* VL (global input) REAL * If RANGE='V', the lower bound of the interval to be searched * for eigenvalues. Not referenced if RANGE = 'A' or 'I'. * -* VU (global input) REAL +* VU (global input) REAL * If RANGE='V', the upper bound of the interval to be searched * for eigenvalues. Not referenced if RANGE = 'A' or 'I'. * @@ -122,7 +129,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Total number of eigenvectors computed. 0 <= NZ <= M. * The number of columns of Z that are filled. * If JOBZ .NE. 'V', NZ is not referenced. -* If JOBZ .EQ. 'V', NZ = M +* If JOBZ .EQ. 'V', NZ = M * * W (global output) REAL array, dimension (N) * Upon successful exit, the first M entries contain the selected @@ -131,7 +138,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Z (local output) REAL array, * global dimension (N, N), * local dimension ( LLD_Z, LOCc(JZ+N-1) ) -* (see Notes below for more detailed explanation of 2d arrays) +* (see Notes below for more detailed explanation of 2d arrays) * If JOBZ = 'V', then on normal exit the first M columns of Z * contain the orthonormal eigenvectors of the matrix * corresponding to the selected eigenvalues. @@ -189,8 +196,8 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * these values is returned in the first entry of the * corresponding work arrays, and no error message is issued by * PXERBLA. -* Note that in a workspace query, for performance the optimal -* workspace LWOPT is returned rather than the minimum necessary +* Note that in a workspace query, for performance the optimal +* workspace LWOPT is returned rather than the minimum necessary * WORKSPACE LWMIN. For very small matrices, LWOPT >> LWMIN. * * IWORK (local workspace) INTEGER array @@ -203,7 +210,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Let NNP = MAX( N, NPROW*NPCOL + 1, 4 ). Then: * LIWORK >= 12*NNP + 2*N when the eigenvectors are desired * LIWORK >= 10*NNP + 2*N when only the eigenvalues have to be computed -* +* * If LIWORK = -1, then LIWORK is global input and a workspace * query is assumed; the routine only calculates the minimum * and optimal size for all work arrays. Each of these @@ -226,8 +233,8 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * and memory location. * * Let A be a generic term for any 2D block cyclicly distributed array. -* Such a global array has an associated description vector DESCA, -* or DESCZ for the descriptor of Z, etc. +* Such a global array has an associated description vector DESCA, +* or DESCZ for the descriptor of Z, etc. * The length of a ScaLAPACK descriptor is nine. * In the following comments, the character _ should be read as * "of the global array". @@ -273,7 +280,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A * -* PSSYEVR assumes IEEE 754 standard compliant arithmetic. +* PSSYEVR assumes IEEE 754 standard compliant arithmetic. * * Alignment requirements * ====================== @@ -281,9 +288,9 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * The distributed submatrices A(IA:*, JA:*) and Z(IZ:IZ+M-1,JZ:JZ+N-1) * must satisfy the following alignment properties: * -* 1.Identical (quadratic) dimension: +* 1.Identical (quadratic) dimension: * DESCA(M_) = DESCZ(M_) = DESCA(N_) = DESCZ(N_) -* 2.Quadratic conformal blocking: +* 2.Quadratic conformal blocking: * DESCA(MB_) = DESCA(NB_) = DESCZ(MB_) = DESCZ(NB_) * DESCA(RSRC_) = DESCZ(RSRC_) * 3.MOD( IA-1, MB_A ) = MOD( IZ-1, MB_Z ) = 0 @@ -340,6 +347,16 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* INFO = 0 @@ -366,7 +383,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** * * Set up pointers into the WORK array -* +* *********************************************************************** INDTAU = 1 INDD = INDTAU + N @@ -382,6 +399,25 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * *********************************************************************** CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, + $ INFO, IU, IZ, JA, JZ, LIWORK, LWORK, + $ M, N, NZ, VL, VU, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSSYEVR inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I5,', IL:',I5, + $ ', INFO:',I5,', IU:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NZ:',I5,', VL:',F9.4,', VU:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW * NPCOL @@ -407,11 +443,11 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Take upper bound for VALEIG case MZ = N END IF -* +* NB = DESCA( NB_ ) IF ( WANTZ ) THEN NP00 = NUMROC( N, NB, 0, 0, NPROW ) - MQ00 = NUMROC( MZ, NB, 0, 0, NPCOL ) + MQ00 = NUMROC( MZ, NB, 0, 0, NPCOL ) INDRW = INDWORK + MAX(18*N, NP00*MQ00 + 2*NB*NB) LWMIN = INDRW - 1 + (ICEIL(MZ, NPROCS) + 2)*N ELSE @@ -436,7 +472,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** NNP = MAX( N, NPROCS+1, 4 ) IF ( WANTZ ) THEN - LIWMIN = 12*NNP + 2*N + LIWMIN = 12*NNP + 2*N ELSE LIWMIN = 10*NNP + 2*N END IF @@ -444,12 +480,12 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** * * Set up pointers into the IWORK array -* +* *********************************************************************** * Pointer to eigenpair distribution over processors - INDILU = LIWMIN - 2*NPROCS + 1 - SIZE2 = INDILU - 2*N - + INDILU = LIWMIN - 2*NPROCS + 1 + SIZE2 = INDILU - 2*N + *********************************************************************** * @@ -486,9 +522,9 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, INFO = -( 800+NB_ ) END IF IF( WANTZ ) THEN - IAROW = INDXG2P( 1, DESCA( NB_ ), MYROW, + IAROW = INDXG2P( 1, DESCA( NB_ ), MYROW, $ DESCA( RSRC_ ), NPROW ) - IZROW = INDXG2P( 1, DESCA( NB_ ), MYROW, + IZROW = INDXG2P( 1, DESCA( NB_ ), MYROW, $ DESCZ( RSRC_ ), NPROW ) IF( IAROW.NE.IZROW ) THEN INFO = -19 @@ -548,8 +584,16 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYEVR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -565,6 +609,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, M = 0 WORK( 1 ) = REAL( LWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -593,6 +641,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'PSSYNTRD', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -602,7 +654,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * *********************************************************************** OFFSET = 0 - IF( IA.EQ.1 .AND. JA.EQ.1 .AND. + IF( IA.EQ.1 .AND. JA.EQ.1 .AND. $ DESCA( RSRC_ ).EQ.0 .AND. DESCA( CSRC_ ).EQ.0 ) $ THEN CALL PSLARED1D( N, IA, JA, DESCA, WORK( INDD ), WORK( INDD2 ), @@ -638,16 +690,16 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * SET IIL, IIU * *********************************************************************** - IF ( ALLEIG ) THEN + IF ( ALLEIG ) THEN IIL = 1 IIU = N ELSE IF ( INDEIG ) THEN IIL = IL IIU = IU ELSE IF ( VALEIG ) THEN - CALL SLARRC('T', N, VLL, VUU, WORK( INDD2 ), + CALL SLARRC('T', N, VLL, VUU, WORK( INDD2 ), $ WORK( INDE2 + OFFSET ), SAFMIN, EIGCNT, IIL, IIU, INFO) -* Refine upper bound N that was taken +* Refine upper bound N that was taken MZ = EIGCNT IIL = IIL + 1 ENDIF @@ -659,6 +711,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF WORK( 1 ) = REAL( LWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -684,7 +740,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, MYIU = IWORK(INDILU+NPROCS+MYPROC) - ZOFFSET = MAX(0, MYIL - IIL - 1) + ZOFFSET = MAX(0, MYIL - IIL - 1) FIRST = ( MYIL .EQ. IIL ) @@ -703,10 +759,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - MYIL + 1 CALL SSTEGR2( JOBZ, 'I', N, WORK( INDD2 ), $ WORK( INDE2+OFFSET ), VLL, VUU, MYIL, MYIU, - $ IM, W( 1 ), WORK( INDRW ), N, + $ IM, W( 1 ), WORK( INDRW ), N, $ MYIU - MYIL + 1, - $ IWORK( 1 ), WORK( INDWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, + $ IWORK( 1 ), WORK( INDWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, $ DOL, DOU, ZOFFSET, IINFO ) * SSTEGR2 zeroes out the entire W array, so we can't just give * it the part of W we need. So here we copy the W entries into @@ -719,6 +775,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'SSTEGR2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ELSEIF ( WANTZ .AND. NPROCS.EQ.1 ) THEN @@ -731,21 +791,25 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - IIL + 1 CALL SSTEGR2( JOBZ, 'I', N, WORK( INDD2 ), $ WORK( INDE2+OFFSET ), VLL, VUU, IIL, IIU, - $ IM, W( 1 ), WORK( INDRW ), N, + $ IM, W( 1 ), WORK( INDRW ), N, $ N, - $ IWORK( 1 ), WORK( INDWORK ), SIZE1, + $ IWORK( 1 ), WORK( INDWORK ), SIZE1, $ IWORK( 2*N+1 ), SIZE2, DOL, DOU, $ ZOFFSET, IINFO ) ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'SSTEGR2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ELSEIF ( WANTZ ) THEN * * Compute representations in parallel. * Share eigenvalue computation for root between all processors -* Then compute the eigenvectors. +* Then compute the eigenvectors. * IINFO = 0 * Part 1. compute root representations and root eigenvalues @@ -754,20 +818,24 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - IIL + 1 CALL SSTEGR2A( JOBZ, 'I', N, WORK( INDD2 ), $ WORK( INDE2+OFFSET ), VLL, VUU, IIL, IIU, - $ IM, W( 1 ), WORK( INDRW ), N, - $ N, WORK( INDWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, DOL, + $ IM, W( 1 ), WORK( INDRW ), N, + $ N, WORK( INDWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, DOL, $ DOU, NEEDIL, NEEDIU, $ INDERR, NSPLIT, PIVMIN, SCALE, WL, WU, $ IINFO ) ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'SSTEGR2A', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * The second part of parallel MRRR, the representation tree -* construction begins. Upon successful completion, the +* construction begins. Upon successful completion, the * eigenvectors have been computed. This is indicated by * the flag FINISH. * @@ -780,17 +848,17 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * There are currently two ways to communicate eigenvalue information * using the BLACS. -* 1.) BROADCAST +* 1.) BROADCAST * 2.) POINT2POINT between collaborators (those processors working * jointly on a cluster. * For efficiency, BROADCAST has been disabled. -* At a later stage, other more efficient communication algorithms +* At a later stage, other more efficient communication algorithms * might be implemented, e. g. group or tree-based communication. * DOBCST = .FALSE. IF(DOBCST) THEN * First gather everything on the first processor. -* Then use BROADCAST-based communication +* Then use BROADCAST-based communication DO 45 I = 2, NPROCS IF (MYPROC .EQ. (I - 1)) THEN DSTROW = 0 @@ -803,25 +871,25 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI = 0 ENDIF IWORK(2) = LENGTHI - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF (( STARTI.GE.1 ) .AND. ( LENGTHI.GE.1 )) THEN LENGTHI2 = 2*LENGTHI * Copy eigenvalues into communication buffer CALL SCOPY(LENGTHI,W( STARTI ),1, - $ WORK( INDD ), 1) + $ WORK( INDD ), 1) * Copy uncertainties into communication buffer CALL SCOPY(LENGTHI,WORK( IINDERR+STARTI-1 ),1, - $ WORK( INDD+LENGTHI ), 1) + $ WORK( INDD+LENGTHI ), 1) * send buffer - CALL SGESD2D( ICTXT, LENGTHI2, + CALL SGESD2D( ICTXT, LENGTHI2, $ 1, WORK( INDD ), LENGTHI2, $ DSTROW, DSTCOL ) END IF ELSE IF (MYPROC .EQ. 0) THEN SRCROW = (I-1) / NPCOL SRCCOL = MOD(I-1, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) STARTI = IWORK(1) LENGTHI = IWORK(2) @@ -832,10 +900,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ WORK(INDD), LENGTHI2, SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL SCOPY( LENGTHI, WORK(INDD), 1, - $ W( STARTI ), 1) + $ W( STARTI ), 1) * copy uncertainties (errors) from communication buffer CALL SCOPY(LENGTHI,WORK(INDD+LENGTHI),1, - $ WORK( IINDERR+STARTI-1 ), 1) + $ WORK( IINDERR+STARTI-1 ), 1) END IF END IF 45 CONTINUE @@ -843,10 +911,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI2 = LENGTHI * 2 IF (MYPROC .EQ. 0) THEN * Broadcast eigenvalues and errors to all processors - CALL SCOPY(LENGTHI,W ,1, WORK( INDD ), 1) + CALL SCOPY(LENGTHI,W ,1, WORK( INDD ), 1) CALL SCOPY(LENGTHI,WORK( IINDERR ),1, - $ WORK( INDD+LENGTHI ), 1) - CALL SGEBS2D( ICTXT, 'A', ' ', LENGTHI2, 1, + $ WORK( INDD+LENGTHI ), 1) + CALL SGEBS2D( ICTXT, 'A', ' ', LENGTHI2, 1, $ WORK(INDD), LENGTHI2 ) ELSE SRCROW = 0 @@ -855,15 +923,15 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ WORK(INDD), LENGTHI2, SRCROW, SRCCOL ) CALL SCOPY( LENGTHI, WORK(INDD), 1, W, 1) CALL SCOPY(LENGTHI,WORK(INDD+LENGTHI),1, - $ WORK( IINDERR ), 1) + $ WORK( IINDERR ), 1) END IF ELSE * * Enable point2point communication between collaborators * -* Find collaborators of MYPROC +* Find collaborators of MYPROC IF( (NPROCS.GT.1).AND.(MYIL.GT.0) ) THEN - CALL PMPCOL( MYPROC, NPROCS, IIL, NEEDIL, NEEDIU, + CALL PMPCOL( MYPROC, NPROCS, IIL, NEEDIL, NEEDIU, $ IWORK(INDILU), IWORK(INDILU+NPROCS), $ COLBRT, FRSTCL, LASTCL ) ELSE @@ -872,34 +940,34 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, IF(COLBRT) THEN * If the processor collaborates with others, -* communicate information. +* communicate information. DO 47 IPROC = FRSTCL, LASTCL IF (MYPROC .EQ. IPROC) THEN STARTI = DOL IWORK(1) = STARTI LENGTHI = MYIU - MYIL + 1 IWORK(2) = LENGTHI - + IF ((STARTI.GE.1) .AND. (LENGTHI.GE.1)) THEN * Copy eigenvalues into communication buffer CALL SCOPY(LENGTHI,W( STARTI ),1, - $ WORK(INDD), 1) + $ WORK(INDD), 1) * Copy uncertainties into communication buffer CALL SCOPY(LENGTHI, $ WORK( IINDERR+STARTI-1 ),1, - $ WORK(INDD+LENGTHI), 1) + $ WORK(INDD+LENGTHI), 1) ENDIF - DO 46 I = FRSTCL, LASTCL + DO 46 I = FRSTCL, LASTCL IF(I.EQ.MYPROC) GOTO 46 DSTROW = I/ NPCOL DSTCOL = MOD(I, NPCOL) - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1) .AND. (LENGTHI.GE.1)) THEN LENGTHI2 = 2*LENGTHI * send buffer - CALL SGESD2D( ICTXT, LENGTHI2, + CALL SGESD2D( ICTXT, LENGTHI2, $ 1, WORK(INDD), LENGTHI2, $ DSTROW, DSTCOL ) END IF @@ -907,7 +975,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, ELSE SRCROW = IPROC / NPCOL SRCCOL = MOD(IPROC, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) RSTARTI = IWORK(1) RLENGTHI = IWORK(2) @@ -918,10 +986,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL SCOPY( RLENGTHI, WORK(INDE), 1, - $ W( RSTARTI ), 1) + $ W( RSTARTI ), 1) * copy uncertainties (errors) from communication buffer CALL SCOPY(RLENGTHI,WORK(INDE+RLENGTHI),1, - $ WORK( IINDERR+RSTARTI-1 ), 1) + $ WORK( IINDERR+RSTARTI-1 ), 1) END IF END IF 47 CONTINUE @@ -934,17 +1002,17 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * is constructed in parallel from top to bottom, * on level at a time, until all eigenvectors * have been computed. -* +* 100 CONTINUE IF ( MYIL.GT.0 ) THEN CALL SSTEGR2B( JOBZ, N, WORK( INDD2 ), - $ WORK( INDE2+OFFSET ), + $ WORK( INDE2+OFFSET ), $ IM, W( 1 ), WORK( INDRW ), N, N, - $ IWORK( 1 ), WORK( INDWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, DOL, + $ IWORK( 1 ), WORK( INDWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, DOL, $ DOU, NEEDIL, NEEDIU, INDWLC, $ PIVMIN, SCALE, WL, WU, - $ VSTART, FINISH, + $ VSTART, FINISH, $ MAXCLS, NDEPTH, PARITY, ZOFFSET, IINFO ) IINDWLC = INDWORK + INDWLC - 1 IF(.NOT.FINISH) THEN @@ -958,7 +1026,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LASTCL = MYPROC ENDIF * -* Check if this processor collaborates, i.e. +* Check if this processor collaborates, i.e. * communication is needed. * IF(COLBRT) THEN @@ -976,23 +1044,23 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Copy eigenvalues into communication buffer CALL SCOPY(LENGTHI, $ WORK( IINDWLC+STARTI-1 ),1, - $ WORK(INDD), 1) + $ WORK(INDD), 1) * Copy uncertainties into communication buffer CALL SCOPY(LENGTHI, $ WORK( IINDERR+STARTI-1 ),1, - $ WORK(INDD+LENGTHI), 1) + $ WORK(INDD+LENGTHI), 1) ENDIF - - DO 146 I = FRSTCL, LASTCL + + DO 146 I = FRSTCL, LASTCL IF(I.EQ.MYPROC) GOTO 146 DSTROW = I/ NPCOL DSTCOL = MOD(I, NPCOL) - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1).AND.(LENGTHI.GE.1)) THEN LENGTHI2 = 2*LENGTHI * send buffer - CALL SGESD2D( ICTXT, LENGTHI2, + CALL SGESD2D( ICTXT, LENGTHI2, $ 1, WORK(INDD), LENGTHI2, $ DSTROW, DSTCOL ) END IF @@ -1000,7 +1068,7 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, ELSE SRCROW = IPROC / NPCOL SRCCOL = MOD(IPROC, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) RSTARTI = IWORK(1) RLENGTHI = IWORK(2) @@ -1011,19 +1079,23 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL SCOPY(RLENGTHI, WORK(INDE), 1, - $ WORK( IINDWLC+RSTARTI-1 ), 1) + $ WORK( IINDWLC+RSTARTI-1 ), 1) * copy uncertainties (errors) from communication buffer CALL SCOPY(RLENGTHI,WORK(INDE+RLENGTHI),1, - $ WORK( IINDERR+RSTARTI-1 ), 1) + $ WORK( IINDERR+RSTARTI-1 ), 1) END IF END IF 147 CONTINUE ENDIF - GOTO 100 + GOTO 100 ENDIF ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'SSTEGR2B', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1055,17 +1127,17 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI = 0 ENDIF IWORK(2) = LENGTHI - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1).AND.(LENGTHI.GE.1)) THEN - CALL SGESD2D( ICTXT, LENGTHI, + CALL SGESD2D( ICTXT, LENGTHI, $ 1, W( STARTI ), LENGTHI, $ DSTROW, DSTCOL ) ENDIF ELSE IF (MYPROC .EQ. 0) THEN SRCROW = (I-1) / NPCOL SRCCOL = MOD(I-1, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) STARTI = IWORK(1) LENGTHI = IWORK(2) @@ -1100,12 +1172,16 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, CALL SLASRT2( 'I', M, W, IWORK( NPROCS+2 ), IINFO ) IF (IINFO.NE.0) THEN CALL PXERBLA( ICTXT, 'SLASRT2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF *********************************************************************** * -* TRANSFORM Z FROM 1D WORKSPACE INTO 2D BLOCKCYCLIC STORAGE +* TRANSFORM Z FROM 1D WORKSPACE INTO 2D BLOCKCYCLIC STORAGE * *********************************************************************** IF ( WANTZ ) THEN @@ -1127,12 +1203,12 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, 180 CONTINUE IF ( FIRST ) THEN - CALL PSLAEVSWP(N, WORK( INDRW ), N, Z, IZ, JZ, - $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), WORK( INDWORK ), + CALL PSLAEVSWP(N, WORK( INDRW ), N, Z, IZ, JZ, + $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), WORK( INDWORK ), $ INDRW - INDWORK ) ELSE - CALL PSLAEVSWP(N, WORK( INDRW + N ), N, Z, IZ, JZ, - $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), WORK( INDWORK ), + CALL PSLAEVSWP(N, WORK( INDRW + N ), N, Z, IZ, JZ, + $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), WORK( INDWORK ), $ INDRW - INDWORK ) END IF * @@ -1151,6 +1227,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF IF (IINFO.NE.0) THEN CALL PXERBLA( ICTXT, 'PSORMTR', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1160,6 +1240,10 @@ SUBROUTINE PSSYEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, WORK( 1 ) = REAL( LWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYEVR diff --git a/SRC/pssyevx.f b/SRC/pssyevx.f index 4e99fae2..9cdef371 100644 --- a/SRC/pssyevx.f +++ b/SRC/pssyevx.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, $ VU, IL, IU, ABSTOL, M, NZ, W, ORFAC, Z, IZ, $ JZ, DESCZ, WORK, LWORK, IWORK, LIWORK, IFAIL, @@ -6,8 +12,9 @@ SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* May 25, 2001 +* May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO INTEGER IA, IL, INFO, IU, IZ, JA, JZ, LIWORK, LWORK, M, @@ -510,10 +517,48 @@ SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, + $ INFO, IU, IZ, JA, JZ, LIWORK, LWORK, + $ M, N, NZ, ABSTOL, + $ ORFAC, VL, VU, eos_str + 102 FORMAT('PSSYEVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I5,', IL:',I5, + $ ', INFO:',I5,', IU:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NZ:',I5,', ABSTOL:',F9.4,', ORFAC:',F9.4, + $ ', VL:',F9.4,', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file * + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F QUICKRETURN = ( N.EQ.0 ) * * Test the input arguments. @@ -740,13 +785,25 @@ SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYEVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF( QUICKRETURN ) THEN IF( WANTZ ) THEN NZ = 0 @@ -755,6 +812,10 @@ SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, M = 0 WORK( 1 ) = REAL( LWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -972,6 +1033,10 @@ SUBROUTINE PSSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, WORK( 1 ) = REAL( LWOPT ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYEVX diff --git a/SRC/pssygs2.f b/SRC/pssygs2.f index db040089..addec792 100644 --- a/SRC/pssygs2.f +++ b/SRC/pssygs2.f @@ -1,4 +1,10 @@ * +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PSSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) @@ -8,6 +14,7 @@ SUBROUTINE PSSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, N @@ -189,9 +196,37 @@ SUBROUTINE PSSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, EXTERNAL LSAME, INDXG2P * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, eos_str + 102 FORMAT('PSSYGS2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', IBTYPE:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -251,13 +286,22 @@ SUBROUTINE PSSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYGS2', -INFO ) CALL BLACS_EXIT( ICTXT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. ( MYROW.NE.IAROW .OR. MYCOL.NE.IACOL ) ) - $ RETURN + IF( N.EQ.0 .OR. ( MYROW.NE.IAROW .OR. MYCOL.NE.IACOL ) ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -414,6 +458,10 @@ SUBROUTINE PSSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYGS2 diff --git a/SRC/pssygst.f b/SRC/pssygst.f index cdf0c90e..f4c69f0c 100644 --- a/SRC/pssygst.f +++ b/SRC/pssygst.f @@ -1,4 +1,10 @@ * +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, INFO ) @@ -8,6 +14,7 @@ SUBROUTINE PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, N @@ -197,9 +204,37 @@ SUBROUTINE PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, EXTERNAL LSAME, ICEIL, INDXG2P * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, SCALE, eos_str + 102 FORMAT('PSSYGST inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', IBTYPE:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5,', SCALE:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -268,13 +303,22 @@ SUBROUTINE PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYGST', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( IBTYPE.EQ.1 ) THEN IF( UPPER ) THEN @@ -433,6 +477,10 @@ SUBROUTINE PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYGST diff --git a/SRC/pssygvx.f b/SRC/pssygvx.f index 8603062c..060c9f29 100644 --- a/SRC/pssygvx.f +++ b/SRC/pssygvx.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, $ DESCA, B, IB, JB, DESCB, VL, VU, IL, IU, $ ABSTOL, M, NZ, W, ORFAC, Z, IZ, JZ, DESCZ, @@ -9,6 +15,7 @@ SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO INTEGER IA, IB, IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ, @@ -527,9 +534,44 @@ SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IB, + $ IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ, + $ LIWORK, LWORK, M, + $ N, NZ, ABSTOL, ORFAC, VL, VU, eos_str + 102 FORMAT('PSSYGVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I5,', IB:',I5, + $ ', IBTYPE:',I5,', IL:',I5,', INFO:',I5, + $ ', IU:',I5,', IZ:',I5,', JA:',I5, + $ ', JB:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NZ:',I5,', ABSTOL:',F9.4,', ORFAC:',F9.4, + $ ', VL:',F9.4,', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -747,8 +789,16 @@ SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYGVX ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -760,6 +810,10 @@ SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, WORK( 1 ) = REAL( LWOPT ) IFAIL( 1 ) = INFO INFO = IERRNPD +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -813,6 +867,10 @@ SUBROUTINE PSSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * IWORK( 1 ) = LIWMIN WORK( 1 ) = REAL( LWOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYGVX diff --git a/SRC/pssyngst.f b/SRC/pssyngst.f index 001f7929..8bb1e3b2 100644 --- a/SRC/pssyngst.f +++ b/SRC/pssyngst.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, LWORK, N @@ -237,8 +244,34 @@ SUBROUTINE PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTRINSIC ICHAR, MAX, MIN, MOD, REAL * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, LWORK, N, SCALE, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSSYNGST inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', IBTYPE:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', LWORK:',I5, + $ ', N:',I5,', SCALE:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF SCALE = 1.0E0 * NB = DESCA( MB_ ) @@ -316,20 +349,37 @@ SUBROUTINE PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYNGST', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * IF( IBTYPE.NE.1 .OR. UPPER .OR. LWORK.LT.LWOPT ) THEN CALL PSSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -419,5 +469,9 @@ SUBROUTINE PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * WORK( 1 ) = REAL( LWOPT ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END diff --git a/SRC/pssyntrd.f b/SRC/pssyntrd.f index c82a981b..1cbe2ca2 100644 --- a/SRC/pssyntrd.f +++ b/SRC/pssyntrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -287,9 +294,37 @@ SUBROUTINE PSSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, eos_str + 102 FORMAT('PSSYNTRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * Get grid parameters * ICTXT = DESCA( CTXT_ ) @@ -353,15 +388,28 @@ SUBROUTINE PSSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYNTRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * ONEPMIN = N*N + 3*N + 1 @@ -544,6 +592,10 @@ SUBROUTINE PSSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * WORK( 1 ) = REAL( TTLWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYNTRD diff --git a/SRC/pssytd2.f b/SRC/pssytd2.f index 177b2668..ad99bf7f 100644 --- a/SRC/pssytd2.f +++ b/SRC/pssytd2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -242,11 +249,34 @@ SUBROUTINE PSSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSSYTD2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -277,15 +307,28 @@ SUBROUTINE PSSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYTD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -457,6 +500,10 @@ SUBROUTINE PSSYTD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYTD2 diff --git a/SRC/pssytrd.f b/SRC/pssytrd.f index 28a18a24..af915d0e 100644 --- a/SRC/pssytrd.f +++ b/SRC/pssytrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -253,11 +260,34 @@ SUBROUTINE PSSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSSYTRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -307,15 +337,28 @@ SUBROUTINE PSSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYTRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) @@ -418,6 +461,10 @@ SUBROUTINE PSSYTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYTRD diff --git a/SRC/pssyttrd.f b/SRC/pssyttrd.f index bd214ca7..fa4f7f08 100644 --- a/SRC/pssyttrd.f +++ b/SRC/pssyttrd.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -456,9 +463,37 @@ SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * * * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, eos_str + 102 FORMAT('PSSYTTRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * @@ -565,13 +600,22 @@ SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYTTRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * @@ -655,6 +699,10 @@ SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSSYTTRD', -INFO ) WORK( 1 ) = REAL( LWMIN ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1189,6 +1237,10 @@ SUBROUTINE PSSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * * WORK( 1 ) = REAL( LWMIN ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSSYTTRD diff --git a/SRC/pstrcon.f b/SRC/pstrcon.f index 10bd7df0..765591db 100644 --- a/SRC/pstrcon.f +++ b/SRC/pstrcon.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, $ WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -7,6 +13,7 @@ SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * May 25, 2001 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER IA, JA, INFO, LIWORK, LWORK, N @@ -219,11 +226,37 @@ SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, INFO, + $ LIWORK, LWORK, N, RCOND, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSTRCON inputs: ,DIAG:',A5,', NORM:',A5, + $ ', UPLO:',A5,', IA:',I5,', JA:',I5, + $ ', INFO:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', RCOND:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -302,8 +335,16 @@ SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTRCON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -311,6 +352,10 @@ SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -419,6 +464,10 @@ SUBROUTINE PSTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTRCON diff --git a/SRC/pstrord.f b/SRC/pstrord.f index 5cdb5491..95b030b7 100644 --- a/SRC/pstrord.f +++ b/SRC/pstrord.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, $ DESCT, Q, IQ, JQ, DESCQ, WR, WI, M, WORK, LWORK, $ IWORK, LIWORK, INFO ) @@ -9,6 +15,7 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -356,10 +363,36 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCT( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COMPQ, INFO, LIWORK, LWORK, + $ M, N, IT, JT, IQ, + $ JQ, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSTRORD inputs: ,COMPQ:',A5,', INFO:',I5, + $ ', LIWORK:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5,', IT:',I5,', JT:',I5, + $ ', IQ:',I5,', JQ:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL * * Test if grid is O.K., i.e., the context is valid. @@ -532,10 +565,18 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, IF( INFO.NE.0 .AND. .NOT.LQUERY ) THEN M = 0 CALL PXERBLA( ICTXT, 'PSTRORD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSEIF( LQUERY ) THEN WORK( 1 ) = FLOAT(LWMIN) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -3457,6 +3498,10 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, * * Return to calling program. * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTRORD diff --git a/SRC/pstrrfs.f b/SRC/pstrrfs.f index 697cdeee..b49da771 100644 --- a/SRC/pstrrfs.f +++ b/SRC/pstrrfs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, $ B, IB, JB, DESCB, X, IX, JX, DESCX, FERR, $ BERR, WORK, LWORK, IWORK, LIWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, TRANS, UPLO INTEGER INFO, IA, IB, IX, JA, JB, JX, LIWORK, LWORK, @@ -283,11 +290,39 @@ SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, INFO, IA, + $ IB, IX, JA, JB, JX, LIWORK, LWORK, + $ N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSTRRFS inputs: ,DIAG:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', INFO:',I5,', IA:',I5, + $ ', IB:',I5,', IX:',I5,', JA:',I5, + $ ', JB:',I5,', JX:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -402,8 +437,16 @@ SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTRRFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -418,6 +461,10 @@ SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -789,6 +836,10 @@ SUBROUTINE PSTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTRRFS diff --git a/SRC/pstrsen.f b/SRC/pstrsen.f index 1922e8f1..a35e3c8a 100644 --- a/SRC/pstrsen.f +++ b/SRC/pstrsen.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, $ DESCT, Q, IQ, JQ, DESCQ, WR, WI, M, S, SEP, WORK, LWORK, $ IWORK, LIWORK, INFO ) @@ -10,6 +16,7 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, * Univ. of Colorado Denver and University of California, Berkeley. * January, 2012 * + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * .. Scalar Arguments .. @@ -381,10 +388,38 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCT( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COMPQ, JOB, INFO, LIWORK, LWORK, + $ M, N, IT, JT, + $ IQ, JQ, S, SEP, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PSTRSEN inputs: ,COMPQ:',A5,', JOB:',A5, + $ ', INFO:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', IT:',I5, + $ ', JT:',I5,', IQ:',I5,', JQ:',I5, + $ ', S:',F9.4,', SEP:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW*NPCOL * * Test if grid is O.K., i.e., the context is valid @@ -617,10 +652,18 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, S = ONE SEP = ZERO CALL PXERBLA( ICTXT, 'PSTRSEN', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSEIF( LQUERY ) THEN WORK( 1 ) = FLOAT(LWMIN) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -705,6 +748,10 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, * 50 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTRSEN diff --git a/SRC/pstrti2.f b/SRC/pstrti2.f index f6cd2277..81b7078d 100644 --- a/SRC/pstrti2.f +++ b/SRC/pstrti2.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER IA, INFO, JA, N @@ -149,11 +156,34 @@ SUBROUTINE PSTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSTRTI2 inputs: ,DIAG:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', JA:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -173,6 +203,10 @@ SUBROUTINE PSTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTRTI2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -271,6 +305,10 @@ SUBROUTINE PSTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PSTRTI2 * END diff --git a/SRC/pstrtri.f b/SRC/pstrtri.f index 5bfc6e11..71d2047b 100644 --- a/SRC/pstrtri.f +++ b/SRC/pstrtri.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER IA, INFO, JA, N @@ -162,11 +169,34 @@ SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSTRTRI inputs: ,DIAG:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', JA:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test input parameters * INFO = 0 @@ -210,13 +240,22 @@ SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTRTRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Check for singularity if non-unit. * @@ -265,8 +304,13 @@ SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) 30 CONTINUE CALL IGAMX2D( ICTXT, 'All', ' ', 1, 1, INFO, 1, IDUMMY, $ IDUMMY, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF * * Use blocked code @@ -346,6 +390,10 @@ SUBROUTINE PSTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PSTRTRI diff --git a/SRC/pstrtrs.f b/SRC/pstrtrs.f index 89a21ebc..ce17e03f 100644 --- a/SRC/pstrtrs.f +++ b/SRC/pstrtrs.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, $ B, IB, JB, DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, TRANS, UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -192,11 +199,37 @@ SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, IA, IB, + $ INFO, JA, JB, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PSTRTRS inputs: ,DIAG:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', IA:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', JB:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test input parameters * INFO = 0 @@ -261,13 +294,22 @@ SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTRTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Check for singularity if non-unit. * @@ -317,8 +359,13 @@ SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, 30 CONTINUE CALL IGAMX2D( ICTXT, 'All', ' ', 1, 1, INFO, 1, IDUM, IDUM, $ -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF * * Solve A * x = b or A' * x = b. @@ -326,6 +373,10 @@ SUBROUTINE PSTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, CALL PSTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, IA, JA, $ DESCA, B, IB, JB, DESCB ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTRTRS diff --git a/SRC/pstzrzf.f b/SRC/pstzrzf.f index 34f822d7..325677e0 100644 --- a/SRC/pstzrzf.f +++ b/SRC/pstzrzf.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PSTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PSTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -213,11 +220,34 @@ SUBROUTINE PSTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PSTZRZF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,15 +286,28 @@ SUBROUTINE PSTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PSTZRZF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( M.EQ.N ) THEN * @@ -327,6 +370,10 @@ SUBROUTINE PSTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = REAL( LWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PSTZRZF From 0a6c3e65ae8732e442f69938c37115ea212ec204 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Thu, 5 Oct 2023 11:50:23 +0530 Subject: [PATCH 16/29] Fix added in the aocl-progress test code for the build errors related to 'implicit function calls' with clang-17 compiler in Linux. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3984] Change-Id: I30a4ba5919f98c6ec72847564cdb9be373104f19 --- .../test_aocl_progress_pcgeqrf.c | 40 ++++++++++------- .../test_aocl_progress_pcgetrf.c | 25 ++++++++--- .../test_aocl_progress_pcpotrf.c | 25 ++++++++--- .../test_aocl_progress_pdgeqrf.c | 37 ++++++++++------ .../test_aocl_progress_pdgetrf.c | 17 +++++-- .../test_aocl_progress_pdpotrf.c | 25 ++++++++--- .../test_aocl_progress_psgeqrf.c | 38 ++++++++++------ .../test_aocl_progress_psgetrf.c | 25 ++++++++--- .../test_aocl_progress_pspotrf.c | 27 ++++++++---- .../test_aocl_progress_pzgeqrf.c | 44 +++++++++++-------- .../test_aocl_progress_pzgetrf.c | 25 ++++++++--- .../test_aocl_progress_pzpotrf.c | 25 ++++++++--- 12 files changed, 239 insertions(+), 114 deletions(-) diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgeqrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgeqrf.c index cd3e8052..122aee38 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgeqrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgeqrf.c @@ -12,24 +12,32 @@ #define SL_complex_float float _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); - -/* Target API Prototype */ -void pcgerqf_(Int*, Int*, SL_complex_float*, Int*, Int*, Int*, SL_complex_float*, SL_complex_float*, Int*, Int*); - void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +void pcgeqrf_(Int*, Int*, SL_complex_float*, Int*, Int*, Int*, SL_complex_float*, SL_complex_float*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -96,10 +104,10 @@ int main(int argc, char **argv) { SL_complex_float *A; A = (SL_complex_float *)calloc(mpA*nqA,sizeof(SL_complex_float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - SL_complex_float work_buffer_size; - SL_complex_float *work, *tau; - Int lwork = -1; - tau = (SL_complex_float *)calloc((mpA+nqA),sizeof(SL_complex_float)) ; + SL_complex_float work_buffer_size; + SL_complex_float *work, *tau; + Int lwork = -1; + tau = (SL_complex_float *)calloc((mpA+nqA),sizeof(SL_complex_float)) ; Int k = 0; for (Int j = 0; j < nqA; j++) { // local col @@ -133,10 +141,10 @@ int main(int argc, char **argv) { pcgeqrf_(&m, &n, A, &ione, &jone, descA, tau, &work_buffer_size, &lwork, &info); - work = (SL_complex_float *)calloc(work_buffer_size, sizeof(SL_complex_float)) ; - lwork = work_buffer_size; + work = (SL_complex_float *)calloc(work_buffer_size, sizeof(SL_complex_float)) ; + lwork = work_buffer_size; - // Run pdpotrf and time + // Run pcgeqrf_ and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pcgeqrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgetrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgetrf.c index 127a1c5e..78987464 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgetrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcgetrf.c @@ -12,6 +12,16 @@ #define SL_complex_float float _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -19,11 +29,12 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pcgetrf_(Int*, Int*, SL_complex_float*, Int*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { char api_name[20]; memcpy(api_name, api, *lenapi); @@ -83,13 +94,13 @@ int main(int argc, char **argv) { // Allocate and fill the matrices A and B // A[I,J] = (I == J ? 5*n : I+J) SL_complex_float *A; - Int *IPPIV; + Int *IPPIV; A = (SL_complex_float *)calloc(mpA*nqA,sizeof(SL_complex_float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + IPPIV = (Int *)calloc(2*n,sizeof(Int)) ; if (IPPIV==NULL){ printf("Error of memory allocation IPPIV %d\n",2*n); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -120,7 +131,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pcgetrf and time + // Run pcgetrf and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pcgetrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcpotrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcpotrf.c index b444c2b3..91d1091d 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcpotrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pcpotrf.c @@ -12,6 +12,16 @@ #define SL_complex_float float _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -19,14 +29,15 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pcpotrf_(char*, Int*, SL_complex_float*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -85,7 +96,7 @@ int main(int argc, char **argv) { SL_complex_float *A; A = (SL_complex_float *)calloc(mpA*nqA,sizeof(SL_complex_float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -116,7 +127,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pcpotrf and time + // Run pcpotrf and measure time double MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pcpotrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgeqrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgeqrf.c index 230c2294..47bb14a5 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgeqrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgeqrf.c @@ -10,21 +10,32 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); -void pdgerqf_(Int*, Int*, double*, Int*, Int*, Int*, double*, double*, Int*, Int*); +void pdgeqrf_(Int*, Int*, double*, Int*, Int*, Int*, double*, double*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -92,10 +103,10 @@ int main(int argc, char **argv) { double *A; A = (double *)calloc(mpA*nqA,sizeof(double)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - double work_buffer_size; - double *work, *tau; - Int lwork = -1; - tau = (double *)calloc((mpA+nqA),sizeof(double)) ; + double work_buffer_size; + double *work, *tau; + Int lwork = -1; + tau = (double *)calloc((mpA+nqA),sizeof(double)) ; Int k = 0; for (Int j = 0; j < nqA; j++) { // local col @@ -129,10 +140,10 @@ int main(int argc, char **argv) { pdgeqrf_(&m, &n, A, &ione, &jone, descA, tau, &work_buffer_size, &lwork, &info); - work = (double *)calloc(work_buffer_size, sizeof(double)) ; - lwork = work_buffer_size; + work = (double *)calloc(work_buffer_size, sizeof(double)) ; + lwork = work_buffer_size; - // Run pdpotrf and time + // Run pdgeqrf_ and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pdgeqrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgetrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgetrf.c index 71f2c2a1..9afcb2f8 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgetrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdgetrf.c @@ -10,6 +10,16 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -17,9 +27,10 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pdgetrf_(Int*, Int*, double*, Int*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); -Int numroc_(Int*, Int*, Int*, Int*, Int*); - +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); +Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { @@ -118,7 +129,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pdgetrf and time + // Run pdgetrf and measure time double MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pdgetrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdpotrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdpotrf.c index 307f916a..cb3334d8 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdpotrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pdpotrf.c @@ -10,6 +10,16 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -17,14 +27,15 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pdpotrf_(char*, Int*, double*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -83,7 +94,7 @@ int main(int argc, char **argv) { double *A; A = (double *)calloc(mpA*nqA,sizeof(double)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -114,7 +125,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pdpotrf and time + // Run pdpotrf and measure time double MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pdpotrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgeqrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgeqrf.c index 2d4493fc..793fdc5d 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgeqrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgeqrf.c @@ -10,22 +10,32 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); -//void pdpotrf_(char*, Int*, float*, Int*, Int*, Int*, Int*); -void pdgerqf_(Int*, Int*, float*, Int*, Int*, Int*, float*, float*, Int*, Int*); +void psgeqrf_(Int*, Int*, float*, Int*, Int*, Int*, float*, float*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -93,10 +103,10 @@ int main(int argc, char **argv) { float *A; A = (float *)calloc(mpA*nqA,sizeof(float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - float work_buffer_size; - float *work, *tau; - Int lwork = -1; - tau = (float *)calloc((mpA+nqA),sizeof(float)) ; + float work_buffer_size; + float *work, *tau; + Int lwork = -1; + tau = (float *)calloc((mpA+nqA),sizeof(float)) ; Int k = 0; for (Int j = 0; j < nqA; j++) { // local col @@ -130,10 +140,10 @@ int main(int argc, char **argv) { psgeqrf_(&m, &n, A, &ione, &jone, descA, tau, &work_buffer_size, &lwork, &info); - work = (float *)calloc(work_buffer_size, sizeof(float)) ; - lwork = work_buffer_size; + work = (float *)calloc(work_buffer_size, sizeof(float)) ; + lwork = work_buffer_size; - // Run pdpotrf and time + // Run psgeqrf_ and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting psgeqrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgetrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgetrf.c index e574565c..27792a24 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgetrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_psgetrf.c @@ -10,6 +10,16 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -17,11 +27,12 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void psgetrf_(Int*, Int*, float*, Int*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { char api_name[20]; memcpy(api_name, api, *lenapi); @@ -82,13 +93,13 @@ int main(int argc, char **argv) { // Allocate and fill the matrices A and B // A[I,J] = (I == J ? 5*n : I+J) float *A; - Int *IPPIV; + Int *IPPIV; A = (float *)calloc(mpA*nqA,sizeof(float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + IPPIV = (Int *)calloc(2*n,sizeof(Int)) ; if (IPPIV==NULL){ printf("Error of memory allocation IPPIV %d\n",2*n); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -119,7 +130,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run psgetrf and time + // Run psgetrf and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting psgetrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pspotrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pspotrf.c index d91ccaa3..457e1376 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pspotrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pspotrf.c @@ -10,6 +10,16 @@ #endif #include "mpi.h" +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -17,14 +27,15 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pspotrf_(char*, Int*, float*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -79,10 +90,10 @@ int main(int argc, char **argv) { // Allocate and fill the matrices A and B // A[I,J] = (I == J ? 5*n : I+J) - float *A; + float *A; A = (float *)calloc(mpA*nqA,sizeof(float)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -113,7 +124,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pspotrf and time + // Run pspotrf and measure time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pspotrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgeqrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgeqrf.c index 90e6880c..306b969a 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgeqrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgeqrf.c @@ -12,24 +12,32 @@ #define SL_complex_double double _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); - -/* Target API Prototype */ -void pzgerqf_(Int*, Int*, SL_complex_double*, Int*, Int*, Int*, SL_complex_double*, SL_complex_double*, Int*, Int*); - +void pzgeqrf_(Int*, Int*, SL_complex_double*, Int*, Int*, Int*, SL_complex_double*, SL_complex_double*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -97,10 +105,10 @@ int main(int argc, char **argv) { SL_complex_double *A; A = (SL_complex_double *)calloc(mpA*nqA,sizeof(SL_complex_double)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - SL_complex_double work_buffer_size; - SL_complex_double *work, *tau; - Int lwork = -1; - tau = (SL_complex_double *)calloc((mpA+nqA),sizeof(SL_complex_double)) ; + SL_complex_double work_buffer_size; + SL_complex_double *work, *tau; + Int lwork = -1; + tau = (SL_complex_double *)calloc((mpA+nqA),sizeof(SL_complex_double)) ; Int k = 0; for (Int j = 0; j < nqA; j++) { // local col @@ -132,16 +140,16 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - pzgerqf_(&m, &n, A, &ione, &jone, descA, tau, &work_buffer_size, &lwork, &info); + pzgeqrf_(&m, &n, A, &ione, &jone, descA, tau, &work_buffer_size, &lwork, &info); - work = (SL_complex_double *)calloc(work_buffer_size, sizeof(SL_complex_double)) ; - lwork = work_buffer_size; + work = (SL_complex_double *)calloc(work_buffer_size, sizeof(SL_complex_double)) ; + lwork = work_buffer_size; - // Run pdpotrf and time + // Run pzgeqrf_ and time float MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pzgeqrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); - pzgerqf_(&m, &n, A, &ione, &jone, descA, tau, work, &lwork, &info); + pzgeqrf_(&m, &n, A, &ione, &jone, descA, tau, work, &lwork, &info); if (info != 0) { printf("Error in pzgeqrf, info = %i\n", info); } diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgetrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgetrf.c index d91bd1df..6f98415a 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgetrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzgetrf.c @@ -12,6 +12,16 @@ #define SL_complex_double double _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -19,11 +29,12 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pzgetrf_(Int*, Int*, SL_complex_double*, Int*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { char api_name[20]; memcpy(api_name, api, *lenapi); @@ -83,13 +94,13 @@ int main(int argc, char **argv) { // Allocate and fill the matrices A and B // A[I,J] = (I == J ? 5*n : I+J) SL_complex_double *A; - Int *IPPIV; + Int *IPPIV; A = (SL_complex_double *)calloc(mpA*nqA,sizeof(SL_complex_double)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + IPPIV = (Int *)calloc(2*n,sizeof(Int)) ; if (IPPIV==NULL){ printf("Error of memory allocation IPPIV %d\n",2*n); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -120,7 +131,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pzgetrf and time + // Run pzgetrf and measure time double MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pzgetrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); diff --git a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzpotrf.c b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzpotrf.c index 2d1aacda..43b1a60e 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzpotrf.c +++ b/TESTING/AOCL_PROGRESS_TESTS/test_aocl_progress_pzpotrf.c @@ -12,6 +12,16 @@ #define SL_complex_double double _Complex +/** Typedefs **/ +typedef Int ( *aocl_scalapack_progress_callback )( +const char * const api, +const Int *lenapi, +const Int *progress, +const Int *current_process, +const Int *total_processes +); + +/** Function prototype declarations **/ void blacs_get_(Int*, Int*, Int*); void blacs_pinfo_(Int*, Int*); void blacs_gridinit_(Int*, char*, Int*, Int*); @@ -19,14 +29,15 @@ void blacs_gridinfo_(Int*, Int*, Int*, Int*, Int*); void descinit_(Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*, Int*); void pzpotrf_(char*, Int*, SL_complex_double*, Int*, Int*, Int*, Int*); void blacs_gridexit_(Int*); +void aocl_scalapack_set_progress(aocl_scalapack_progress_callback AOCL_progress_ptr); +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes); Int numroc_(Int*, Int*, Int*, Int*, Int*); +/** Prototype declaration end **/ -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes); - -Int AOCL_progress(char* api, Int *lenapi, Int *progress, Int *mpi_rank, Int *total_mpi_processes) +Int AOCL_progress(const char* const api, const Int *lenapi, const Int *progress, const Int *mpi_rank, const Int *total_mpi_processes) { - char api_name[20]; - memcpy(api_name, api, *lenapi); + char api_name[20]; + memcpy(api_name, api, *lenapi); printf( "In AOCL Progress MPI Rank: %i API: %s progress: %i MPI processes: %i\n", *mpi_rank, api_name, *progress,*total_mpi_processes ); return 0; } @@ -85,7 +96,7 @@ int main(int argc, char **argv) { SL_complex_double *A; A = (SL_complex_double *)calloc(mpA*nqA,sizeof(SL_complex_double)) ; if (A==NULL){ printf("Error of memory allocation A on proc %dx%d\n",myrow,mycol); exit(0); } - + Int k = 0; for (Int j = 0; j < nqA; j++) { // local col Int l_j = j / nb; // which block @@ -116,7 +127,7 @@ int main(int argc, char **argv) { printf("Error in descinit, info = %i\n", info); } - // Run pzpotrf and time + // Run pzpotrf and measure time double MPIt1 = MPI_Wtime(); printf("[%dx%d] Starting pzpotrf\n", myrow, mycol); aocl_scalapack_set_progress(&AOCL_progress); From 3e2d66d728c201acb6939a57c89c55eb436c3232 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Mon, 9 Oct 2023 15:57:41 +0530 Subject: [PATCH 17/29] Fix added for windows static build linker errors with static blis, libflame libraries. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3961] Change-Id: Ic662b79c633a814d5fba15084f876eedc6c13ee7 --- CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index cb3f9416..1655d525 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -44,6 +44,9 @@ option (ENABLE_LARGE_MATRIX_TESTING "Dynamic allocation of work buffer memory in if (WIN32 AND CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set (CMAKE_IFORT_LIBDEPS_DIR "C:/Program Files (x86)/IntelSWTools/compilers_and_libraries/windows/compiler/lib/intel64_win" CACHE STRING "") + # set the "FORCE:MULTIPLE" option to handle linker errors due to some + # of the common functions of scalapack and lapack in case of static build. + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} /FORCE:MULTIPLE") endif() set(CMAKE_ICC_FLAGS " ") From ee932f1a016d848816ffc2e103c1ae9d011a32e1 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Fri, 15 Sep 2023 12:59:34 +0530 Subject: [PATCH 18/29] Trace and Logging feature corrected for 56 double data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3509] Change-Id: I0c777421a1ef1e73aaddb615d8d3d5b630d6dc44 --- SRC/pddbsv.f | 27 ++++----- SRC/pddtsv.f | 25 ++++---- SRC/pdgbsv.f | 27 ++++----- SRC/pdgesvd.f | 33 +++++------ SRC/pdlabad.f | 16 ++--- SRC/pdlabrd.f | 26 ++++----- SRC/pdlacp2.f | 26 ++++----- SRC/pdlacp3.f | 24 ++++---- SRC/pdlacpy.f | 10 ++-- SRC/pdlaed0.f | 23 ++++---- SRC/pdlaed1.f | 26 ++++----- SRC/pdlaed2.f | 34 +++++------ SRC/pdlaed3.f | 29 +++++----- SRC/pdlaedz.f | 24 ++++---- SRC/pdlaevswp.f | 23 ++++---- SRC/pdlahqr.f | 29 +++++----- SRC/pdlahrd.f | 25 ++++---- SRC/pdlamch.f | 4 +- SRC/pdlamr1d.f | 23 ++++---- SRC/pdlapv2.f | 27 ++++----- SRC/pdlaqge.f | 28 ++++----- SRC/pdlaqr1.f | 29 +++++----- SRC/pdlaqr2.f | 37 ++++++------ SRC/pdlaqr3.f | 19 +++--- SRC/pdlaqr4.f | 33 ++++++----- SRC/pdlaqr5.f | 17 +++--- SRC/pdlaqsy.f | 27 ++++----- SRC/pdlared1d.f | 23 ++++---- SRC/pdlared2d.f | 23 ++++---- SRC/pdlarf.f | 26 ++++----- SRC/pdlarfb.f | 29 +++++----- SRC/pdlarft.f | 26 ++++----- SRC/pdlarz.f | 27 ++++----- SRC/pdlarzb.f | 29 +++++----- SRC/pdlase2.f | 26 ++++----- SRC/pdlaset.f | 11 ++-- SRC/pdlasrt.f | 31 +++++----- SRC/pdlaswp.f | 35 ++++++----- SRC/pdlatrd.f | 26 ++++----- SRC/pdlatrz.f | 23 ++++---- SRC/pdlauu2.f | 23 ++++---- SRC/pdlauum.f | 6 +- SRC/pdpbsv.f | 27 ++++----- SRC/pdptsv.f | 25 ++++---- SRC/pdstebz.f | 151 +++++++++++++++++++++++++++++++++++++++++++++++- SRC/pdstedc.f | 27 ++++----- SRC/pdstein.f | 31 +++++----- SRC/pdsyev.f | 29 +++++----- SRC/pdsyevd.f | 29 +++++----- SRC/pdsyevx.f | 39 ++++++------- SRC/pdsygs2.f | 27 ++++----- SRC/pdsygst.f | 28 ++++----- SRC/pdsygvx.f | 41 ++++++------- SRC/pdsyntrd.f | 26 ++++----- SRC/pdsyttrd.f | 26 ++++----- SRC/pdtrti2.f | 13 +++-- 56 files changed, 802 insertions(+), 752 deletions(-) diff --git a/SRC/pddbsv.f b/SRC/pddbsv.f index f0dbab2a..176860ff 100644 --- a/SRC/pddbsv.f +++ b/SRC/pddbsv.f @@ -389,7 +389,6 @@ SUBROUTINE PDDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDDBTRF, PDDBTRS, PXERBLA * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -402,6 +401,18 @@ SUBROUTINE PDDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PDDBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PDDBTRF and PDDBTRS. @@ -432,20 +443,6 @@ SUBROUTINE PDDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, - $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDDBSV inputs:,BWL:',I5,',BWU:',I5,',IB:',I5, - $ ',INFO:',I5,',JA:',I5,',LWORK:',I5, - $ ',N:',I5,',NRHS:',I5,',NPROW:',I5, - $ ',NPCOL:',I5 ,',MYROW:',I5,',MYCOL:',I5,A5) - AOCL_DTL_LOG_ENTRY_F - END IF -* * * Size needed for AF in factorization * diff --git a/SRC/pddtsv.f b/SRC/pddtsv.f index da1e4c2e..282a6fa9 100644 --- a/SRC/pddtsv.f +++ b/SRC/pddtsv.f @@ -399,7 +399,6 @@ SUBROUTINE PDDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDDTTRF, PDDTTRS, PXERBLA * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -412,6 +411,17 @@ SUBROUTINE PDDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ eos_str + 102 FORMAT('PDDTSV inputs: ,IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PDDTTRF and PDDTTRS. @@ -445,19 +455,6 @@ SUBROUTINE PDDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDDTSV inputs:,IB:',I5,',INFO:',I5,',JA:',I5, - $ ',LWORK:',I5,',N:',I5,',NRHS:',I5, - $ ',NPROW:',I5,',NPCOL:',I5 ,',MYROW:',I5, - $ ',MYCOL:',I5,A5) - AOCL_DTL_LOG_ENTRY_F - END IF -* * * Size needed for AF in factorization * diff --git a/SRC/pdgbsv.f b/SRC/pdgbsv.f index 93aebe82..f497d7f6 100644 --- a/SRC/pdgbsv.f +++ b/SRC/pdgbsv.f @@ -394,7 +394,6 @@ SUBROUTINE PDGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * .. External Subroutines .. EXTERNAL PDGBTRF, PDGBTRS, PXERBLA * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -407,6 +406,18 @@ SUBROUTINE PDGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PDGBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PDGBTRF and PDGBTRS. @@ -437,20 +448,6 @@ SUBROUTINE PDGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, - $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDGBSV inputs:,BWL:',I5,',BWU:',I5,',IB:',I5, - $ ',INFO:',I5,',JA:',I5,',LWORK:',I5, - $ ',N:',I5,',NRHS:',I5,',NPROW:',I5, - $ ',NPCOL:',I5 ,',MYROW:',I5,',MYCOL:',I5,A5) - AOCL_DTL_LOG_ENTRY_F - END IF -* * * Size needed for AF in factorization * diff --git a/SRC/pdgesvd.f b/SRC/pdgesvd.f index 440be3b9..cf4ca40b 100644 --- a/SRC/pdgesvd.f +++ b/SRC/pdgesvd.f @@ -327,7 +327,6 @@ SUBROUTINE PDGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * .. Intrinsic Functions .. INTRINSIC MAX,MIN,SQRT,DBLE * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -339,30 +338,30 @@ SUBROUTINE PDGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F -* This is just to keep ftnchek happy -* -* Capture the subroutine exit in the trace file -* - AOCL_DTL_TRACE_EXIT_F - IF (BLOCK_CYCLIC_2D*DTYPE_*LLD_*MB_*M_*NB_*N_.LT.0) RETURN -* - CALL BLACS_GRIDINFO(DESCA(CTXT_),NPROW,NPCOL,MYPROW,MYPCOL) * * Update the log buffer with the scalar arguments details, * MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN WRITE(LOG_BUF,102) JOBU,JOBVT, IA,INFO,IU,IVT, - $ JA,JU,JVT,LWORK,M,N, NPROW, NPCOL, MYROW, - $ MYCOL, eos_str - 102 FORMAT('PDGESVD inputs:,JOBU:',A5,',JOBVT:',A5, - $ ',IA:',I5,',INFO:',I5,',IU:',I5,',IVT:',I5, - $ ',JA:',I5,',JU:',I5,',JVT:',I5, - $ ',LWORK:',I5,',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5 ,',MYROW:',I5, - $ ',MYCOL:',I5,A5) + $ JA,JU,JVT,LWORK,M,N, eos_str + 102 FORMAT('PDGESVD inputs: ,JOBU:',A5,', JOBVT:',A5, + $ ', IA:',I5,', INFO:',I5,', IU:',I5, + $ ', IVT:',I5,', JA:',I5,', JU:',I5, + $ ', JVT:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5, A1 ) AOCL_DTL_LOG_ENTRY_F END IF +* This is just to keep ftnchek happy + IF (BLOCK_CYCLIC_2D*DTYPE_*LLD_*MB_*M_*NB_*N_.LT.0) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + CALL BLACS_GRIDINFO(DESCA(CTXT_),NPROW,NPCOL,MYPROW,MYPCOL) ISCALE = 0 INFO = 0 * diff --git a/SRC/pdlabad.f b/SRC/pdlabad.f index 6d2b57cd..04aafda2 100644 --- a/SRC/pdlabad.f +++ b/SRC/pdlabad.f @@ -60,7 +60,6 @@ SUBROUTINE PDLABAD( ICTXT, SMALL, LARGE ) * .. Intrinsic Functions .. INTRINSIC LOG10, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -68,18 +67,21 @@ SUBROUTINE PDLABAD( ICTXT, SMALL, LARGE ) * CALL AOCL_SCALAPACK_INIT( ) * +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) LARGE, SMALL, eos_str - 102 FORMAT('PDLABAD inputs:,LARGE:',F9.4,',SMALL:',F9.4,A1) + WRITE(LOG_BUF,102) ICTXT, LARGE, SMALL, eos_str + 102 FORMAT('PDLABAD inputs: ,ICTXT:',I5,', LARGE:',F9.4, + $ ', SMALL:',F9.4, A1 ) AOCL_DTL_LOG_ENTRY_F END IF * -* Capture the subroutine entry in the trace file -* - AOCL_DTL_TRACE_ENTRY_F -* * If it looks like we're on a Cray, take the square root of * SMALL and LARGE to avoid overflow and underflow problems. * diff --git a/SRC/pdlabrd.f b/SRC/pdlabrd.f index 023b1b36..e006c755 100644 --- a/SRC/pdlabrd.f +++ b/SRC/pdlabrd.f @@ -276,7 +276,6 @@ SUBROUTINE PDLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -289,6 +288,18 @@ SUBROUTINE PDLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, + $ N, NB, eos_str + 102 FORMAT('PDLABRD inputs: ,IA:',I5,', IX:',I5,', IY:',I5, + $ ', JA:',I5,', JX:',I5,', JY:',I5, + $ ', M:',I5,', N:',I5,', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN @@ -301,19 +312,6 @@ SUBROUTINE PDLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, N, - $ NB, NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLABRD inputs:,IA:',I5,',IX:',I5,',IY:',I5, - $ ',JA:',I5,',JX:',I5,',JY:',I5, - $ ',M:',I5,',N:',I5,',NB:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, JJ, $ IAROW, IACOL ) IPY = DESCA( MB_ ) + 1 diff --git a/SRC/pdlacp2.f b/SRC/pdlacp2.f index b779862d..cf094883 100644 --- a/SRC/pdlacp2.f +++ b/SRC/pdlacp2.f @@ -173,7 +173,6 @@ SUBROUTINE PDLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -185,6 +184,18 @@ SUBROUTINE PDLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PDLACP2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * @@ -197,19 +208,6 @@ SUBROUTINE PDLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Get grid parameters * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLACP2 inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, - $ ',JA:',I5,',JB:',I5,',M:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) diff --git a/SRC/pdlacp3.f b/SRC/pdlacp3.f index 66bd02c3..0e7a69da 100644 --- a/SRC/pdlacp3.f +++ b/SRC/pdlacp3.f @@ -165,7 +165,6 @@ SUBROUTINE PDLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -177,6 +176,16 @@ SUBROUTINE PDLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, eos_str + 102 FORMAT('PDLACP3 inputs: ,I:',I5,', II:',I5,', JJ:',I5, + $ ', LDB:',I5,', M:',I5,', REV:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( M.LE.0 ) THEN * @@ -193,19 +202,6 @@ SUBROUTINE PDLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) JAFIRST = DESCA( CSRC_ ) * CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLACP3 inputs:,I:',I5,',II:',I5,',JJ:',I5, - $ ',LDB:',I5,',M:',I5,',REV:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * IF( REV.EQ.0 ) THEN DO 20 IDI = 1, M diff --git a/SRC/pdlacpy.f b/SRC/pdlacpy.f index cd652e3a..a2b52dd8 100644 --- a/SRC/pdlacpy.f +++ b/SRC/pdlacpy.f @@ -167,7 +167,6 @@ SUBROUTINE PDLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -183,12 +182,13 @@ SUBROUTINE PDLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Update the log buffer with the scalar arguments details, * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, eos_str - 102 FORMAT('PDLACPY inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, - $ ',JA:',I5,',JB:',I5,',M:',I5,',N:',I5,A1) + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PDLACPY inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) AOCL_DTL_LOG_ENTRY_F END IF -* * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * diff --git a/SRC/pdlaed0.f b/SRC/pdlaed0.f index 72dd0b3f..bc3d0e9d 100644 --- a/SRC/pdlaed0.f +++ b/SRC/pdlaed0.f @@ -106,7 +106,6 @@ SUBROUTINE PDLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -119,6 +118,16 @@ SUBROUTINE PDLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, IQ, JQ, N, eos_str + 102 FORMAT('PDLAED0 inputs: ,INFO:',I5,', IQ:',I5, + $ ', JQ:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -132,18 +141,6 @@ SUBROUTINE PDLAED0( N, D, E, Q, IQ, JQ, DESCQ, WORK, IWORK, INFO ) * Test the input parameters. * CALL BLACS_GRIDINFO( DESCQ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) INFO, IQ, JQ, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAED0 inputs:,INFO:',I5,',IQ:',I5,',JQ:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF INFO = 0 IF( DESCQ( NB_ ).GT.N .OR. N.LT.2 ) $ INFO = -1 diff --git a/SRC/pdlaed1.f b/SRC/pdlaed1.f index 1a64b9b9..0bc572ee 100644 --- a/SRC/pdlaed1.f +++ b/SRC/pdlaed1.f @@ -143,7 +143,6 @@ SUBROUTINE PDLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -156,6 +155,18 @@ SUBROUTINE PDLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, N, N1, RHO, + $ eos_str + 102 FORMAT('PDLAED1 inputs: ,ID:',I5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', N:',I5,', N1:',I5, + $ ', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -170,19 +181,6 @@ SUBROUTINE PDLAED1( N, N1, D, ID, Q, IQ, JQ, DESCQ, RHO, WORK, * Test the input parameters. * CALL BLACS_GRIDINFO( DESCQ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, N, N1, RHO, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAED1 inputs:,ID:',I5,',INFO:',I5,',IQ:',I5, - $ ',JQ:',I5,',N:',I5,',N1:',I5, - $ ',RHO:',F9.4,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF INFO = 0 IF( NPROW.EQ.-1 ) THEN INFO = -( 600+CTXT_ ) diff --git a/SRC/pdlaed2.f b/SRC/pdlaed2.f index 6615994a..4e4f471c 100644 --- a/SRC/pdlaed2.f +++ b/SRC/pdlaed2.f @@ -184,7 +184,6 @@ SUBROUTINE PDLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * .. Local Arrays .. INTEGER PTT( 4 ) * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -197,6 +196,22 @@ SUBROUTINE PDLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DCOL, DROW, IB1, IB2, ICTXT, + $ K, LDQ, LDQ2, N, N1, + $ NB, NN, NN1, NN2, NPCOL, RHO, eos_str + 102 FORMAT('PDLAED2 inputs: ,DCOL:',I5,', DROW:',I5, + $ ', IB1:',I5,', IB2:',I5,', ICTXT:',I5, + $ ', K:',I5,', LDQ:',I5,', LDQ2:',I5, + $ ', N:',I5,', N1:',I5,', NB:',I5,', NN:',I5, + $ ', NN1:',I5,', NN2:',I5,', NPCOL:',I5, + $ ', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.EQ.0 ) THEN @@ -209,23 +224,6 @@ SUBROUTINE PDLAED2( ICTXT, K, N, N1, NB, D, DROW, DCOL, Q, LDQ, * CALL BLACS_PINFO( IAM, NPROCS ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DCOL, DROW, IB1, IB2, ICTXT, - $ K, LDQ, LDQ2, N, N1, - $ NB, NN, NN1, NN2, NPCOL, RHO, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAED2 inputs:,DCOL:',I5,',DROW:',I5, - $ ',IB1:',I5,',IB2:',I5,',ICTXT:',I5,',K:',I5, - $ ',LDQ:',I5,',LDQ2:',I5,',N:',I5, - $ ',N1:',I5,',NB:',I5,',NN:',I5,',NN1:',I5, - $ ',NN2:',I5,',NPCOL:',I5,',RHO:',F9.4, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NP = NUMROC( N, NB, MYROW, DROW, NPROW ) * N2 = N - N1 diff --git a/SRC/pdlaed3.f b/SRC/pdlaed3.f index de9191cd..42eab9b9 100644 --- a/SRC/pdlaed3.f +++ b/SRC/pdlaed3.f @@ -155,7 +155,6 @@ SUBROUTINE PDLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * .. Intrinsic Functions .. INTRINSIC MOD, SIGN, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -168,6 +167,19 @@ SUBROUTINE PDLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DCOL, DROW, ICTXT, INFO, K, + $ LDU, N, NB, NPCOL, RHO, eos_str + 102 FORMAT('PDLAED3 inputs: ,DCOL:',I5,', DROW:',I5, + $ ', ICTXT:',I5,', INFO:',I5,', K:',I5, + $ ', LDU:',I5,', N:',I5,', NB:',I5, + $ ', NPCOL:',I5,', RHO:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -183,21 +195,6 @@ SUBROUTINE PDLAED3( ICTXT, K, N, NB, D, DROW, DCOL, RHO, DLAMDA, END IF * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DCOL, DROW, ICTXT, INFO, K, - $ LDU, N, NB, NPCOL, RHO, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAED3 inputs:,DCOL:',I5,',DROW:',I5, - $ ',ICTXT:',I5,',INFO:',I5,',K:',I5,',LDU:',I5, - $ ',N:',I5,',NB:',I5,',NPCOL:',I5, - $ ',RHO:',F9.4,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * ROW = DROW COL = DCOL diff --git a/SRC/pdlaedz.f b/SRC/pdlaedz.f index 9977b5e7..4b796015 100644 --- a/SRC/pdlaedz.f +++ b/SRC/pdlaedz.f @@ -53,7 +53,6 @@ SUBROUTINE PDLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -66,6 +65,16 @@ SUBROUTINE PDLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, IQ, JQ, LDQ, N, N1, eos_str + 102 FORMAT('PDLAEDZ inputs: ,ID:',I5,', IQ:',I5,', JQ:',I5, + $ ', LDQ:',I5,', N:',I5,', N1:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -79,19 +88,6 @@ SUBROUTINE PDLAEDZ( N, N1, ID, Q, IQ, JQ, LDQ, DESCQ, Z, WORK ) ICTXT = DESCQ( CTXT_ ) NB = DESCQ( NB_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) ID, IQ, JQ, LDQ, N, N1, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAEDZ inputs:,ID:',I5,',IQ:',I5,',JQ:',I5, - $ ',LDQ:',I5,',N:',I5,',N1:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF CALL INFOG2L( ID, ID, DESCQ, NPROW, NPCOL, MYROW, MYCOL, IIQ, JJQ, $ IQROW, IQCOL ) N2 = N - N1 diff --git a/SRC/pdlaevswp.f b/SRC/pdlaevswp.f index a505e1eb..b5112bd8 100644 --- a/SRC/pdlaevswp.f +++ b/SRC/pdlaevswp.f @@ -159,7 +159,6 @@ SUBROUTINE PDLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -171,6 +170,16 @@ SUBROUTINE PDLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IZ, JZ, LDZI, LWORK, N, eos_str + 102 FORMAT('PDLAEVSWP inputs: ,IZ:',I5,', JZ:',I5, + $ ', LDZI:',I5,', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -181,18 +190,6 @@ SUBROUTINE PDLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, RETURN END IF CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IZ, JZ, LDZI, LWORK, N, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAEVSWP inputs:,IZ:',I5,',JZ:',I5,',LDZI:',I5, - $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF IAM = MYROW + MYCOL*NPROW IAM = MYROW*NPCOL + MYCOL * diff --git a/SRC/pdlahqr.f b/SRC/pdlahqr.f index e37939cf..28654279 100644 --- a/SRC/pdlahqr.f +++ b/SRC/pdlahqr.f @@ -286,7 +286,6 @@ SUBROUTINE PDLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, MOD, SIGN, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -298,6 +297,19 @@ SUBROUTINE PDLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, ILWORK, INFO, LWORK, N, eos_str + 102 FORMAT('PDLAHQR inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', ILWORK:',I5,', INFO:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * @@ -320,21 +332,6 @@ SUBROUTINE PDLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, JAFIRST = DESCA( CSRC_ ) LDZ = DESCZ( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, - $ ILOZ, ILWORK, INFO, LWORK, N, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAHQR inputs:,WANTT:',L2,',WANTZ:',L2, - $ ',IHI:',I5,',IHIZ:',I5,',ILO:',I5, - $ ',ILOZ:',I5,',ILWORK:',I5,',INFO:',I5, - $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NODE = MYROW*NPCOL + MYCOL NUM = NPROW*NPCOL LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) diff --git a/SRC/pdlahrd.f b/SRC/pdlahrd.f index 111969e5..8e9435b7 100644 --- a/SRC/pdlahrd.f +++ b/SRC/pdlahrd.f @@ -165,7 +165,6 @@ SUBROUTINE PDLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -178,6 +177,17 @@ SUBROUTINE PDLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IY, JA, JY, K, N, NB, eos_str + 102 FORMAT('PDLAHRD inputs: ,IA:',I5,', IY:',I5,', JA:',I5, + $ ', JY:',I5,', K:',I5,', N:',I5, + $ ', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.1 ) THEN @@ -190,19 +200,6 @@ SUBROUTINE PDLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, IY, JA, JY, K, N, NB, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAHRD inputs:,IA:',I5,',IY:',I5,',JA:',I5, - $ ',JY:',I5,',K:',I5,',N:',I5,',NB:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * IOFF = MOD( JA-1, DESCA( NB_ ) ) CALL INFOG2L( IA+K, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, diff --git a/SRC/pdlamch.f b/SRC/pdlamch.f index 260ea25c..d7868802 100644 --- a/SRC/pdlamch.f +++ b/SRC/pdlamch.f @@ -69,7 +69,6 @@ DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH ) DOUBLE PRECISION DLAMCH EXTERNAL DLAMCH, LSAME * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -83,10 +82,11 @@ DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH ) AOCL_DTL_TRACE_ENTRY_F * * Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN WRITE(LOG_BUF,102) CMACH, ICTXT, eos_str - 102 FORMAT('PDLAMCH inputs:,CMACH:',A5,',ICTXT:',I5,A1) + 102 FORMAT('PDLAMCH inputs: ,CMACH:',A5,', ICTXT:',I5, A1 ) AOCL_DTL_LOG_ENTRY_F END IF * diff --git a/SRC/pdlamr1d.f b/SRC/pdlamr1d.f index 7151ebbc..e2912a24 100644 --- a/SRC/pdlamr1d.f +++ b/SRC/pdlamr1d.f @@ -112,7 +112,6 @@ SUBROUTINE PDLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -124,6 +123,16 @@ SUBROUTINE PDLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, JA, JB, N, eos_str + 102 FORMAT('PDLAMR1D inputs: ,IA:',I5,', IB:',I5,', JA:',I5, + $ ', JB:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -158,18 +167,6 @@ SUBROUTINE PDLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) CALL PDGEMR2D( 1, N, A, IA, JA, DESCAA, B, IB, JB, DESCBB, ICTXT ) * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, IB, JA, JB, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAMR1D inputs:,IA:',I5,',IB:',I5,',JA:',I5, - $ ',JB:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NQ = NUMROC( N, DESCB( NB_ ), MYCOL, 0, NPCOL ) * IF( MYROW.EQ.0 ) THEN diff --git a/SRC/pdlapv2.f b/SRC/pdlapv2.f index ce18a5e6..8a506b81 100644 --- a/SRC/pdlapv2.f +++ b/SRC/pdlapv2.f @@ -174,7 +174,6 @@ SUBROUTINE PDLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -186,6 +185,18 @@ SUBROUTINE PDLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, IP, JA, + $ JP, M, N, eos_str + 102 FORMAT('PDLAPV2 inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I5,', IP:',I5,', JA:',I5, + $ ', JP:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * ROWPVT = LSAME( ROWCOL, 'R' ) IF( ROWPVT ) THEN @@ -216,20 +227,6 @@ SUBROUTINE PDLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, IP, JA, JP, - $ M, N, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDLAPV2 inputs:,DIREC:',A5,',ROWCOL:',A5, - $ ',IA:',I5,',IP:',I5,',JA:',I5,',JP:',I5, - $ ',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * If I'm applying pivots from beginning to end (e.g., repeating * pivoting done earlier). Thus this section computes P * sub( A ). * diff --git a/SRC/pdlaqge.f b/SRC/pdlaqge.f index 7546207d..2b7a1b41 100644 --- a/SRC/pdlaqge.f +++ b/SRC/pdlaqge.f @@ -184,7 +184,6 @@ SUBROUTINE PDLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -197,6 +196,18 @@ SUBROUTINE PDLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, IA, JA, M, N, AMAX, + $ COLCND, ROWCND, eos_str + 102 FORMAT('PDLAQGE inputs: ,EQUED:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', AMAX:',F9.4, + $ ', COLCND:',F9.4,', ROWCND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN @@ -212,21 +223,6 @@ SUBROUTINE PDLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) EQUED, IA, JA, M, N, AMAX, COLCND, - $ ROWCND, NPROW, NPCOL, MYROW, - $ MYCOL, eos_str - 102 FORMAT('PDLAQGE inputs:,EQUED:',A5,',IA:',I5,',JA:',I5, - $ ',M:',I5,',N:',I5,',AMAX:',F9.4, - $ ',COLCND:',F9.4,',ROWCND:',F9.4, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) IROFF = MOD( IA-1, DESCA( MB_ ) ) diff --git a/SRC/pdlaqr1.f b/SRC/pdlaqr1.f index f85ded27..97125e8a 100644 --- a/SRC/pdlaqr1.f +++ b/SRC/pdlaqr1.f @@ -308,7 +308,6 @@ RECURSIVE SUBROUTINE PDLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, MOD, SIGN, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -320,6 +319,19 @@ RECURSIVE SUBROUTINE PDLAQR1( WANTT, WANTZ, N, ILO, IHI, A, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, ILWORK, INFO, LWORK, N, eos_str + 102 FORMAT('PDLAQR1 inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', ILWORK:',I5,', INFO:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * @@ -341,21 +353,6 @@ RECURSIVE SUBROUTINE PDLAQR1( WANTT, WANTZ, N, ILO, IHI, A, JAFIRST = DESCA( CSRC_ ) LDZ = DESCZ( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, - $ ILOZ, ILWORK, INFO, LWORK, N, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAQR1 inputs:,WANTT:',L2,',WANTZ:',L2, - $ ',IHI:',I5,',IHIZ:',I5,',ILO:',I5, - $ ',ILOZ:',I5,',ILWORK:',I5,',INFO:',I5, - $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NODE = MYROW*NPCOL + MYCOL NUM = NPROW*NPCOL LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) diff --git a/SRC/pdlaqr2.f b/SRC/pdlaqr2.f index 12f74d2a..d6da165d 100644 --- a/SRC/pdlaqr2.f +++ b/SRC/pdlaqr2.f @@ -248,7 +248,6 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -260,6 +259,21 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LDT, + $ LDV, LWORK, N, ND, NS, + $ NW, WANTT, WANTZ, eos_str + 102 FORMAT('PDLAQR2 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KBOT:',I5,', KTOP:',I5,', LDT:',I5, + $ ', LDV:',I5,', LWORK:',I5,', N:',I5, + $ ', ND:',I5,', NS:',I5,', NW:',I5, + $ ', WANTT:',L1,', WANTZ:',L1, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * @@ -280,23 +294,6 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, JAFIRST = DESCA( CSRC_ ) LDZ = DESCZ( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IHIZ, ILOZ, KBOT, KTOP, LDT, - $ LDV, LWORK, N, ND, NS, - $ NW, WANTT, WANTZ, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAQR2 inputs:,IHIZ:',I5,',ILOZ:',I5, - $ ',KBOT:',I5,',KTOP:',I5,',LDT:',I5,',LDV:',I5, - $ ',LWORK:',I5,',N:',I5,',ND:',I5, - $ ',NS:',I5,',NW:',I5,',WANTT:',L2, - $ ',WANTZ:',L2,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NODE = MYROW*NPCOL + MYCOL LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) @@ -706,6 +703,10 @@ SUBROUTINE PDLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, A, DESCA, IF( II .LT. ND ) GOTO 160 END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * END OF PDLAQR2 * END diff --git a/SRC/pdlaqr3.f b/SRC/pdlaqr3.f index e1c63842..046bdf04 100644 --- a/SRC/pdlaqr3.f +++ b/SRC/pdlaqr3.f @@ -289,7 +289,6 @@ RECURSIVE SUBROUTINE PDLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -312,12 +311,14 @@ RECURSIVE SUBROUTINE PDLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, $ N, ND, NH, NS, NV, $ NW, LIWORK, RECLEVEL, WANTT, WANTZ, $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAQR3 inputs:,IHIZ:',I5,',ILOZ:',I5, - $ ',KBOT:',I5,',KTOP:',I5,',LWORK:',I5, - $ ',N:',I5,',ND:',I5,',NH:',I5,',NS:',I5, - $ ',NV:',I5,',NW:',I5,',LIWORK:',I5, - $ ',RECLEVEL:',I5,',WANTT:',L2,',WANTZ:',L2, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) + 102 FORMAT('PDLAQR3 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KBOT:',I5,', KTOP:',I5,', LWORK:',I5, + $ ', N:',I5,', ND:',I5,', NH:',I5, + $ ', NS:',I5,', NV:',I5,', NW:',I5,', LIWORK:',I5, + $ ', RECLEVEL:',I5,', WANTT:',L1, + $ ', WANTZ:',L1,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) AOCL_DTL_LOG_ENTRY_F END IF NPROCS = NPROW*NPCOL @@ -1207,6 +1208,10 @@ RECURSIVE SUBROUTINE PDLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, WORK( 1 ) = DBLE( LWKOPT ) IWORK( 1 ) = ILWKOPT + NSEL * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDLAQR3 * END diff --git a/SRC/pdlaqr4.f b/SRC/pdlaqr4.f index 2b2eb2e3..b37cc363 100644 --- a/SRC/pdlaqr4.f +++ b/SRC/pdlaqr4.f @@ -233,7 +233,6 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -245,6 +244,19 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, INFO, LDT, LDV, LWORK, N, eos_str + 102 FORMAT('PDLAQR4 inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I5,', IHIZ:',I5,', ILO:',I5, + $ ', ILOZ:',I5,', INFO:',I5,', LDT:',I5, + $ ', LDV:',I5,', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * @@ -267,21 +279,6 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, JAFIRST = DESCA( CSRC_ ) LDZ = DESCZ( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, - $ ILOZ, INFO, LDT, LDV, LWORK, N, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLAQR4 inputs:,WANTT:',L2,',WANTZ:',L2, - $ ',IHI:',I5,',IHIZ:',I5,',ILO:',I5, - $ ',ILOZ:',I5,',INFO:',I5,',LDT:',I5,',LDV:',I5, - $ ',LWORK:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NODE = MYROW*NPCOL + MYCOL LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) @@ -666,6 +663,10 @@ SUBROUTINE PDLAQR4( WANTT, WANTZ, N, ILO, IHI, A, DESCA, WR, WI, END IF END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * END OF PDLAQR4 * END diff --git a/SRC/pdlaqr5.f b/SRC/pdlaqr5.f index 85043f53..5831951d 100644 --- a/SRC/pdlaqr5.f +++ b/SRC/pdlaqr5.f @@ -186,7 +186,6 @@ SUBROUTINE PDLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, EXTERNAL DGEMM, DLABAD, DLAMOV, DLAQR1, DLARFG, DLASET, $ DTRMM, DLAQR6 * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -211,12 +210,12 @@ SUBROUTINE PDLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, $ N, NSHFTS, LWORK, $ LIWORK, WANTT, WANTZ, NPROW, NPCOL, $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAQR5 inputs:,IHIZ:',I5,',ILOZ:',I5, - $ ',KACC22:',I5,',KBOT:',I5,',KTOP:',I5, - $ ',N:',I5,',NSHFTS:',I5,',LWORK:',I5, - $ ',LIWORK:',I5,',WANTT:',L2,',WANTZ:',L2, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) + 102 FORMAT('PDLAQR5 inputs: ,IHIZ:',I5,', ILOZ:',I5, + $ ', KACC22:',I5,', KBOT:',I5,', KTOP:',I5, + $ ', N:',I5,', NSHFTS:',I5,', LWORK:',I5, + $ ', LIWORK:',I5,', WANTT:',L1, + $ ', WANTZ:',L1,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) AOCL_DTL_LOG_ENTRY_F END IF NPROCS = NPROW*NPCOL @@ -2331,6 +2330,10 @@ SUBROUTINE PDLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * GO TO 20 * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDLAQR5 * END diff --git a/SRC/pdlaqsy.f b/SRC/pdlaqsy.f index e07d0a34..c28332bc 100644 --- a/SRC/pdlaqsy.f +++ b/SRC/pdlaqsy.f @@ -186,7 +186,6 @@ SUBROUTINE PDLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -199,6 +198,18 @@ SUBROUTINE PDLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, UPLO, IA, JA, N, AMAX, + $ SCOND, eos_str + 102 FORMAT('PDLAQSY inputs: ,EQUED:',A5,', UPLO:',A5, + $ ', IA:',I5,', JA:',I5,', N:',I5,', AMAX:',F9.4, + $ ', SCOND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.0 ) THEN @@ -214,20 +225,6 @@ SUBROUTINE PDLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) EQUED, UPLO, IA, JA, N, AMAX, - $ SCOND, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDLAQSY inputs:,EQUED:',A5,',UPLO:',A5, - $ ',IA:',I5,',JA:',I5,',N:',I5,',AMAX:',F9.4, - $ ',SCOND:',F9.4,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) LDA = DESCA( LLD_ ) diff --git a/SRC/pdlared1d.f b/SRC/pdlared1d.f index b931d7e8..a8e74e2d 100644 --- a/SRC/pdlared1d.f +++ b/SRC/pdlared1d.f @@ -145,7 +145,6 @@ SUBROUTINE PDLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -157,6 +156,16 @@ SUBROUTINE PDLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, LWORK, N, eos_str + 102 FORMAT('PDLARED1D inputs: ,IA:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -168,18 +177,6 @@ SUBROUTINE PDLARED1D( N, IA, JA, DESC, BYCOL, BYALL, WORK, LWORK ) END IF * CALL BLACS_GRIDINFO( DESC( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, JA, LWORK, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLARED1D inputs:,IA:',I5,',JA:',I5,',LWORK:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NB = DESC( MB_ ) * * diff --git a/SRC/pdlared2d.f b/SRC/pdlared2d.f index cf1bf375..533b8681 100644 --- a/SRC/pdlared2d.f +++ b/SRC/pdlared2d.f @@ -142,7 +142,6 @@ SUBROUTINE PDLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -154,6 +153,16 @@ SUBROUTINE PDLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, LWORK, N, eos_str + 102 FORMAT('PDLARED2D inputs: ,IA:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -165,18 +174,6 @@ SUBROUTINE PDLARED2D( N, IA, JA, DESC, BYROW, BYALL, WORK, LWORK ) END IF * CALL BLACS_GRIDINFO( DESC( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, JA, LWORK, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLARED2D inputs:,IA:',I5,',JA:',I5,',LWORK:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF MB = DESC( MB_ ) * DO 30 PROW = 0, NPROW - 1 diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f index ed58e428..c9c911d2 100644 --- a/SRC/pdlarf.f +++ b/SRC/pdlarf.f @@ -264,7 +264,6 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -277,6 +276,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ M, N, eos_str + 102 FORMAT('PDLARF inputs: ,SIDE:',A5,', IC:',I5,', INCV:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN @@ -292,19 +303,6 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, ICTXT = DESCC( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, - $ M, N, NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLARF inputs:,SIDE:',A5,',IC:',I5,',INCV:',I5, - $ ',IV:',I5,',JC:',I5,',JV:',I5, - $ ',M:',I5,',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Figure local indexes * CALL INFOG2L( IC, JC, DESCC, NPROW, NPCOL, MYROW, MYCOL, IIC, JJC, diff --git a/SRC/pdlarfb.f b/SRC/pdlarfb.f index 9b65e623..99ce0bef 100644 --- a/SRC/pdlarfb.f +++ b/SRC/pdlarfb.f @@ -254,7 +254,6 @@ SUBROUTINE PDLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, INTEGER ICEIL, NUMROC EXTERNAL ICEIL, LSAME, NUMROC * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -267,6 +266,19 @@ SUBROUTINE PDLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, DIRECT, STOREV, + $ IC, IV, JC, JV, K, M, N, eos_str + 102 FORMAT('PDLARFB inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', DIRECT:',A5,', STOREV:',A5,', IC:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', K:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN @@ -281,21 +293,6 @@ SUBROUTINE PDLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * ICTXT = DESCC( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) SIDE, TRANS, DIRECT, STOREV, - $ IC, IV, JC, JV, K, M, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLARFB inputs:,SIDE:',A5,',TRANS:',A5, - $ ',DIRECT:',A5,',STOREV:',A5,',IC:',I5, - $ ',IV:',I5,',JC:',I5,',JV:',I5,',K:',I5, - $ ',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * IF( LSAME( TRANS, 'N' ) ) THEN TRANST = 'T' diff --git a/SRC/pdlarft.f b/SRC/pdlarft.f index 5ec4747a..e9f07ca3 100644 --- a/SRC/pdlarft.f +++ b/SRC/pdlarft.f @@ -204,7 +204,6 @@ SUBROUTINE PDLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. Intrinsic Functions .. INTRINSIC MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -217,6 +216,18 @@ SUBROUTINE PDLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, + $ N, eos_str + 102 FORMAT('PDLARFT inputs: ,DIRECT:',A5,', STOREV:',A5, + $ ', IV:',I5,', JV:',I5,', K:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.0 .OR. K.LE.0 ) THEN @@ -229,19 +240,6 @@ SUBROUTINE PDLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * ICTXT = DESCV( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, N, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLARFT inputs:,DIRECT:',A5,',STOREV:',A5, - $ ',IV:',I5,',JV:',I5,',K:',I5,',N:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * FORWARD = LSAME( DIRECT, 'F' ) CALL INFOG2L( IV, JV, DESCV, NPROW, NPCOL, MYROW, MYCOL, diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f index 4e81d7b5..cfc4155d 100644 --- a/SRC/pdlarz.f +++ b/SRC/pdlarz.f @@ -273,7 +273,6 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -286,6 +285,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ L, M, N, eos_str + 102 FORMAT('PDLARZ inputs: ,SIDE:',A5,', IC:',I5,', INCV:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', L:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN @@ -301,20 +312,6 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, ICTXT = DESCC( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, - $ L, M, N, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDLARZ inputs:,SIDE:',A5,',IC:',I5,',INCV:',I5, - $ ',IV:',I5,',JC:',I5,',JV:',I5, - $ ',L:',I5,',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Figure local indexes * LEFT = LSAME( SIDE, 'L' ) diff --git a/SRC/pdlarzb.f b/SRC/pdlarzb.f index fb24913d..a6a7a8a5 100644 --- a/SRC/pdlarzb.f +++ b/SRC/pdlarzb.f @@ -259,7 +259,6 @@ SUBROUTINE PDLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, INTEGER ICEIL, NUMROC EXTERNAL ICEIL, LSAME, NUMROC * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -272,6 +271,19 @@ SUBROUTINE PDLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, SIDE, STOREV, TRANS, + $ IC, IV, JC, JV, K, L, M, N, eos_str + 102 FORMAT('PDLARZB inputs: ,DIRECT:',A5,', SIDE:',A5, + $ ', STOREV:',A5,', TRANS:',A5,', IC:',I5, + $ ', IV:',I5,', JC:',I5,', JV:',I5, + $ ', K:',I5,', L:',I5,', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN @@ -287,21 +299,6 @@ SUBROUTINE PDLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, ICTXT = DESCC( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DIRECT, SIDE, STOREV, TRANS, - $ IC, IV, JC, JV, K, L, M, N, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLARZB inputs:,DIRECT:',A5,',SIDE:',A5, - $ ',STOREV:',A5,',TRANS:',A5,',IC:',I5, - $ ',IV:',I5,',JC:',I5,',JV:',I5,',K:',I5, - $ ',L:',I5,',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Check for currently supported options * INFO = 0 diff --git a/SRC/pdlase2.f b/SRC/pdlase2.f index 309e5896..fc017c46 100644 --- a/SRC/pdlase2.f +++ b/SRC/pdlase2.f @@ -161,7 +161,6 @@ SUBROUTINE PDLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -173,6 +172,18 @@ SUBROUTINE PDLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PDLASE2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', ALPHA:',F9.4, + $ ', BETA:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * @@ -185,19 +196,6 @@ SUBROUTINE PDLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * Get grid parameters * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, BETA, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLASE2 inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, - $ ',M:',I5,',N:',I5,',ALPHA:',F9.4, - $ ',BETA:',F9.4,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) diff --git a/SRC/pdlaset.f b/SRC/pdlaset.f index bea25545..3d082d25 100644 --- a/SRC/pdlaset.f +++ b/SRC/pdlaset.f @@ -156,7 +156,6 @@ SUBROUTINE PDLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -170,14 +169,16 @@ SUBROUTINE PDLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) AOCL_DTL_TRACE_ENTRY_F * * Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, BETA eos_str - 102 FORMAT('PDLASET inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, - $ ',M:',I5,',N:',I5,',ALPHA:',F9.4,',BETA:',F9.4,A1) + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PDLASET inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', ALPHA:',F9.4, + $ ', BETA:',F9.4, A1 ) AOCL_DTL_LOG_ENTRY_F END IF -* * IF( M.EQ.0 .OR. N.EQ.0 ) THEN * diff --git a/SRC/pdlasrt.f b/SRC/pdlasrt.f index c8df9ffb..9ea060f0 100644 --- a/SRC/pdlasrt.f +++ b/SRC/pdlasrt.f @@ -108,7 +108,6 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -121,6 +120,18 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, LIWORK, LWORK, + $ N, eos_str + 102 FORMAT('PDLASRT inputs: ,ID:',A5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -142,20 +153,6 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, ICTXT = DESCQ( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) ID, INFO, IQ, JQ, LIWORK, LWORK, - $ N, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDLASRT inputs:,ID:',A5,',INFO:',I5,',IQ:',I5, - $ ',JQ:',I5,',LIWORK:',I5,',LWORK:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Test the input parameters * INFO = 0 @@ -296,6 +293,10 @@ SUBROUTINE PDLASRT( ID, N, D, Q, IQ, JQ, DESCQ, WORK, LWORK, END IF CALL DLAMOV( 'Full', NP, NQ, WORK, NP, Q( IIQ ), LDQ ) * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDLASRT * END diff --git a/SRC/pdlaswp.f b/SRC/pdlaswp.f index ffb8e894..7ee85a32 100644 --- a/SRC/pdlaswp.f +++ b/SRC/pdlaswp.f @@ -159,7 +159,6 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, LOGICAL LSAME EXTERNAL LSAME * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -172,9 +171,27 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, JA, K1, + $ K2, N, eos_str + 102 FORMAT('PDLASWP inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I5,', JA:',I5,', K1:',I5, + $ ', K2:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* +#ifdef AOCL_DTL + CALL AOCL_SL_DTL_TRACE_ENTRY(__FILE__, __LINE__, ' ') +#endif * Quick return if possible * IF( N.EQ.0 ) THEN +#ifdef AOCL_DTL + CALL AOCL_SL_DTL_TRACE_EXIT(__FILE__, __LINE__, ' ') +#endif * * Capture the subroutine exit in the trace file * @@ -183,19 +200,6 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, END IF * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, JA, K1, K2, - $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLASWP inputs:,DIREC:',A5,',ROWCOL:',A5, - $ ',IA:',I5,',JA:',I5,',K1:',I5,',K2:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5 , - $ ',MYROW:',I5,',MYCOL:',I5,A5) - AOCL_DTL_LOG_ENTRY_F - END IF * IF( LSAME( ROWCOL, 'R' ) ) THEN IF( LSAME( DIREC, 'F' ) ) THEN @@ -239,6 +243,9 @@ SUBROUTINE PDLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, END IF END IF * +#ifdef AOCL_DTL + CALL AOCL_SL_DTL_TRACE_EXIT(__FILE__, __LINE__, ' ') +#endif * * Capture the subroutine exit in the trace file * diff --git a/SRC/pdlatrd.f b/SRC/pdlatrd.f index 0ec029c4..ece18647 100644 --- a/SRC/pdlatrd.f +++ b/SRC/pdlatrd.f @@ -256,7 +256,6 @@ SUBROUTINE PDLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -269,6 +268,18 @@ SUBROUTINE PDLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IW, JA, JW, N, NB, + $ eos_str + 102 FORMAT('PDLATRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', IW:',I5,', JA:',I5,', JW:',I5,', N:',I5, + $ ', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.0 ) THEN @@ -281,19 +292,6 @@ SUBROUTINE PDLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, IW, JA, JW, N, NB, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDLATRD inputs:,UPLO:',A5,',IA:',I5,',IW:',I5, - $ ',JA:',I5,',JW:',I5,',N:',I5, - $ ',NB:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF NQ = MAX( 1, NUMROC( JA+N-1, DESCA( NB_ ), MYCOL, DESCA( CSRC_ ), $ NPCOL ) ) CALL DESCSET( DESCD, 1, JA+N-1, 1, DESCA( NB_ ), MYROW, diff --git a/SRC/pdlatrz.f b/SRC/pdlatrz.f index fe2ecd70..733f42d7 100644 --- a/SRC/pdlatrz.f +++ b/SRC/pdlatrz.f @@ -192,7 +192,6 @@ SUBROUTINE PDLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) INTEGER NUMROC EXTERNAL NUMROC * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -205,6 +204,16 @@ SUBROUTINE PDLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, L, M, N, eos_str + 102 FORMAT('PDLATRZ inputs: ,IA:',I5,', JA:',I5,', L:',I5, + $ ', M:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.EQ.0 .OR. N.EQ.0 ) THEN @@ -219,18 +228,6 @@ SUBROUTINE PDLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IA, JA, L, M, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLATRZ inputs:,IA:',I5,',JA:',I5,',L:',I5, - $ ',M:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * MP = NUMROC( IA+M-1, DESCA( MB_ ), MYROW, DESCA( RSRC_ ), $ NPROW ) diff --git a/SRC/pdlauu2.f b/SRC/pdlauu2.f index 3d9306f5..68f829be 100644 --- a/SRC/pdlauu2.f +++ b/SRC/pdlauu2.f @@ -147,7 +147,6 @@ SUBROUTINE PDLAUU2( UPLO, N, A, IA, JA, DESCA ) DOUBLE PRECISION DDOT EXTERNAL DDOT, LSAME * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -160,6 +159,16 @@ SUBROUTINE PDLAUU2( UPLO, N, A, IA, JA, DESCA ) * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PDLAUU2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.EQ.0 ) THEN @@ -173,18 +182,6 @@ SUBROUTINE PDLAUU2( UPLO, N, A, IA, JA, DESCA ) * Get grid parameters and compute local indexes * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, JA, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDLAUU2 inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) * diff --git a/SRC/pdlauum.f b/SRC/pdlauum.f index caf7b5a5..cae8ed4d 100644 --- a/SRC/pdlauum.f +++ b/SRC/pdlauum.f @@ -146,7 +146,6 @@ SUBROUTINE PDLAUUM( UPLO, N, A, IA, JA, DESCA ) * .. Intrinsic Functions .. INTRINSIC MIN * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -163,12 +162,11 @@ SUBROUTINE PDLAUUM( UPLO, N, A, IA, JA, DESCA ) * IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str - 102 FORMAT('PDLACPY inputs:,UPLO:',A5,',IA:',I5,',JA:',I5, - $ ',N:',I5,A1) + 102 FORMAT('PDLAUUM inputs: ,UPLO:',A5,', IA:',I5, + $ ', JA:',I5,', N:',I5, A1 ) AOCL_DTL_LOG_ENTRY_F END IF * -* * Quick return if possible * IF( N.EQ.0 ) THEN diff --git a/SRC/pdpbsv.f b/SRC/pdpbsv.f index c2b7a6be..4808bbe5 100644 --- a/SRC/pdpbsv.f +++ b/SRC/pdpbsv.f @@ -389,7 +389,6 @@ SUBROUTINE PDPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. External Subroutines .. EXTERNAL PDPBTRF, PDPBTRS, PXERBLA * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -402,6 +401,18 @@ SUBROUTINE PDPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PDPBSV inputs: ,UPLO:',A5,', BW:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PDPBTRF and PDPBTRS. @@ -432,20 +443,6 @@ SUBROUTINE PDPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LWORK, - $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDPBSV inputs:,UPLO:',A5,',BW:',I5,',IB:',I5, - $ ',INFO:',I5,',JA:',I5,',LWORK:',I5, - $ ',N:',I5,',NRHS:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * * Size needed for AF in factorization * diff --git a/SRC/pdptsv.f b/SRC/pdptsv.f index ea0d4810..7fbbe7ea 100644 --- a/SRC/pdptsv.f +++ b/SRC/pdptsv.f @@ -390,7 +390,6 @@ SUBROUTINE PDPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * .. External Subroutines .. EXTERNAL PDPTTRF, PDPTTRS, PXERBLA * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -403,6 +402,17 @@ SUBROUTINE PDPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ eos_str + 102 FORMAT('PDPTSV inputs: ,IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PDPTTRF and PDPTTRS. @@ -436,19 +446,6 @@ SUBROUTINE PDPTSV( N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK, * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDPTSV inputs:,IB:',I5,',INFO:',I5,',JA:',I5, - $ ',LWORK:',I5,',N:',I5,',NRHS:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * * Size needed for AF in factorization * diff --git a/SRC/pdstebz.f b/SRC/pdstebz.f index bf4dacc5..177de989 100644 --- a/SRC/pdstebz.f +++ b/SRC/pdstebz.f @@ -1,3 +1,9 @@ +* +* Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, $ ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, $ WORK, LWORK, IWORK, LIWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER ORDER, RANGE INTEGER ICTXT, IL, INFO, IU, LIWORK, LWORK, M, N, @@ -256,9 +263,42 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, INTEGER TORECV( 1, 1 ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) ORDER, RANGE, ICTXT, IL, INFO, + $ IU, LIWORK, LWORK, M, N, NSPLIT, + $ ABSTOL, VL, VU, eos_str + 102 FORMAT('PDSTEBZ inputs: ,ORDER:',A5,', RANGE:',A5, + $ ', ICTXT:',I5,', IL:',I5,', INFO:',I5, + $ ', IU:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NSPLIT:',I5, + $ ', ABSTOL:',F9.4,', VL:',F9.4, + $ ', VU:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Set up process grid * @@ -377,16 +417,29 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PDSTEBZ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK.EQ.-1 .AND. LIWORK.EQ.-1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = 1 DO 20 I = 0, NPROW - 1 @@ -874,6 +927,10 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, 230 CONTINUE CALL BLACS_FREEBUFF( ONEDCONTEXT, 1 ) CALL BLACS_GRIDEXIT( ONEDCONTEXT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PDSTEBZ @@ -890,6 +947,7 @@ SUBROUTINE PDLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IEFLAG, IJOB, INFO, MINP, MMAX, MOUT, N DOUBLE PRECISION ABSTOL, LSAVE, PIVMIN, RELTOL @@ -1030,6 +1088,30 @@ SUBROUTINE PDLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, DOUBLE PRECISION ALPHA, BETA, MID * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IEFLAG, IJOB, INFO, MINP, MMAX, + $ MOUT, N, ABSTOL, LSAVE, PIVMIN, + $ RELTOL, eos_str + 102 FORMAT('PDLAEBZ inputs: ,IEFLAG:',I5,', IJOB:',I5, + $ ', INFO:',I5,', MINP:',I5,', MMAX:',I5, + $ ', MOUT:',I5,', N:',I5,', ABSTOL:',F9.4, + $ ', LSAVE:',F9.4,', PIVMIN:',F9.4, + $ ', RELTOL:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * KF = 1 KL = MINP + 1 @@ -1037,6 +1119,10 @@ SUBROUTINE PDLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, IF( INTVL( 2 )-INTVL( 1 ).LE.ZERO ) THEN INFO = MINP MOUT = KF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF IF( IJOB.EQ.0 ) THEN @@ -1192,6 +1278,10 @@ SUBROUTINE PDLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, KLNEW = KLNEW + 1 ELSE INFO = MMAX + 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF 40 CONTINUE @@ -1205,6 +1295,10 @@ SUBROUTINE PDLAEBZ( IJOB, N, MMAX, MINP, ABSTOL, RELTOL, PIVMIN, 60 CONTINUE INFO = MAX( KL-KF, 0 ) MOUT = KL - 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PDLAEBZ @@ -1221,6 +1315,7 @@ SUBROUTINE PDLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IJOB, KF, KL DOUBLE PRECISION ABSTOL, RELTOL @@ -1312,6 +1407,27 @@ SUBROUTINE PDLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, DOUBLE PRECISION TMP1, TMP2, TMP3, TMP4 * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IJOB, KF, KL, ABSTOL, RELTOL, + $ eos_str + 102 FORMAT('PDLAECV inputs: ,IJOB:',I5,', KF:',I5, + $ ', KL:',I5,', ABSTOL:',F9.4,', RELTOL:',F9.4, + $ A1) + AOCL_DTL_LOG_ENTRY_F + END IF * KFNEW = KF DO 10 I = KF, KL - 1 @@ -1355,6 +1471,10 @@ SUBROUTINE PDLAECV( IJOB, KF, KL, INTVL, INTVLCT, NVAL, ABSTOL, END IF 10 CONTINUE KF = KFNEW +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PDLAECV @@ -1369,6 +1489,7 @@ SUBROUTINE PDLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) * November 15, 1997 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER COUNT, N DOUBLE PRECISION PIVMIN, SIGMA @@ -1436,6 +1557,26 @@ SUBROUTINE PDLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) DOUBLE PRECISION TMP * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COUNT, N, PIVMIN, SIGMA, + $ eos_str + 102 FORMAT('PDLAPDCT inputs: ,COUNT:',I5,', N:',I5, + $ ', PIVMIN:',F9.4,', SIGMA:',F9.4, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * TMP = D( 1 ) - SIGMA IF( ABS( TMP ).LE.PIVMIN ) @@ -1451,6 +1592,10 @@ SUBROUTINE PDLAPDCT( SIGMA, N, D, PIVMIN, COUNT ) $ COUNT = COUNT + 1 10 CONTINUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PDLAPDCT diff --git a/SRC/pdstedc.f b/SRC/pdstedc.f index 47067e20..d3c1d862 100644 --- a/SRC/pdstedc.f +++ b/SRC/pdstedc.f @@ -152,7 +152,6 @@ SUBROUTINE PDSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * .. Intrinsic Functions .. INTRINSIC DBLE, MOD * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -165,6 +164,18 @@ SUBROUTINE PDSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) COMPZ, INFO, IQ, JQ, LIWORK, + $ LWORK, N, eos_str + 102 FORMAT('PDSTEDC inputs: ,COMPZ:',A5,', INFO:',I5, + $ ', IQ:',I5,', JQ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -178,20 +189,6 @@ SUBROUTINE PDSTEDC( COMPZ, N, D, E, Q, IQ, JQ, DESCQ, WORK, LWORK, * Test the input parameters. * CALL BLACS_GRIDINFO( DESCQ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) COMPZ, INFO, IQ, JQ, LIWORK, - $ LWORK, N, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDSTEDC inputs:,COMPZ:',A5,',INFO:',I5, - $ ',IQ:',I5,',JQ:',I5,',LIWORK:',I5,',LWORK:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF LDQ = DESCQ( LLD_ ) NB = DESCQ( NB_ ) NP = NUMROC( N, NB, MYROW, DESCQ( RSRC_ ), NPROW ) diff --git a/SRC/pdstein.f b/SRC/pdstein.f index e28146cd..af8c1a53 100644 --- a/SRC/pdstein.f +++ b/SRC/pdstein.f @@ -302,7 +302,6 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * .. Local Arrays .. INTEGER IDUM1( 1 ), IDUM2( 1 ) * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -314,6 +313,18 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, IZ, JZ, LIWORK, LWORK, + $ M, N, ORFAC, eos_str + 102 FORMAT('PDSTEIN inputs: ,INFO:',I5,', IZ:',I5, + $ ', JZ:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', ORFAC:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -325,20 +336,6 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, END IF * CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) INFO, IZ, JZ, LIWORK, LWORK, - $ M, N, ORFAC, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDSTEIN inputs:,INFO:',I5,',IZ:',I5,',JZ:',I5, - $ ',LIWORK:',I5,',LWORK:',I5,',M:',I5, - $ ',N:',I5,',ORFAC:',F9.4,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF SELF = MYROW*NPCOL + MYCOL * * Make sure that we belong to this context (before calling PCHK1MAT) @@ -689,6 +686,10 @@ SUBROUTINE PDSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, WORK( 1 ) = ( LGCLSIZ+LOAD-1 )*N + INDRW IWORK( 1 ) = 3*N + P + 1 * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDSTEIN * END diff --git a/SRC/pdsyev.f b/SRC/pdsyev.f index ad375068..41fdde13 100644 --- a/SRC/pdsyev.f +++ b/SRC/pdsyev.f @@ -285,7 +285,6 @@ SUBROUTINE PDSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, MAX, MIN, MOD, SQRT, INT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -297,6 +296,19 @@ SUBROUTINE PDSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LWORK, N, eos_str + 102 FORMAT('PDSYEV inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -319,21 +331,6 @@ SUBROUTINE PDSYEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) INFO = 0 -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, - $ JZ, LWORK, N, NPROW, NPCOL, MYROW, - $ MYCOL, eos_str - 102 FORMAT('PDSYEV inputs:,JOBZ:',A5,',UPLO:',A5,',IA:',I5, - $ ',INFO:',I5,',IZ:',I5,',JA:',I5, - $ ',JZ:',I5,',LWORK:',I5,',N:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * WANTZ = LSAME( JOBZ, 'V' ) IF( NPROW.EQ.-1 ) THEN diff --git a/SRC/pdsyevd.f b/SRC/pdsyevd.f index 1a8a0155..5a4c1709 100644 --- a/SRC/pdsyevd.f +++ b/SRC/pdsyevd.f @@ -195,7 +195,6 @@ SUBROUTINE PDSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, MAX, MIN, MOD, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -207,6 +206,19 @@ SUBROUTINE PDSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LIWORK, LWORK, N, eos_str + 102 FORMAT('PDSYEVD inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -231,21 +243,6 @@ SUBROUTINE PDSYEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * ICTXT = DESCZ( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, - $ JZ, LIWORK, LWORK, N, NPROW, NPCOL, - $ MYROW, MYCOL, eos_str - 102 FORMAT('PDSYEVD inputs:,JOBZ:',A5,',UPLO:',A5, - $ ',IA:',I5,',INFO:',I5,',IZ:',I5,',JA:',I5, - $ ',JZ:',I5,',LIWORK:',I5,',LWORK:',I5, - $ ',N:',I5,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * INFO = 0 IF( NPROW.EQ.-1 ) THEN diff --git a/SRC/pdsyevx.f b/SRC/pdsyevx.f index 5a288891..e6d3e8c9 100644 --- a/SRC/pdsyevx.f +++ b/SRC/pdsyevx.f @@ -515,7 +515,6 @@ SUBROUTINE PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -527,6 +526,24 @@ SUBROUTINE PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, + $ INFO, IU, IZ, JA, JZ, LIWORK, LWORK, + $ M, N, NZ, ABSTOL, + $ ORFAC, VL, VU, eos_str + 102 FORMAT('PDSYEVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I5,', IL:',I5, + $ ', INFO:',I5,', IU:',I5,', IZ:',I5, + $ ', JA:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NZ:',I5,', ABSTOL:',F9.4,', ORFAC:',F9.4, + $ ', VL:',F9.4,', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -547,26 +564,6 @@ SUBROUTINE PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, INFO, - $ IU, IZ, JA, JZ, LIWORK, LWORK, - $ M, N, NZ, ABSTOL, - $ ORFAC, VL, VU, NPROW, NPCOL, MYROW, - $ MYCOL, eos_str - 102 FORMAT('PDSYEVX inputs:,JOBZ:',A5,',RANGE:',A5, - $ ',UPLO:',A5,',IA:',I5,',IL:',I5,',INFO:',I5, - $ ',IU:',I5,',IZ:',I5,',JA:',I5, - $ ',JZ:',I5,',LIWORK:',I5,',LWORK:',I5, - $ ',M:',I5,',N:',I5,',NZ:',I5,',ABSTOL:',F9.4, - $ ',ORFAC:',F9.4,',VL:',F9.4, - $ ',VU:',F9.4,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF INFO = 0 * WANTZ = LSAME( JOBZ, 'V' ) diff --git a/SRC/pdsygs2.f b/SRC/pdsygs2.f index 23c445ba..321b04c0 100644 --- a/SRC/pdsygs2.f +++ b/SRC/pdsygs2.f @@ -195,7 +195,6 @@ SUBROUTINE PDSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTEGER INDXG2P EXTERNAL LSAME, INDXG2P * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -207,6 +206,18 @@ SUBROUTINE PDSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, eos_str + 102 FORMAT('PDSYGS2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', IBTYPE:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -222,20 +233,6 @@ SUBROUTINE PDSYGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, - $ JA, JB, N, NPROW, NPCOL, MYROW, MYCOL, - $ eos_str - 102 FORMAT('PDSYGS2 inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, - $ ',IBTYPE:',I5,',INFO:',I5,',JA:',I5, - $ ',JB:',I5,',N:',I5,',NPROW:',I5, - $ ',NPCOL:',I5,',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Test the input parameters. * INFO = 0 diff --git a/SRC/pdsygst.f b/SRC/pdsygst.f index dbe98b62..9cf35fe3 100644 --- a/SRC/pdsygst.f +++ b/SRC/pdsygst.f @@ -203,7 +203,6 @@ SUBROUTINE PDSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTEGER ICEIL, INDXG2P EXTERNAL LSAME, ICEIL, INDXG2P * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -215,6 +214,18 @@ SUBROUTINE PDSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, SCALE, eos_str + 102 FORMAT('PDSYGST inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', IBTYPE:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5,', SCALE:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -232,21 +243,6 @@ SUBROUTINE PDSYGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, - $ JA, JB, N, SCALE, NPROW, NPCOL, MYROW, - $ MYCOL, eos_str - 102 FORMAT('PDSYGST inputs:,UPLO:',A5,',IA:',I5,',IB:',I5, - $ ',IBTYPE:',I5,',INFO:',I5,',JA:',I5, - $ ',JB:',I5,',N:',I5,',SCALE:',F9.4, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Test the input parameters * INFO = 0 diff --git a/SRC/pdsygvx.f b/SRC/pdsygvx.f index 17c98961..99d07278 100644 --- a/SRC/pdsygvx.f +++ b/SRC/pdsygvx.f @@ -532,7 +532,6 @@ SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -544,6 +543,25 @@ SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IB, + $ IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ, + $ LIWORK, LWORK, M, + $ N, NZ, ABSTOL, ORFAC, VL, VU, eos_str + 102 FORMAT('PDSYGVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I5,', IB:',I5, + $ ', IBTYPE:',I5,', IL:',I5,', INFO:',I5, + $ ', IU:',I5,', IZ:',I5,', JA:',I5, + $ ', JB:',I5,', JZ:',I5,', LIWORK:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NZ:',I5,', ABSTOL:',F9.4,', ORFAC:',F9.4, + $ ', VL:',F9.4,', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -559,27 +577,6 @@ SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IB, IBTYPE, - $ IL, INFO, IU, IZ, JA, JB, JZ, - $ LIWORK, LWORK, M, - $ N, NZ, ABSTOL, ORFAC, VL, VU, NPROW, - $ NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDSYGVX inputs:,JOBZ:',A5,',RANGE:',A5, - $ ',UPLO:',A5,',IA:',I5,',IB:',I5,',IBTYPE:',I5, - $ ',IL:',I5,',INFO:',I5,',IU:',I5, - $ ',IZ:',I5,',JA:',I5,',JB:',I5, - $ ',JZ:',I5,',LIWORK:',I5,',LWORK:',I5, - $ ',M:',I5,',N:',I5,',NZ:',I5,',ABSTOL:',F9.4, - $ ',ORFAC:',F9.4,',VL:',F9.4, - $ ',VU:',F9.4,',NPROW:',I5,',NPCOL:',I5, - $ ',MYROW:',I5,',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Test the input parameters * INFO = 0 diff --git a/SRC/pdsyntrd.f b/SRC/pdsyntrd.f index 48766fb8..53ea2975 100644 --- a/SRC/pdsyntrd.f +++ b/SRC/pdsyntrd.f @@ -293,7 +293,6 @@ SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. Intrinsic Functions .. INTRINSIC DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -306,6 +305,18 @@ SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * AOCL_DTL_TRACE_ENTRY_F * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, eos_str + 102 FORMAT('PDSYNTRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -320,19 +331,6 @@ SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDSYNTRD inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, - $ ',JA:',I5,',LWORK:',I5,',N:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF -* * Test the input parameters * INFO = 0 diff --git a/SRC/pdsyttrd.f b/SRC/pdsyttrd.f index 725c4256..f0a8aa7e 100644 --- a/SRC/pdsyttrd.f +++ b/SRC/pdsyttrd.f @@ -463,7 +463,6 @@ SUBROUTINE PDSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * * -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -475,6 +474,18 @@ SUBROUTINE PDSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * Capture the subroutine entry in the trace file * AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, eos_str + 102 FORMAT('PDSYTTRD inputs: ,UPLO:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* $ RSRC_.LT.0 )THEN @@ -507,19 +518,6 @@ SUBROUTINE PDSYTTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) -* -* Update the log buffer with the scalar arguments details, -* MPI process grid information and write to the log file -* - IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN - WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, N, - $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDSYTTRD inputs:,UPLO:',A5,',IA:',I5,',INFO:',I5, - $ ',JA:',I5,',LWORK:',I5,',N:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) - AOCL_DTL_LOG_ENTRY_F - END IF * SAFMAX = SQRT( PDLAMCH( ICTXT, 'O' ) ) / N SAFMIN = SQRT( PDLAMCH( ICTXT, 'S' ) ) diff --git a/SRC/pdtrti2.f b/SRC/pdtrti2.f index 5060d7ed..dfe3a5f5 100644 --- a/SRC/pdtrti2.f +++ b/SRC/pdtrti2.f @@ -154,7 +154,6 @@ SUBROUTINE PDTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) LOGICAL LSAME EXTERNAL LSAME * .. -* .. * .. Executable Statements .. * * Initialize framework context structure if not initialized @@ -178,10 +177,10 @@ SUBROUTINE PDTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, $ NPROW, NPCOL, MYROW, MYCOL, eos_str - 102 FORMAT('PDTRTI2 inputs:,DIAG:',A5,',UPLO:',A5, - $ ',IA:',I5,',INFO:',I5,',JA:',I5,',N:',I5, - $ ',NPROW:',I5,',NPCOL:',I5,',MYROW:',I5, - $ ',MYCOL:',I5,A1) + 102 FORMAT('PDTRTI2 inputs: ,DIAG:',A5,', UPLO:',A5, + $ ', IA:',I5,', INFO:',I5,', JA:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) AOCL_DTL_LOG_ENTRY_F END IF * @@ -306,6 +305,10 @@ SUBROUTINE PDTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PDTRTI2 * END From 1d80f8efafa6b9cc0725200bcdd320cd5a8f6625 Mon Sep 17 00:00:00 2001 From: rahulraj Date: Fri, 13 Oct 2023 10:52:44 +0530 Subject: [PATCH 19/29] Fix added for aocl-scalapack windows static build to specify the openmp linkage with multi-threaded blas library. Signed-off-by: Rahul AMD-Internal: [CPUPL-3961] Change-Id: I64e23d69c60f46f5593505206b3ac76c8bed313e --- CMakeLists.txt | 18 ++- TESTING/AOCL_PROGRESS_TESTS/CMakeLists.txt | 40 ++++-- TESTING/EIG/CMakeLists.txt | 132 ++++++++++++------ TESTING/LIN/CMakeLists.txt | 151 ++++++++++++++------- 4 files changed, 234 insertions(+), 107 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 1655d525..4aac8556 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -312,13 +312,29 @@ ELSE(BLACS_LIBRARY) message(STATUS "--> Using default BLACS source code for building aocl-scalapack") ENDIF() +if(WIN32) + #specify openmp library to resolve multithreaded BLAS and LAPACK Libraries for static builds + SET(OpenMP_libomp_LIBRARY "C:/Program Files/LLVM/lib/libomp.lib" CACHE STRING "openmp library path") +endif(WIN32) + +find_package(OpenMP) +if (OPENMP_FOUND) + message(STATUS "Found Openmp Library : ${OPENMP_FOUND} ") +else() + message (FATAL_ERROR "Openmp Library Not Found") +endif() + unset(LAPACK_FOUND CACHE) message(STATUS "CHECKING BLAS AND LAPACK LIBRARIES") IF(LAPACK_LIBRARIES) include(CheckFortranFunctionExists) message(STATUS "--> LAPACK supplied by user is ${LAPACK_LIBRARIES}.") if(BLAS_LIBRARIES) - set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES};${BLAS_LIBRARIES}) + if(WIN32) + set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES};${BLAS_LIBRARIES};${OpenMP_libomp_LIBRARY}) + else(WIN32) + set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES};${BLAS_LIBRARIES}) + endif(WIN32) else(BLAS_LIBRARIES) set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES}) ENDIF(BLAS_LIBRARIES) diff --git a/TESTING/AOCL_PROGRESS_TESTS/CMakeLists.txt b/TESTING/AOCL_PROGRESS_TESTS/CMakeLists.txt index 201dc871..2a0fbf67 100644 --- a/TESTING/AOCL_PROGRESS_TESTS/CMakeLists.txt +++ b/TESTING/AOCL_PROGRESS_TESTS/CMakeLists.txt @@ -19,19 +19,33 @@ add_executable(xap_psgeqrf test_aocl_progress_psgeqrf.c ) add_executable(xap_pcgeqrf test_aocl_progress_pcgeqrf.c ) add_executable(xap_pzgeqrf test_aocl_progress_pzgeqrf.c ) - -target_link_libraries(xap_pdpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pspotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pcpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pzpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pcgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pdgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_psgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pzgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pdgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_psgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pcgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xap_pzgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +if(WIN32) + target_link_libraries(xap_pdpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pspotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pcpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pzpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pcgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pdgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_psgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pzgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pdgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_psgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pcgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xap_pzgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) +else(WIN32) + target_link_libraries(xap_pdpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pspotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pcpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pzpotrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pcgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pdgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_psgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pzgetrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pdgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_psgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pcgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xap_pzgeqrf scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +endif(WIN32) if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt index 43bb00e0..19451dc4 100644 --- a/TESTING/EIG/CMakeLists.txt +++ b/TESTING/EIG/CMakeLists.txt @@ -68,49 +68,95 @@ pzsepchk.f pzsepqtq.f pzlatms.f pzseprtst.f pdsepinfo.f pzlagsy.f pzlasizesep.f add_executable(xshseqr pshseqrdriver.f psmatgen2.f ${cmatgen}) add_executable(xdhseqr pdhseqrdriver.f pdmatgen2.f ${cmatgen}) -target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +if(WIN32) + target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) +else(WIN32) + target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +endif(WIN32) if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt index 2055b7d2..68b13b59 100644 --- a/TESTING/LIN/CMakeLists.txt +++ b/TESTING/LIN/CMakeLists.txt @@ -66,56 +66,107 @@ add_executable(xdls pdlsdriver.f pdlsinfo.f pdqrt13.f pdqrt14.f pdqrt16.f pdqrt1 add_executable(xcls pclsdriver.f pclsinfo.f pcqrt13.f pcqrt14.f pcqrt16.f pcqrt17.f ${cmatgen}) add_executable(xzls pzlsdriver.f pzlsinfo.f pzqrt13.f pzqrt14.f pzqrt16.f pzqrt17.f ${zmatgen}) - -target_link_libraries(xslu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xclu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xddblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xddtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xspbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +if(WIN32) + target_link_libraries(xslu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xclu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xddblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xddtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xspbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) +else(WIN32) + target_link_libraries(xslu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xclu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xddblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzdblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xddtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzdtlu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzgblu scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xspbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzpbllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzptllt scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzinv scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +endif(WIN32) if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory From 5708ac65065e04fa670ad0086f677ba1a5fc6832 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Thu, 21 Sep 2023 16:14:26 +0530 Subject: [PATCH 20/29] Trace and Logging feature enabled for 45 'single precision complex' data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: I9074bcc59c114d04a927b4e3f22415fdaf144d34 --- SRC/pcdbsv.f | 44 +++++++++++++++++++++++++++++ SRC/pcdbtrf.f | 65 +++++++++++++++++++++++++++++++++++++++++-- SRC/pcdbtrs.f | 73 +++++++++++++++++++++++++++++++++++++++++++++---- SRC/pcdbtrsv.f | 71 ++++++++++++++++++++++++++++++++++++++++++++--- SRC/pcdtsv.f | 43 +++++++++++++++++++++++++++++ SRC/pcdttrf.f | 65 +++++++++++++++++++++++++++++++++++++++++-- SRC/pcdttrs.f | 70 ++++++++++++++++++++++++++++++++++++++++++++--- SRC/pcdttrsv.f | 70 ++++++++++++++++++++++++++++++++++++++++++++--- SRC/pcgbsv.f | 44 +++++++++++++++++++++++++++++ SRC/pcgbtrf.f | 65 +++++++++++++++++++++++++++++++++++++++++-- SRC/pcgbtrs.f | 71 ++++++++++++++++++++++++++++++++++++++++++++--- SRC/pcgebd2.f | 46 +++++++++++++++++++++++++++++++ SRC/pcgebrd.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgecon.f | 57 ++++++++++++++++++++++++++++++++++++++ SRC/pcgeequ.f | 62 ++++++++++++++++++++++++++++++++++++++--- SRC/pcgehd2.f | 43 +++++++++++++++++++++++++++++ SRC/pcgehrd.f | 52 +++++++++++++++++++++++++++++++++-- SRC/pcgelq2.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgelqf.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgels.f | 48 ++++++++++++++++++++++++++++++++ SRC/pcgeql2.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgeqlf.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgeqpf.f | 57 +++++++++++++++++++++++++++++++++++--- SRC/pcgeqr2.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgeqrf.f | 55 +++++++++++++++++++++++++++++++++++-- SRC/pcgerfs.f | 51 ++++++++++++++++++++++++++++++++++ SRC/pcgerq2.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgerqf.f | 51 ++++++++++++++++++++++++++++++++-- SRC/pcgesv.f | 38 +++++++++++++++++++++++++ SRC/pcgesvd.f | 42 ++++++++++++++++++++++++++++ SRC/pcgesvx.f | 57 ++++++++++++++++++++++++++++++++++++++ SRC/pcgetf2.f | 47 +++++++++++++++++++++++++++++-- SRC/pcgetrf.f | 43 +++++++++++++++++++++++++++-- SRC/pcgetri.f | 70 +++++++++++++++++++++++++++++++++++++++++------ SRC/pcgetrs.f | 49 +++++++++++++++++++++++++++++++-- SRC/pcggqrf.f | 44 +++++++++++++++++++++++++++++ SRC/pcggrqf.f | 44 +++++++++++++++++++++++++++++ SRC/pclabrd.f | 41 +++++++++++++++++++++++++-- SRC/pclacgv.f | 51 +++++++++++++++++++++++++++++++--- SRC/pclacon.f | 63 ++++++++++++++++++++++++++++++++++++++++-- SRC/pclaconsb.f | 43 +++++++++++++++++++++++++++++ SRC/pclacp2.f | 59 +++++++++++++++++++++++++++++++++++---- SRC/pclacp3.f | 39 ++++++++++++++++++++++++-- SRC/pclacpy.f | 41 +++++++++++++++++++++++++-- SRC/pclaevswp.f | 36 +++++++++++++++++++++++- 45 files changed, 2276 insertions(+), 91 deletions(-) diff --git a/SRC/pcdbsv.f b/SRC/pcdbsv.f index c8bc24fe..d2e32653 100644 --- a/SRC/pcdbsv.f +++ b/SRC/pcdbsv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -387,6 +394,27 @@ SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PCDBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PCDBTRF and PCDBTRS. @@ -408,6 +436,10 @@ SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PCDBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -430,6 +462,10 @@ SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PCDBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -443,9 +479,17 @@ SUBROUTINE PCDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCDBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDBSV diff --git a/SRC/pcdbtrf.f b/SRC/pcdbtrf.f index cee598de..d8eae2d7 100644 --- a/SRC/pcdbtrf.f +++ b/SRC/pcdbtrf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -392,6 +399,16 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -424,6 +441,21 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, MBW2 = MAX_BW * MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCDBTRF inputs: ,BWL:',I5,', BWU:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -473,6 +505,10 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PCDBTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -481,6 +517,10 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PCDBTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -496,6 +536,10 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PCDBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -512,6 +556,10 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, $ 'PCDBTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,13 +615,22 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1258,6 +1315,10 @@ SUBROUTINE PCDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDBTRF diff --git a/SRC/pcdbtrs.f b/SRC/pcdbtrs.f index 2d5c6095..d43d5286 100644 --- a/SRC/pcdbtrs.f +++ b/SRC/pcdbtrs.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,8 +12,9 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 7, 2001 +* August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -408,6 +415,16 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -465,6 +482,22 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PCDBTRS inputs: ,TRANS:',A5,', BWL:',I5, + $ ', BWU:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -540,6 +573,10 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PCDBTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -548,6 +585,10 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PCDBTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -564,6 +605,10 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, $ 'PCDBTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -635,16 +680,30 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -757,6 +816,10 @@ SUBROUTINE PCDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDBTRS diff --git a/SRC/pcdbtrsv.f b/SRC/pcdbtrsv.f index fbb0ddad..3169dc8c 100644 --- a/SRC/pcdbtrsv.f +++ b/SRC/pcdbtrsv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -414,6 +421,16 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -476,6 +493,22 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, MBW2 = MAX_BW * MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, BWL, BWU, IB, + $ INFO, JA, LAF, LWORK, N, NRHS, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCDBTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -559,6 +592,10 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PCDBTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,6 +604,10 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PCDBTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -583,6 +624,10 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, $ 'PCDBTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -656,16 +701,30 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDBTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1589,6 +1648,10 @@ SUBROUTINE PCDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDBTRSV diff --git a/SRC/pcdtsv.f b/SRC/pcdtsv.f index 83af99db..9346d0dc 100644 --- a/SRC/pcdtsv.f +++ b/SRC/pcdtsv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IB, INFO, JA, LWORK, N, NRHS * .. @@ -397,6 +404,26 @@ SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ eos_str + 102 FORMAT('PCDTSV inputs: ,IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PCDTTRF and PCDTTRS. @@ -421,6 +448,10 @@ SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PCDTSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -443,6 +474,10 @@ SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PCDTSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -456,9 +491,17 @@ SUBROUTINE PCDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCDTSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDTSV diff --git a/SRC/pcdttrf.f b/SRC/pcdttrf.f index a084b59c..07fd47ba 100644 --- a/SRC/pcdttrf.f +++ b/SRC/pcdttrf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, $ INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, JA, LAF, LWORK, N * .. @@ -404,6 +411,16 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -439,6 +456,19 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCDTTRF inputs: ,INFO:',I5,', JA:',I5, + $ ', LAF:',I5,', LWORK:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -470,6 +500,10 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PCDTTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -478,6 +512,10 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PCDTTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -493,6 +531,10 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PCDTTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -509,6 +551,10 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, $ 'PCDTTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -560,13 +606,22 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDTTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -748,7 +803,7 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * Calculate the update block for previous proc, E_i = GL_i{GU_i} * #ifdef F2C - CALL CDOTC( TMP, ODD_SIZE, AF( 1 ), 1, + CALL CDOTC( TMP, ODD_SIZE, AF( 1 ), 1, $ AF( WORK_U+1 ), 1 ) AF( ODD_SIZE+3 ) = -CONE * TMP #else @@ -1076,6 +1131,10 @@ SUBROUTINE PCDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDTTRF diff --git a/SRC/pcdttrs.f b/SRC/pcdttrs.f index d41406e7..233d1410 100644 --- a/SRC/pcdttrs.f +++ b/SRC/pcdttrs.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * and University of California, Berkeley. * August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -424,6 +431,16 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -489,6 +506,21 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IB, INFO, JA, LAF, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PCDTTRS inputs: ,TRANS:',A5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -546,6 +578,10 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PCDTTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -554,6 +590,10 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PCDTTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -570,6 +610,10 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, $ 'PCDTTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -637,16 +681,30 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDTTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -788,6 +846,10 @@ SUBROUTINE PCDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDTTRS diff --git a/SRC/pcdttrsv.f b/SRC/pcdttrsv.f index 417c14d0..1d4c2fc8 100644 --- a/SRC/pcdttrsv.f +++ b/SRC/pcdttrsv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -429,6 +436,16 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -494,6 +511,21 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, IB, INFO, JA, + $ LAF, LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PCDTTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5, + $ ', LAF:',I5,', LWORK:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -559,6 +591,10 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PCDTTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,6 +603,10 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PCDTTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -583,6 +623,10 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, $ 'PCDTTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -652,16 +696,30 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCDTTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1520,6 +1578,10 @@ SUBROUTINE PCDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCDTTRSV diff --git a/SRC/pcgbsv.f b/SRC/pcgbsv.f index 20480f6e..851a4a77 100644 --- a/SRC/pcgbsv.f +++ b/SRC/pcgbsv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, $ DESCB, WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -392,6 +399,27 @@ SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PCGBSV inputs: ,BWL:',I5,', BWU:',I5,', IB:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PCGBTRF and PCGBTRS. @@ -413,6 +441,10 @@ SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, CALL PXERBLA( ICTXT, $ 'PCGBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -435,6 +467,10 @@ SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PCGBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -448,9 +484,17 @@ SUBROUTINE PCGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGBSV diff --git a/SRC/pcgbtrf.f b/SRC/pcgbtrf.f index ce246fdd..2a28f428 100644 --- a/SRC/pcgbtrf.f +++ b/SRC/pcgbtrf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, $ WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -401,6 +408,16 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -429,6 +446,21 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGBTRF inputs: ,BWL:',I5,', BWU:',I5, + $ ', INFO:',I5,', JA:',I5,', LAF:',I5, + $ ', LWORK:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -480,6 +512,10 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PCGBTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -488,6 +524,10 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PCGBTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -503,6 +543,10 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PCGBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -521,6 +565,10 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, $ 'PCGBTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -576,13 +624,22 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCGBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1099,6 +1156,10 @@ SUBROUTINE PCGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGBTRF diff --git a/SRC/pcgbtrs.f b/SRC/pcgbtrs.f index 1ded0781..7f5f7a38 100644 --- a/SRC/pcgbtrs.f +++ b/SRC/pcgbtrs.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWU, BWL, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -414,6 +421,16 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -472,6 +489,22 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWU, BWL, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PCGBTRS inputs: ,TRANS:',A5,', BWU:',I5, + $ ', BWL:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', LAF:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -549,6 +582,10 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, CALL PXERBLA( ICTXT, $ 'PCGBTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -557,6 +594,10 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, CALL PXERBLA( ICTXT, $ 'PCGBTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -574,6 +615,10 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, $ 'PCGBTRS: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -645,16 +690,30 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCGBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1172,6 +1231,10 @@ SUBROUTINE PCGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * WORK( 1 ) = WORK_SIZE_MIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGBTRS diff --git a/SRC/pcgebd2.f b/SRC/pcgebd2.f index 22f7fbbf..0fd1f74c 100644 --- a/SRC/pcgebd2.f +++ b/SRC/pcgebd2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -272,11 +279,34 @@ SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEBD2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -310,8 +340,16 @@ SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEBD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -337,6 +375,10 @@ SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, END IF IF( MYROW.EQ.IAROW ) $ TAUP( II ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -446,6 +488,10 @@ SUBROUTINE PCGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEBD2 diff --git a/SRC/pcgebrd.f b/SRC/pcgebrd.f index 94327ecb..adac196f 100644 --- a/SRC/pcgebrd.f +++ b/SRC/pcgebrd.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -271,11 +278,34 @@ SUBROUTINE PCGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEBRD inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -314,16 +344,29 @@ SUBROUTINE PCGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEBRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * MN = MIN( M, N ) - IF( MN.EQ.0 ) - $ RETURN + IF( MN.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Initialize parameters. * @@ -407,6 +450,10 @@ SUBROUTINE PCGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEBRD diff --git a/SRC/pcgecon.f b/SRC/pcgecon.f index 82b157cf..a6d1953f 100644 --- a/SRC/pcgecon.f +++ b/SRC/pcgecon.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM INTEGER IA, INFO, JA, LRWORK, LWORK, N @@ -218,11 +225,37 @@ SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, INFO, JA, LRWORK, + $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PCGECON inputs: ,NORM:',A5,', IA:',I5, + $ ', INFO:',I5,', JA:',I5,', LRWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', ANORM:',F9.4, + $ ', RCOND:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -285,8 +318,16 @@ SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGECON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -295,11 +336,23 @@ SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, RCOND = ZERO IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( ANORM.EQ.ZERO ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( N.EQ.1 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -415,6 +468,10 @@ SUBROUTINE PCGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGECON diff --git a/SRC/pcgeequ.f b/SRC/pcgeequ.f index bea7071f..e4675260 100644 --- a/SRC/pcgeequ.f +++ b/SRC/pcgeequ.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, $ AMAX, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N REAL AMAX, COLCND, ROWCND @@ -195,11 +202,36 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, AMAX, COLCND, + $ ROWCND, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PCGEEQU inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', AMAX:',F9.4, + $ ', COLCND:',F9.4,', ROWCND:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -213,6 +245,10 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEEQU', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -222,6 +258,10 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, ROWCND = ONE COLCND = ONE AMAX = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -293,8 +333,13 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 50 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -352,8 +397,13 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 110 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -368,6 +418,10 @@ SUBROUTINE PCGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEEQU diff --git a/SRC/pcgehd2.f b/SRC/pcgehd2.f index 9b0f2d18..736f0a95 100644 --- a/SRC/pcgehd2.f +++ b/SRC/pcgehd2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -216,11 +223,35 @@ SUBROUTINE PCGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEHD2 inputs: ,IA:',I5,', IHI:',I5,', ILO:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,8 +287,16 @@ SUBROUTINE PCGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEHD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -287,6 +326,10 @@ SUBROUTINE PCGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEHD2 diff --git a/SRC/pcgehrd.f b/SRC/pcgehrd.f index 16c4e262..9e8fc1d8 100644 --- a/SRC/pcgehrd.f +++ b/SRC/pcgehrd.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -230,11 +237,35 @@ SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEHRD inputs: ,IA:',I5,', IHI:',I5,', ILO:',I5, + $ ', INFO:',I5,', JA:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -288,8 +319,16 @@ SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEHRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -310,8 +349,13 @@ SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * * Quick return if possible * - IF( IHI-ILO.LE.0 ) - $ RETURN + IF( IHI-ILO.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) @@ -376,6 +420,10 @@ SUBROUTINE PCGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEHRD diff --git a/SRC/pcgelq2.f b/SRC/pcgelq2.f index ce845fc9..78846ef2 100644 --- a/SRC/pcgelq2.f +++ b/SRC/pcgelq2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PCGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGELQ2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -223,15 +253,28 @@ SUBROUTINE PCGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGELQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -267,6 +310,10 @@ SUBROUTINE PCGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGELQ2 diff --git a/SRC/pcgelqf.f b/SRC/pcgelqf.f index 51e5be80..4e5a7444 100644 --- a/SRC/pcgelqf.f +++ b/SRC/pcgelqf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PCGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGELQF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -230,15 +260,28 @@ SUBROUTINE PCGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGELQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -305,6 +348,10 @@ SUBROUTINE PCGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGELQF diff --git a/SRC/pcgels.f b/SRC/pcgels.f index 494c10a1..7d1bf039 100644 --- a/SRC/pcgels.f +++ b/SRC/pcgels.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, NRHS @@ -268,11 +275,36 @@ SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ LWORK, M, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PCGELS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5,', JB:',I5, + $ ', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -378,8 +410,16 @@ SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGELS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -388,6 +428,10 @@ SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, IF( MIN( M, N, NRHS ).EQ.0 ) THEN CALL PCLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, $ IB, JB, DESCB ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -590,6 +634,10 @@ SUBROUTINE PCGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGELS diff --git a/SRC/pcgeql2.f b/SRC/pcgeql2.f index 3a74a6f2..657eac16 100644 --- a/SRC/pcgeql2.f +++ b/SRC/pcgeql2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PCGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEQL2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -225,15 +255,28 @@ SUBROUTINE PCGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEQL2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -302,6 +345,10 @@ SUBROUTINE PCGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEQL2 diff --git a/SRC/pcgeqlf.f b/SRC/pcgeqlf.f index e7808a5e..3f8a3cb6 100644 --- a/SRC/pcgeqlf.f +++ b/SRC/pcgeqlf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PCGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEQLF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,15 +262,28 @@ SUBROUTINE PCGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEQLF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -304,6 +347,10 @@ SUBROUTINE PCGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEQLF diff --git a/SRC/pcgeqpf.f b/SRC/pcgeqpf.f index 5e3e2d08..a0c50d7c 100644 --- a/SRC/pcgeqpf.f +++ b/SRC/pcgeqpf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * and University of California, Berkeley. * November 20, 2019 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, INFO, LRWORK, LWORK, M, N * .. @@ -189,9 +196,9 @@ SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * * References * ========== -* +* * For modifications introduced in Scalapack 2.1 -* LAWN 295 +* LAWN 295 * New robust ScaLAPACK routine for computing the QR factorization with column pivoting * Zvonimir Bujanovic, Zlatko Drmac * http://www.netlib.org/lapack/lawnspdf/lawn295.pdf @@ -238,11 +245,36 @@ SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, INFO, LRWORK, LWORK, + $ M, N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGEQPF inputs: ,IA:',I5,', JA:',I5,', INFO:',I5, + $ ', LRWORK:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -291,15 +323,28 @@ SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEQPF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) @@ -568,6 +613,10 @@ SUBROUTINE PCGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, WORK( 1 ) = CMPLX( REAL( LWMIN ) ) RWORK( 1 ) = REAL( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEQPF diff --git a/SRC/pcgeqr2.f b/SRC/pcgeqr2.f index 5ef4cd6a..32ea982d 100644 --- a/SRC/pcgeqr2.f +++ b/SRC/pcgeqr2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PCGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEQR2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -224,15 +254,28 @@ SUBROUTINE PCGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEQR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -301,6 +344,10 @@ SUBROUTINE PCGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEQR2 diff --git a/SRC/pcgeqrf.f b/SRC/pcgeqrf.f index d186ecf5..7272e1c8 100644 --- a/SRC/pcgeqrf.f +++ b/SRC/pcgeqrf.f @@ -1,8 +1,13 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 20, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) @@ -14,6 +19,7 @@ SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -182,6 +188,9 @@ SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -216,11 +225,34 @@ SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGEQRF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,15 +288,28 @@ SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGEQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -355,6 +400,10 @@ SUBROUTINE PCGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGEQRF diff --git a/SRC/pcgerfs.f b/SRC/pcgerfs.f index 10f301f8..86c218a5 100644 --- a/SRC/pcgerfs.f +++ b/SRC/pcgerfs.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, $ JAF, DESCAF, IPIV, B, IB, JB, DESCB, X, IX, $ JX, DESCX, FERR, BERR, WORK, LWORK, RWORK, @@ -8,6 +14,7 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IAF, IB, IX, INFO, JA, JAF, JB, JX, @@ -308,6 +315,16 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * .. Initialize EST EST = (0.0, 0.0) * @@ -316,6 +333,24 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IAF, IB, IX, INFO, + $ JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PCGERFS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IAF:',I5,', IB:',I5,', IX:',I5,', INFO:',I5, + $ ', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LRWORK:',I5, + $ ', LWORK:',I5,', N:',I5,', NRHS:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * NOTRAN = LSAME( TRANS, 'N' ) @@ -436,8 +471,16 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGERFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -452,6 +495,10 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -890,6 +937,10 @@ SUBROUTINE PCGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, WORK( 1 ) = CMPLX( REAL( LWMIN ) ) RWORK( 1 ) = REAL( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGERFS diff --git a/SRC/pcgerq2.f b/SRC/pcgerq2.f index dcdb7703..ac5d349a 100644 --- a/SRC/pcgerq2.f +++ b/SRC/pcgerq2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGERQ2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -223,15 +253,28 @@ SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGERQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -264,6 +307,10 @@ SUBROUTINE PCGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGERQ2 diff --git a/SRC/pcgerqf.f b/SRC/pcgerqf.f index 5faf6223..9742829b 100644 --- a/SRC/pcgerqf.f +++ b/SRC/pcgerqf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PCGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGERQF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LWORK:',I5,', M:',I5,', N:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -230,15 +260,28 @@ SUBROUTINE PCGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGERQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -302,6 +345,10 @@ SUBROUTINE PCGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = CMPLX( REAL( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGERQF diff --git a/SRC/pcgesv.f b/SRC/pcgesv.f index a3e435cd..02d609b6 100644 --- a/SRC/pcgesv.f +++ b/SRC/pcgesv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * and University of California, Berkeley. * Jan 30, 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, N, NRHS * .. @@ -179,11 +186,34 @@ SUBROUTINE PCGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, N, NRHS, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGESV inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', N:',I5, + $ ', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,6 +250,10 @@ SUBROUTINE PCGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGESV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -237,6 +271,10 @@ SUBROUTINE PCGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGESV diff --git a/SRC/pcgesvd.f b/SRC/pcgesvd.f index 67f1f324..f8df1ede 100644 --- a/SRC/pcgesvd.f +++ b/SRC/pcgesvd.f @@ -1,4 +1,10 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, + VT,IVT,JVT,DESCVT,WORK,LWORK,RWORK,INFO) * @@ -8,6 +14,7 @@ SUBROUTINE PCGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * Jan 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBU,JOBVT INTEGER IA,INFO,IU,IVT,JA,JU,JVT,LWORK,M,N @@ -328,7 +335,34 @@ SUBROUTINE PCGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, INTRINSIC CMPLX * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBU,JOBVT, IA,INFO,IU,IVT, + $ JA,JU,JVT,LWORK,M,N, eos_str + 102 FORMAT('PCGESVD inputs: ,JOBU:',A5,', JOBVT:',A5, + $ ', IA:',I5,', INFO:',I5,', IU:',I5, + $ ', IVT:',I5,', JA:',I5,', JU:',I5, + $ ', JVT:',I5,', LWORK:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF (BLOCK_CYCLIC_2D*DTYPE_*LLD_*MB_*M_*NB_*N_.LT.0) RETURN * CALL BLACS_GRIDINFO(DESCA(CTXT_),NPROW,NPCOL,MYPROW,MYPCOL) @@ -480,6 +514,10 @@ SUBROUTINE PCGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * IF (INFO.NE.0) THEN CALL PXERBLA(DESCA(CTXT_),'PCGESVD',-INFO) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF (LWORK.EQ.-1) THEN GO TO 40 @@ -645,5 +683,9 @@ SUBROUTINE PCGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * * End of PCGESVD * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END diff --git a/SRC/pcgesvx.f b/SRC/pcgesvx.f index 1627dcb7..3422f247 100644 --- a/SRC/pcgesvx.f +++ b/SRC/pcgesvx.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, $ IAF, JAF, DESCAF, IPIV, EQUED, R, C, B, IB, $ JB, DESCB, X, IX, JX, DESCX, RCOND, FERR, @@ -8,6 +14,7 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, FACT, TRANS INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, LRWORK, @@ -449,11 +456,41 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, FACT, TRANS, IA, IAF, + $ IB, INFO, IX, JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, + $ RCOND, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGESVX inputs: ,EQUED:',A5,', FACT:',A5, + $ ', TRANS:',A5,', IA:',I5,', IAF:',I5, + $ ', IB:',I5,', INFO:',I5,', IX:',I5, + $ ', JA:',I5,', JAF:',I5,', JB:',I5, + $ ', JX:',I5,', LRWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NRHS:',I5,', RCOND:',F9.4, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -651,8 +688,16 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGESVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -729,6 +774,10 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, IF( INFO.NE.0 ) THEN IF( INFO.GT.0 ) $ RCOND = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF END IF @@ -751,6 +800,10 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( RCOND.LT.PSLAMCH( ICTXT, 'Epsilon' ) ) THEN INFO = IA + N +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -823,6 +876,10 @@ SUBROUTINE PCGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, WORK( 1 ) = REAL( LWMIN ) RWORK( 1 ) = REAL( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGESVX diff --git a/SRC/pcgetf2.f b/SRC/pcgetf2.f index 7807ac17..5174ec20 100644 --- a/SRC/pcgetf2.f +++ b/SRC/pcgetf2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PCGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -159,11 +166,34 @@ SUBROUTINE PCGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGETF2 inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -189,13 +219,22 @@ SUBROUTINE PCGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGETF2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * MN = MIN( M, N ) CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, @@ -245,6 +284,10 @@ SUBROUTINE PCGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGETF2 diff --git a/SRC/pcgetrf.f b/SRC/pcgetrf.f index 70669c64..6be160b5 100644 --- a/SRC/pcgetrf.f +++ b/SRC/pcgetrf.f @@ -1,7 +1,11 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. +* Copyright (c) 2022-23 Advanced Micro Devices, Inc.  All rights reserved. * June 10, 2022 * +* #include "SL_Context_fortran_include.h" * SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) @@ -13,6 +17,7 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -161,6 +166,7 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -182,18 +188,35 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) INTRINSIC MIN, MOD * .. * +* .. Executable Statements .. +* * Initialize framework context structure if not initialized * * CALL AOCL_SCALAPACK_INIT( ) * -* .. Executable Statements .. +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGETRF inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', M:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -218,6 +241,10 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGETRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -225,8 +252,16 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( DESCA( M_ ).EQ.1 ) THEN IPIV( 1 ) = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -354,6 +389,10 @@ SUBROUTINE PCGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGETRF diff --git a/SRC/pcgetri.f b/SRC/pcgetri.f index 8d582dd1..a7642be3 100644 --- a/SRC/pcgetri.f +++ b/SRC/pcgetri.f @@ -1,12 +1,19 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, $ IWORK, LIWORK, INFO ) * * -- ScaLAPACK routine (version 1.7.4) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* v1.7.4: May 10, 2006 +* v1.7.4: May 10, 2006 * v1.7: May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LIWORK, LWORK, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PCGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LIWORK, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCGETRI inputs: ,IA:',I5,', INFO:',I5, + $ ', JA:',I5,', LIWORK:',I5,', LWORK:',I5, + $ ', N:',I5,', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -226,21 +256,21 @@ SUBROUTINE PCGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * LDW = LOCc( M_P + MOD(IP-1, MB_P) ) + * MB_P * CEIL( CEIL(LOCr(M_P)/MB_P) / (LCM/NPROW) ) * -* where +* where * M_P is the global length of the pivot vector * MP = DESCA( M_ ) + DESCA( MB_ ) * NPROW * I_P is IA * I_P = IA -* MB_P is the block size use for the block cyclic distribution of the +* MB_P is the block size use for the block cyclic distribution of the * pivot vector * MB_P = DESCA (MB_ ) -* LOCc ( . ) +* LOCc ( . ) * NUMROC ( . , DESCA ( NB_ ), MYCOL, DESCA ( CSRC_ ), NPCOL ) * LOCr ( . ) * NUMROC ( . , DESCA ( MB_ ), MYROW, DESCA ( RSRC_ ), NPROW ) * CEIL ( X / Y ) * ICEIL( X, Y ) -* LCM +* LCM * LCM = ILCM( NPROW, NPCOL ) * LCM = ILCM( NPROW, NPCOL ) @@ -285,22 +315,40 @@ SUBROUTINE PCGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGETRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Form inv(U). If INFO > 0 from PCTRTRI, then U is singular, * and the inverse is not computed. * CALL PCTRTRI( 'Upper', 'Non-unit', N, A, IA, JA, DESCA, INFO ) - IF( INFO.GT.0 ) - $ RETURN + IF( INFO.GT.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Define array descriptor for working array WORK * @@ -367,6 +415,10 @@ SUBROUTINE PCGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGETRI diff --git a/SRC/pcgetrs.f b/SRC/pcgetrs.f index 0979fee1..3de9fa35 100644 --- a/SRC/pcgetrs.f +++ b/SRC/pcgetrs.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, $ IB, JB, DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -179,11 +186,36 @@ SUBROUTINE PCGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGETRS inputs: ,TRANS:',A5,', IA:',I5, + $ ', IB:',I5,', INFO:',I5,', JA:',I5, + $ ', JB:',I5,', N:',I5,', NRHS:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,13 +264,22 @@ SUBROUTINE PCGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGETRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL DESCSET( DESCIP, DESCA( M_ ) + DESCA( MB_ )*NPROW, 1, $ DESCA( MB_ ), 1, DESCA( RSRC_ ), MYCOL, ICTXT, @@ -284,6 +325,10 @@ SUBROUTINE PCGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGETRS diff --git a/SRC/pcggqrf.f b/SRC/pcggqrf.f index a794a27a..8244310d 100644 --- a/SRC/pcggqrf.f +++ b/SRC/pcggqrf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -281,11 +288,36 @@ SUBROUTINE PCGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGGQRF inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', P:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -341,8 +373,16 @@ SUBROUTINE PCGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGGQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -363,6 +403,10 @@ SUBROUTINE PCGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PCGERQF( N, P, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = CMPLX( REAL( MAX( LWMIN, INT( WORK( 1 ) ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGGQRF diff --git a/SRC/pcggrqf.f b/SRC/pcggrqf.f index a5a1c2fd..d702d22c 100644 --- a/SRC/pcggrqf.f +++ b/SRC/pcggrqf.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PCGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -281,11 +288,36 @@ SUBROUTINE PCGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCGGRQF inputs: ,IA:',I5,', IB:',I5,', INFO:',I5, + $ ', JA:',I5,', JB:',I5,', LWORK:',I5, + $ ', M:',I5,', N:',I5,', P:',I5, + $ ', NPROW: ', I5,', NPCOL: ', I5 , + $ ', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -341,8 +373,16 @@ SUBROUTINE PCGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCGGRQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -363,6 +403,10 @@ SUBROUTINE PCGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PCGEQRF( P, N, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = CMPLX( REAL( MAX( LWMIN, INT( WORK( 1 ) ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCGGRQF diff --git a/SRC/pclabrd.f b/SRC/pclabrd.f index 5229b8f3..4c4f2376 100644 --- a/SRC/pclabrd.f +++ b/SRC/pclabrd.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ X, IX, JX, DESCX, Y, IY, JY, DESCY, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PCLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IX, IY, JA, JX, JY, M, N, NB * .. @@ -274,10 +281,36 @@ SUBROUTINE PCLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, + $ N, NB, eos_str + 102 FORMAT('PCLABRD inputs: ,IA:',I5,', IX:',I5,', IY:',I5, + $ ', JA:',I5,', JX:',I5,', JY:',I5, + $ ', M:',I5,', N:',I5,', NB:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -508,6 +541,10 @@ SUBROUTINE PCLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, 20 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLABRD diff --git a/SRC/pclacgv.f b/SRC/pclacgv.f index a69802f9..711c7262 100644 --- a/SRC/pclacgv.f +++ b/SRC/pclacgv.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INCX, IX, JX, N * .. @@ -131,11 +138,33 @@ SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INCX, IX, JX, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PCLACGV inputs: ,INCX:',I5,', IX:',I5, + $ ', JX:',I5,', N:',I5,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Figure local indexes * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, @@ -146,8 +175,13 @@ SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * * sub( X ) is rowwise distributed. * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ICOFFX = MOD( JX-1, DESCX( NB_ ) ) NQ = NUMROC( N+ICOFFX, DESCX( NB_ ), MYCOL, IXCOL, NPCOL ) IF( MYCOL.EQ.IXCOL ) @@ -165,8 +199,13 @@ SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * * sub( X ) is columnwise distributed. * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFFX = MOD( IX-1, DESCX( MB_ ) ) NP = NUMROC( N+IROFFX, DESCX( MB_ ), MYROW, IXROW, NPROW ) IF( MYROW.EQ.IXROW ) @@ -181,6 +220,10 @@ SUBROUTINE PCLACGV( N, X, IX, JX, DESCX, INCX ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACGV diff --git a/SRC/pclacon.f b/SRC/pclacon.f index d02ed0a2..321b9147 100644 --- a/SRC/pclacon.f +++ b/SRC/pclacon.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, $ KASE ) * @@ -6,6 +12,7 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IV, IX, JV, JX, KASE, N REAL EST @@ -184,15 +191,43 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IV, IX, JV, JX, KASE, N, EST, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PCLACON inputs: ,IV:',I5,', IX:',I5,', JV:',I5, + $ ', JX:',I5,', KASE:',I5,', N:',I5, + $ ', EST:',F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIVX, JJVX, IVXROW, IVXCOL ) - IF( MYCOL.NE.IVXCOL ) - $ RETURN + IF( MYCOL.NE.IVXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFF = MOD( IX-1, DESCX( MB_ ) ) NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IVXROW, NPROW ) IF( MYROW.EQ.IVXROW ) @@ -206,6 +241,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 10 CONTINUE KASE = 1 JUMP = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -246,6 +285,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 30 CONTINUE KASE = 2 JUMP = 2 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 2) @@ -280,6 +323,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, END IF KASE = 1 JUMP = 3 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 3) @@ -311,6 +358,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 80 CONTINUE KASE = 2 JUMP = 4 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 4) @@ -353,6 +404,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 110 CONTINUE KASE = 1 JUMP = 5 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 5) @@ -377,6 +432,10 @@ SUBROUTINE PCLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 130 CONTINUE KASE = 0 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACON diff --git a/SRC/pclaconsb.f b/SRC/pclaconsb.f index aaaf249a..6e5961a0 100644 --- a/SRC/pclaconsb.f +++ b/SRC/pclaconsb.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, $ LWORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PCLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, L, LWORK, M COMPLEX H33, H43H34, H44 @@ -192,12 +199,40 @@ SUBROUTINE PCLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) LDA = DESCA( LLD_ ) ULP = PSLAMCH( CONTXT, 'PRECISION' ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, L, LWORK, M, real(H33), + $ ' + i ',aimag(H33),real(H43H34),' + i ', + $ aimag(H43H34),real(H44),' + i ', + $ aimag(H44), NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PCLACONSB inputs: ,I:',I5,', L:',I5,', LWORK:',I5, + $ ', M:',I5,', H33:',F9.4, A, F9.4, + $ ', H43H34:',F9.4, A, F9.4,', H44:',F9.4, A, F9.4, + $ ', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5, + $ ', MYCOL: ', I5, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -222,6 +257,10 @@ SUBROUTINE PCLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, END IF IF( LWORK.LT.7*ISTR2 ) THEN CALL PXERBLA( CONTXT, 'PCLACONSB', 10 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ISTR3 = 3*ISTR2 @@ -578,6 +617,10 @@ SUBROUTINE PCLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * CALL IGAMX2D( CONTXT, 'ALL', ' ', 1, 1, M, 1, L, L, -1, -1, -1 ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACONSB diff --git a/SRC/pclacp2.f b/SRC/pclacp2.f index 7265ea29..34dda3dc 100644 --- a/SRC/pclacp2.f +++ b/SRC/pclacp2.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -5,6 +11,7 @@ SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -168,8 +175,34 @@ SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PCLACP2 inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -228,8 +261,13 @@ SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYCOL.EQ.IACOL ) THEN * MP = NUMROC( M+IROFFA, MBA, MYROW, IAROW, NPROW ) - IF( MP.LE.0 ) - $ RETURN + IF( MP.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYROW.EQ.IAROW ) $ MP = MP - IROFFA MYDIST = MOD( MYROW-IAROW+NPROW, NPROW ) @@ -326,8 +364,13 @@ SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYROW.EQ.IAROW ) THEN * NQ = NUMROC( N+ICOFFA, NBA, MYCOL, IACOL, NPCOL ) - IF( NQ.LE.0 ) - $ RETURN + IF( NQ.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYCOL.EQ.IACOL ) $ NQ = NQ - ICOFFA MYDIST = MOD( MYCOL-IACOL+NPCOL, NPCOL ) @@ -398,6 +441,10 @@ SUBROUTINE PCLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACP2 diff --git a/SRC/pclacp3.f b/SRC/pclacp3.f index 831d4323..81ffb34e 100644 --- a/SRC/pclacp3.f +++ b/SRC/pclacp3.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PCLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, II, JJ, LDB, M, REV * .. @@ -161,8 +168,32 @@ SUBROUTINE PCLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * .. * .. Executable Statements .. * - IF( M.LE.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, eos_str + 102 FORMAT('PCLACP3 inputs: ,I:',I5,', II:',I5,', JJ:',I5, + $ ', LDB:',I5,', M:',I5,', REV:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) @@ -305,6 +336,10 @@ SUBROUTINE PCLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) IF( IDJ.LE.IFIN ) $ GO TO 30 END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACP3 diff --git a/SRC/pclacpy.f b/SRC/pclacpy.f index 4322c998..079b943b 100644 --- a/SRC/pclacpy.f +++ b/SRC/pclacpy.f @@ -1,3 +1,9 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PCLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -6,6 +12,7 @@ SUBROUTINE PCLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -162,8 +169,34 @@ SUBROUTINE PCLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PCLACPY inputs: ,UPLO:',A5,', IA:',I5, + $ ', IB:',I5,', JA:',I5,', JB:',I5,', M:',I5, + $ ', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) @@ -224,6 +257,10 @@ SUBROUTINE PCLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLACPY diff --git a/SRC/pclaevswp.f b/SRC/pclaevswp.f index 97a41c80..0a591877 100644 --- a/SRC/pclaevswp.f +++ b/SRC/pclaevswp.f @@ -1,4 +1,8 @@ +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. * +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PCLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, $ RWORK, LRWORK ) @@ -8,6 +12,7 @@ SUBROUTINE PCLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * and University of California, Berkeley. * April 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IZ, JZ, LDZI, LRWORK, N * .. @@ -154,9 +159,34 @@ SUBROUTINE PCLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, INTRINSIC CMPLX, MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IZ, JZ, LDZI, LRWORK, N, eos_str + 102 FORMAT('PCLAEVSWP inputs: ,IZ:',I5,', JZ:',I5, + $ ', LDZI:',I5,', LRWORK:',I5,', N:',I5, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) IAM = MYROW + MYCOL*NPROW IAM = MYROW*NPCOL + MYCOL @@ -280,6 +310,10 @@ SUBROUTINE PCLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, 100 CONTINUE * 110 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PCLAEVSWP From b599f4628acbf4304c17cad8924ca11ba2758805 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Wed, 25 Oct 2023 11:14:20 +0530 Subject: [PATCH 21/29] Trace and Log feature build config option modification: 1) Default build does not support Trace and Log feature. 2) config flag -DENABLE_DTL=ON will enable the same. 3) Run time enablement needs the environment variables AOCL_SL_TRACE, AOCL_SL_LOG for trace and log respectively. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3505] Change-Id: I51ccbd98d1d2328db37d4bcacef57774a1ecb9dc --- CMakeLists.txt | 7 ++----- FRAMEWORK/CMakeLists.txt | 11 +++++++++-- FRAMEWORK/SL_Context_fortran_include.h | 16 ++++++++++++---- 3 files changed, 23 insertions(+), 11 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4aac8556..edd72749 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -50,7 +50,7 @@ if (WIN32 AND CMAKE_Fortran_COMPILER_ID MATCHES "Intel") endif() set(CMAKE_ICC_FLAGS " ") -set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -fopenmp" ) +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp" ) # set compile flags to enable address sanitizer (ASAN) tests if(ENABLE_ASAN_TESTS) @@ -230,10 +230,7 @@ MESSAGE(STATUS "CMAKE_C_COMPILER_ID = ${CMAKE_C_COMPILER_ID}") MESSAGE(STATUS "CMAKE_Fortran_COMPILER_ID = ${CMAKE_Fortran_COMPILER_ID}") if(ENABLE_DTL) -#Enable DTL for UNIX - if(UNIX) - add_definitions("-DAOCL_DTL ") - endif() + add_definitions("-DAOCL_DTL ") ENDIF(ENABLE_DTL) if(ENABLE_ILP64) diff --git a/FRAMEWORK/CMakeLists.txt b/FRAMEWORK/CMakeLists.txt index f26a375f..465d188d 100644 --- a/FRAMEWORK/CMakeLists.txt +++ b/FRAMEWORK/CMakeLists.txt @@ -3,11 +3,18 @@ # ---------------------------------- # aocl-scaLAPACK framework routines # ---------------------------------- + +if(ENABLE_DTL) +# Include 'fopenmp' flag to enable 'Thread local storage' +# attribute for the 'Log Buffer' +set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -cpp -fopenmp" ) +ENDIF(ENABLE_DTL) + set (framework-C - SL_Context.c cpu_features.c) + SL_Context.c cpu_features.c) set (framework - SL_Context_module.f) + SL_Context_module.f) set(src ${framework-C} ${framework}) diff --git a/FRAMEWORK/SL_Context_fortran_include.h b/FRAMEWORK/SL_Context_fortran_include.h index e4de8007..da876f8b 100644 --- a/FRAMEWORK/SL_Context_fortran_include.h +++ b/FRAMEWORK/SL_Context_fortran_include.h @@ -25,17 +25,25 @@ #ifndef SL_CONTEXT_FORTRAN_H #define SL_CONTEXT_FORTRAN_H +#ifdef AOCL_DTL + #if _WIN32 #define AOCL_DTL_TRACE_ENTRY_F CALL SL_DTL_TRACE_ENTRY_F(__FILE__, __LINE__, ' ') #define AOCL_DTL_TRACE_EXIT_F CALL SL_DTL_TRACE_EXIT_F (__FILE__, __LINE__, ' ') - #define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY(__FILE__, "", __LINE__, LOG_BUF ) #define aocl_scalapack_init_ AOCL_SCALAPACK_INIT -#else +#else /* _WIN32 */ #define AOCL_DTL_TRACE_ENTRY_F CALL SL_DTL_TRACE_ENTRY_F(FILE_NAME, __LINE__, ' ') #define AOCL_DTL_TRACE_EXIT_F CALL SL_DTL_TRACE_EXIT_F (FILE_NAME, __LINE__, ' ') - #define AOCL_DTL_LOG_ENTRY_F CALL AOCL_SL_DTL_LOG_ENTRY( FILE_NAME// C_NULL_CHAR, FUNCTION_NAME// C_NULL_CHAR, __LINE__, LOG_BUF ) -#endif +#endif /* _WIN32 */ + +#else /* AOCL_DTL */ + +#define AOCL_DTL_TRACE_ENTRY_F CONTINUE +#define AOCL_DTL_TRACE_EXIT_F CONTINUE +#define AOCL_DTL_LOG_ENTRY_F CONTINUE + +#endif /* AOCL_DTL */ #endif /* SL_CONTEXT_FORTRAN_H */ From b982ecbb822e8de99ce3db76958ed6996b3a201a Mon Sep 17 00:00:00 2001 From: nprasadm Date: Thu, 12 Oct 2023 17:18:04 +0530 Subject: [PATCH 22/29] Build support added for Linux LLVM-16 flang compiler. Modified the structure of some DO loops in Fortran sources that look like Hollerith constants to the LLVM-16 flang compiler. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3482] Change-Id: I632a322327c4e3083e200a8593bb555be9e3b279 --- PBLAS/TESTING/pcblastst.f | 16 ++++++++-------- PBLAS/TESTING/pdblastst.f | 16 ++++++++-------- PBLAS/TESTING/psblastst.f | 16 ++++++++-------- PBLAS/TESTING/pzblastst.f | 16 ++++++++-------- SRC/icopypv.f | 2 +- TESTING/LIN/pcdbdriver.f | 4 ++-- TESTING/LIN/pcdtdriver.f | 4 ++-- TESTING/LIN/pcgbdriver.f | 4 ++-- TESTING/LIN/pclltdriver.f | 4 ++-- TESTING/LIN/pclsdriver.f | 4 ++-- TESTING/LIN/pcludriver.f | 4 ++-- TESTING/LIN/pcpbdriver.f | 4 ++-- TESTING/LIN/pcptdriver.f | 8 ++++---- TESTING/LIN/pddbdriver.f | 4 ++-- TESTING/LIN/pddtdriver.f | 4 ++-- TESTING/LIN/pdgbdriver.f | 4 ++-- TESTING/LIN/pdlltdriver.f | 4 ++-- TESTING/LIN/pdlsdriver.f | 4 ++-- TESTING/LIN/pdludriver.f | 4 ++-- TESTING/LIN/pdpbdriver.f | 4 ++-- TESTING/LIN/pdptdriver.f | 4 ++-- TESTING/LIN/psdbdriver.f | 4 ++-- TESTING/LIN/psdtdriver.f | 4 ++-- TESTING/LIN/psgbdriver.f | 4 ++-- TESTING/LIN/pslltdriver.f | 4 ++-- TESTING/LIN/pslsdriver.f | 4 ++-- TESTING/LIN/psludriver.f | 4 ++-- TESTING/LIN/pspbdriver.f | 4 ++-- TESTING/LIN/psptdriver.f | 4 ++-- TESTING/LIN/pzdbdriver.f | 4 ++-- TESTING/LIN/pzdtdriver.f | 4 ++-- TESTING/LIN/pzgbdriver.f | 4 ++-- TESTING/LIN/pzlltdriver.f | 4 ++-- TESTING/LIN/pzlsdriver.f | 4 ++-- TESTING/LIN/pzludriver.f | 4 ++-- TESTING/LIN/pzpbdriver.f | 4 ++-- TESTING/LIN/pzptdriver.f | 8 ++++---- TOOLS/pclaprnt.f | 8 ++++---- TOOLS/pclaread.f | 4 ++-- TOOLS/pclawrite.f | 8 ++++---- TOOLS/pdlaprnt.f | 8 ++++---- TOOLS/pdlaread.f | 4 ++-- TOOLS/pdlawrite.f | 8 ++++---- TOOLS/pilaprnt.f | 8 ++++---- TOOLS/pslaprnt.f | 8 ++++---- TOOLS/pslaread.f | 4 ++-- TOOLS/pslawrite.f | 8 ++++---- TOOLS/pzlaprnt.f | 8 ++++---- TOOLS/pzlaread.f | 4 ++-- TOOLS/pzlawrite.f | 8 ++++---- 50 files changed, 145 insertions(+), 145 deletions(-) diff --git a/PBLAS/TESTING/pcblastst.f b/PBLAS/TESTING/pcblastst.f index d17edbcc..dfb5ba72 100644 --- a/PBLAS/TESTING/pcblastst.f +++ b/PBLAS/TESTING/pcblastst.f @@ -3530,7 +3530,7 @@ SUBROUTINE PCCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN * - DO 40 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -3561,7 +3561,7 @@ SUBROUTINE PCCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 40 CONTINUE + 40 END DO * JJ = JJ + JB * @@ -3574,7 +3574,7 @@ SUBROUTINE PCCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) DO 90 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN - DO 80 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 )*DESCA( MB_ ) + IB @@ -3606,7 +3606,7 @@ SUBROUTINE PCCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 80 CONTINUE + 80 END DO * JJ = JJ + JB END IF @@ -9586,7 +9586,7 @@ SUBROUTINE PB_PCLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, $ JB = ( (-JB) / DESCA( NB_ ) + 1 ) * DESCA( NB_ ) + JB JB = MIN( JB, N ) JN = JA+JB-1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9656,7 +9656,7 @@ SUBROUTINE PB_PCLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -9668,7 +9668,7 @@ SUBROUTINE PB_PCLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ )-IA+1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9738,7 +9738,7 @@ SUBROUTINE PB_PCLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/PBLAS/TESTING/pdblastst.f b/PBLAS/TESTING/pdblastst.f index 818c4d5b..c2ce6830 100644 --- a/PBLAS/TESTING/pdblastst.f +++ b/PBLAS/TESTING/pdblastst.f @@ -3524,7 +3524,7 @@ SUBROUTINE PDCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN * - DO 40 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -3555,7 +3555,7 @@ SUBROUTINE PDCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 40 CONTINUE + 40 END DO * JJ = JJ + JB * @@ -3568,7 +3568,7 @@ SUBROUTINE PDCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) DO 90 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN - DO 80 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 )*DESCA( MB_ ) + IB @@ -3600,7 +3600,7 @@ SUBROUTINE PDCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 80 CONTINUE + 80 END DO * JJ = JJ + JB END IF @@ -8918,7 +8918,7 @@ SUBROUTINE PB_PDLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, $ JB = ( (-JB) / DESCA( NB_ ) + 1 ) * DESCA( NB_ ) + JB JB = MIN( JB, N ) JN = JA+JB-1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -8982,7 +8982,7 @@ SUBROUTINE PB_PDLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -8994,7 +8994,7 @@ SUBROUTINE PB_PDLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ )-IA+1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9058,7 +9058,7 @@ SUBROUTINE PB_PDLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/PBLAS/TESTING/psblastst.f b/PBLAS/TESTING/psblastst.f index c6a2f28e..e5410e22 100644 --- a/PBLAS/TESTING/psblastst.f +++ b/PBLAS/TESTING/psblastst.f @@ -3524,7 +3524,7 @@ SUBROUTINE PSCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN * - DO 40 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -3555,7 +3555,7 @@ SUBROUTINE PSCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 40 CONTINUE + 40 END DO * JJ = JJ + JB * @@ -3568,7 +3568,7 @@ SUBROUTINE PSCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) DO 90 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN - DO 80 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 )*DESCA( MB_ ) + IB @@ -3600,7 +3600,7 @@ SUBROUTINE PSCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 80 CONTINUE + 80 END DO * JJ = JJ + JB END IF @@ -8920,7 +8920,7 @@ SUBROUTINE PB_PSLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, $ JB = ( (-JB) / DESCA( NB_ ) + 1 ) * DESCA( NB_ ) + JB JB = MIN( JB, N ) JN = JA+JB-1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -8984,7 +8984,7 @@ SUBROUTINE PB_PSLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -8996,7 +8996,7 @@ SUBROUTINE PB_PSLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ )-IA+1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9060,7 +9060,7 @@ SUBROUTINE PB_PSLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/PBLAS/TESTING/pzblastst.f b/PBLAS/TESTING/pzblastst.f index f6142158..e07a09c4 100644 --- a/PBLAS/TESTING/pzblastst.f +++ b/PBLAS/TESTING/pzblastst.f @@ -3530,7 +3530,7 @@ SUBROUTINE PZCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN * - DO 40 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -3561,7 +3561,7 @@ SUBROUTINE PZCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 40 CONTINUE + 40 END DO * JJ = JJ + JB * @@ -3574,7 +3574,7 @@ SUBROUTINE PZCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) DO 90 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) IF( MYCOL.EQ.ICURCOL .OR. COLREP ) THEN - DO 80 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( ( -IB ) / DESCA( MB_ ) + 1 )*DESCA( MB_ ) + IB @@ -3606,7 +3606,7 @@ SUBROUTINE PZCHKMIN( ERRMAX, M, N, A, PA, IA, JA, DESCA, INFO ) * II = IIA ICURROW = IAROW - 80 CONTINUE + 80 END DO * JJ = JJ + JB END IF @@ -9588,7 +9588,7 @@ SUBROUTINE PB_PZLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, $ JB = ( (-JB) / DESCA( NB_ ) + 1 ) * DESCA( NB_ ) + JB JB = MIN( JB, N ) JN = JA+JB-1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ ) - IA + 1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9658,7 +9658,7 @@ SUBROUTINE PB_PZLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -9670,7 +9670,7 @@ SUBROUTINE PB_PZLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IB = DESCA( IMB_ )-IA+1 IF( IB.LE.0 ) $ IB = ( (-IB) / DESCA( MB_ ) + 1 ) * DESCA( MB_ ) + IB @@ -9740,7 +9740,7 @@ SUBROUTINE PB_PZLAPRN2( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/SRC/icopypv.f b/SRC/icopypv.f index 90923d75..1a18868d 100644 --- a/SRC/icopypv.f +++ b/SRC/icopypv.f @@ -75,7 +75,7 @@ SUBROUTINE ICOPYPV( M, N, A, IA, JA, DESCA, TPIV, IPIV, INFO ) * .. Parameters .. INTEGER I, IACOL, IAROW, ICTXT, $ J, MN, MYCOL, MYROW, NPCOL, NPROW - PARAMETER ( CTXT_ = 2 ) + INTEGER,PARAMETER :: CTXT_ = 2 * .. * .. External Subroutines .. EXTERNAL BLACS_ABORT, BLACS_GRIDINFO, CHK1MAT, IGEBR2D, diff --git a/TESTING/LIN/pcdbdriver.f b/TESTING/LIN/pcdbdriver.f index fde3186f..168d634f 100644 --- a/TESTING/LIN/pcdbdriver.f +++ b/TESTING/LIN/pcdbdriver.f @@ -541,7 +541,7 @@ PROGRAM PCDBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -865,7 +865,7 @@ PROGRAM PCDBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pcdtdriver.f b/TESTING/LIN/pcdtdriver.f index 8bdb88eb..80d3ee65 100644 --- a/TESTING/LIN/pcdtdriver.f +++ b/TESTING/LIN/pcdtdriver.f @@ -538,7 +538,7 @@ PROGRAM PCDTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -870,7 +870,7 @@ PROGRAM PCDTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pcgbdriver.f b/TESTING/LIN/pcgbdriver.f index 74845fb5..aba51f37 100644 --- a/TESTING/LIN/pcgbdriver.f +++ b/TESTING/LIN/pcgbdriver.f @@ -555,7 +555,7 @@ PROGRAM PCGBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -879,7 +879,7 @@ PROGRAM PCGBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pclltdriver.f b/TESTING/LIN/pclltdriver.f index 3774949b..91bf0fc0 100644 --- a/TESTING/LIN/pclltdriver.f +++ b/TESTING/LIN/pclltdriver.f @@ -480,7 +480,7 @@ PROGRAM PCLLTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -836,7 +836,7 @@ PROGRAM PCLLTDRIVER * END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK .AND. SRESID.GT.THRESH ) THEN * diff --git a/TESTING/LIN/pclsdriver.f b/TESTING/LIN/pclsdriver.f index 9723b5db..f84d045f 100644 --- a/TESTING/LIN/pclsdriver.f +++ b/TESTING/LIN/pclsdriver.f @@ -366,7 +366,7 @@ PROGRAM PCLSDRIVER * * Loop over the different values for NRHS * - DO 40 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -1030,7 +1030,7 @@ PROGRAM PCLSDRIVER $ TMFLOPS, PASSED END IF 30 CONTINUE - 40 CONTINUE + 40 END DO 50 CONTINUE 60 CONTINUE 70 CONTINUE diff --git a/TESTING/LIN/pcludriver.f b/TESTING/LIN/pcludriver.f index 7924d40e..c4382411 100644 --- a/TESTING/LIN/pcludriver.f +++ b/TESTING/LIN/pcludriver.f @@ -601,7 +601,7 @@ PROGRAM PCLUDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -977,7 +977,7 @@ PROGRAM PCLUDRIVER $ PASSED END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK.AND.( SRESID.GT.THRESH ) ) THEN * diff --git a/TESTING/LIN/pcpbdriver.f b/TESTING/LIN/pcpbdriver.f index e3d4c187..bb3945b6 100644 --- a/TESTING/LIN/pcpbdriver.f +++ b/TESTING/LIN/pcpbdriver.f @@ -524,7 +524,7 @@ PROGRAM PCPBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -827,7 +827,7 @@ PROGRAM PCPBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pcptdriver.f b/TESTING/LIN/pcptdriver.f index a431f383..aa189b2d 100644 --- a/TESTING/LIN/pcptdriver.f +++ b/TESTING/LIN/pcptdriver.f @@ -498,10 +498,10 @@ PROGRAM PCPTDRIVER * For SPD Tridiagonal complex matrices, diagonal is stored * as a real. Thus, compact D into half the space * - DO 10 H=1, NUMROC(N,NB,MYCOL,0,NPCOL)/2 + DO H=1, NUMROC(N,NB,MYCOL,0,NPCOL)/2 MEM( IPA+INT_TEMP+H-1 ) = MEM( IPA+INT_TEMP+2*H-2 ) $ +MEM( IPA+INT_TEMP+2*H-1 )*( 0.0E+0, 1.0E+0 ) - 10 CONTINUE + 10 END DO IF( 2*(NUMROC(N,NB,MYCOL,0,NPCOL)/2).NE. $ NUMROC(N,NB,MYCOL,0,NPCOL) ) THEN H=NUMROC(N,NB,MYCOL,0,NPCOL)/2+1 @@ -543,7 +543,7 @@ PROGRAM PCPTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -853,7 +853,7 @@ PROGRAM PCPTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pddbdriver.f b/TESTING/LIN/pddbdriver.f index 58ee82de..c26f4bfa 100644 --- a/TESTING/LIN/pddbdriver.f +++ b/TESTING/LIN/pddbdriver.f @@ -539,7 +539,7 @@ PROGRAM PDDBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -855,7 +855,7 @@ PROGRAM PDDBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pddtdriver.f b/TESTING/LIN/pddtdriver.f index c3933104..373a7747 100644 --- a/TESTING/LIN/pddtdriver.f +++ b/TESTING/LIN/pddtdriver.f @@ -537,7 +537,7 @@ PROGRAM PDDTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -861,7 +861,7 @@ PROGRAM PDDTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pdgbdriver.f b/TESTING/LIN/pdgbdriver.f index 4106280c..0f15dfb6 100644 --- a/TESTING/LIN/pdgbdriver.f +++ b/TESTING/LIN/pdgbdriver.f @@ -553,7 +553,7 @@ PROGRAM PDGBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -869,7 +869,7 @@ PROGRAM PDGBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pdlltdriver.f b/TESTING/LIN/pdlltdriver.f index c496d77e..e3168791 100644 --- a/TESTING/LIN/pdlltdriver.f +++ b/TESTING/LIN/pdlltdriver.f @@ -483,7 +483,7 @@ PROGRAM PDLLTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -839,7 +839,7 @@ PROGRAM PDLLTDRIVER * END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK .AND. SRESID.GT.THRESH ) THEN * diff --git a/TESTING/LIN/pdlsdriver.f b/TESTING/LIN/pdlsdriver.f index d17d5959..c85cc030 100644 --- a/TESTING/LIN/pdlsdriver.f +++ b/TESTING/LIN/pdlsdriver.f @@ -365,7 +365,7 @@ PROGRAM PDLSDRIVER * * Loop over the different values for NRHS * - DO 40 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -1027,7 +1027,7 @@ PROGRAM PDLSDRIVER $ TMFLOPS, PASSED END IF 30 CONTINUE - 40 CONTINUE + 40 END DO 50 CONTINUE 60 CONTINUE 70 CONTINUE diff --git a/TESTING/LIN/pdludriver.f b/TESTING/LIN/pdludriver.f index 2ac9bcbb..a6aa5ef2 100644 --- a/TESTING/LIN/pdludriver.f +++ b/TESTING/LIN/pdludriver.f @@ -610,7 +610,7 @@ PROGRAM PDLUDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -986,7 +986,7 @@ PROGRAM PDLUDRIVER $ PASSED END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK.AND.( SRESID.GT.THRESH ) ) THEN * diff --git a/TESTING/LIN/pdpbdriver.f b/TESTING/LIN/pdpbdriver.f index 9a0ab4f8..5603db72 100644 --- a/TESTING/LIN/pdpbdriver.f +++ b/TESTING/LIN/pdpbdriver.f @@ -523,7 +523,7 @@ PROGRAM PDPBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -822,7 +822,7 @@ PROGRAM PDPBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pdptdriver.f b/TESTING/LIN/pdptdriver.f index 5beb6475..0ba405d1 100644 --- a/TESTING/LIN/pdptdriver.f +++ b/TESTING/LIN/pdptdriver.f @@ -528,7 +528,7 @@ PROGRAM PDPTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -834,7 +834,7 @@ PROGRAM PDPTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/psdbdriver.f b/TESTING/LIN/psdbdriver.f index 13a303bf..535ae695 100644 --- a/TESTING/LIN/psdbdriver.f +++ b/TESTING/LIN/psdbdriver.f @@ -538,7 +538,7 @@ PROGRAM PSDBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -854,7 +854,7 @@ PROGRAM PSDBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/psdtdriver.f b/TESTING/LIN/psdtdriver.f index c7a01f5f..1f4599d0 100644 --- a/TESTING/LIN/psdtdriver.f +++ b/TESTING/LIN/psdtdriver.f @@ -536,7 +536,7 @@ PROGRAM PSDTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -860,7 +860,7 @@ PROGRAM PSDTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/psgbdriver.f b/TESTING/LIN/psgbdriver.f index 24e641e2..ae1fe316 100644 --- a/TESTING/LIN/psgbdriver.f +++ b/TESTING/LIN/psgbdriver.f @@ -552,7 +552,7 @@ PROGRAM PSGBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -868,7 +868,7 @@ PROGRAM PSGBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pslltdriver.f b/TESTING/LIN/pslltdriver.f index b28314a2..ced011bb 100644 --- a/TESTING/LIN/pslltdriver.f +++ b/TESTING/LIN/pslltdriver.f @@ -483,7 +483,7 @@ PROGRAM PSLLTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -839,7 +839,7 @@ PROGRAM PSLLTDRIVER * END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK .AND. SRESID.GT.THRESH ) THEN * diff --git a/TESTING/LIN/pslsdriver.f b/TESTING/LIN/pslsdriver.f index 81ed67f4..07e6acbe 100644 --- a/TESTING/LIN/pslsdriver.f +++ b/TESTING/LIN/pslsdriver.f @@ -364,7 +364,7 @@ PROGRAM PSLSDRIVER * * Loop over the different values for NRHS * - DO 40 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -1026,7 +1026,7 @@ PROGRAM PSLSDRIVER $ TMFLOPS, PASSED END IF 30 CONTINUE - 40 CONTINUE + 40 END DO 50 CONTINUE 60 CONTINUE 70 CONTINUE diff --git a/TESTING/LIN/psludriver.f b/TESTING/LIN/psludriver.f index 1ce446f6..1a149e49 100644 --- a/TESTING/LIN/psludriver.f +++ b/TESTING/LIN/psludriver.f @@ -600,7 +600,7 @@ PROGRAM PSLUDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -976,7 +976,7 @@ PROGRAM PSLUDRIVER $ PASSED END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK.AND.( SRESID.GT.THRESH ) ) THEN * diff --git a/TESTING/LIN/pspbdriver.f b/TESTING/LIN/pspbdriver.f index 61dddafb..1b3e6e28 100644 --- a/TESTING/LIN/pspbdriver.f +++ b/TESTING/LIN/pspbdriver.f @@ -522,7 +522,7 @@ PROGRAM PSPBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -821,7 +821,7 @@ PROGRAM PSPBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/psptdriver.f b/TESTING/LIN/psptdriver.f index 24f9f396..ce76f86d 100644 --- a/TESTING/LIN/psptdriver.f +++ b/TESTING/LIN/psptdriver.f @@ -527,7 +527,7 @@ PROGRAM PSPTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -833,7 +833,7 @@ PROGRAM PSPTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pzdbdriver.f b/TESTING/LIN/pzdbdriver.f index ff06a9c3..5edf9962 100644 --- a/TESTING/LIN/pzdbdriver.f +++ b/TESTING/LIN/pzdbdriver.f @@ -541,7 +541,7 @@ PROGRAM PZDBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -865,7 +865,7 @@ PROGRAM PZDBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pzdtdriver.f b/TESTING/LIN/pzdtdriver.f index a407e375..2e841de1 100644 --- a/TESTING/LIN/pzdtdriver.f +++ b/TESTING/LIN/pzdtdriver.f @@ -539,7 +539,7 @@ PROGRAM PZDTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -871,7 +871,7 @@ PROGRAM PZDTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pzgbdriver.f b/TESTING/LIN/pzgbdriver.f index 490ed6f6..108ef5a3 100644 --- a/TESTING/LIN/pzgbdriver.f +++ b/TESTING/LIN/pzgbdriver.f @@ -555,7 +555,7 @@ PROGRAM PZGBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -879,7 +879,7 @@ PROGRAM PZGBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pzlltdriver.f b/TESTING/LIN/pzlltdriver.f index db162cf1..b14f5e2e 100644 --- a/TESTING/LIN/pzlltdriver.f +++ b/TESTING/LIN/pzlltdriver.f @@ -479,7 +479,7 @@ PROGRAM PZLLTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -835,7 +835,7 @@ PROGRAM PZLLTDRIVER * END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK .AND. SRESID.GT.THRESH ) THEN * diff --git a/TESTING/LIN/pzlsdriver.f b/TESTING/LIN/pzlsdriver.f index 09d12eb6..6193ac72 100644 --- a/TESTING/LIN/pzlsdriver.f +++ b/TESTING/LIN/pzlsdriver.f @@ -366,7 +366,7 @@ PROGRAM PZLSDRIVER * * Loop over the different values for NRHS * - DO 40 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -1030,7 +1030,7 @@ PROGRAM PZLSDRIVER $ TMFLOPS, PASSED END IF 30 CONTINUE - 40 CONTINUE + 40 END DO 50 CONTINUE 60 CONTINUE 70 CONTINUE diff --git a/TESTING/LIN/pzludriver.f b/TESTING/LIN/pzludriver.f index 14a39ce2..486fb0be 100644 --- a/TESTING/LIN/pzludriver.f +++ b/TESTING/LIN/pzludriver.f @@ -605,7 +605,7 @@ PROGRAM PZLUDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * NRHS = NRVAL( HH ) * @@ -981,7 +981,7 @@ PROGRAM PZLUDRIVER $ PASSED END IF 10 CONTINUE - 20 CONTINUE + 20 END DO * IF( CHECK.AND.( SRESID.GT.THRESH ) ) THEN * diff --git a/TESTING/LIN/pzpbdriver.f b/TESTING/LIN/pzpbdriver.f index 02454013..a7f84bb5 100644 --- a/TESTING/LIN/pzpbdriver.f +++ b/TESTING/LIN/pzpbdriver.f @@ -525,7 +525,7 @@ PROGRAM PZPBDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -828,7 +828,7 @@ PROGRAM PZPBDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TESTING/LIN/pzptdriver.f b/TESTING/LIN/pzptdriver.f index 3a0873f0..49a01706 100644 --- a/TESTING/LIN/pzptdriver.f +++ b/TESTING/LIN/pzptdriver.f @@ -498,10 +498,10 @@ PROGRAM PZPTDRIVER * For SPD Tridiagonal complex matrices, diagonal is stored * as a real. Thus, compact D into half the space * - DO 10 H=1, NUMROC(N,NB,MYCOL,0,NPCOL)/2 + DO H=1, NUMROC(N,NB,MYCOL,0,NPCOL)/2 MEM( IPA+INT_TEMP+H-1 ) = MEM( IPA+INT_TEMP+2*H-2 ) $ +MEM( IPA+INT_TEMP+2*H-1 )*( 0.0D+0, 1.0D+0 ) - 10 CONTINUE + 10 END DO IF( 2*(NUMROC(N,NB,MYCOL,0,NPCOL)/2).NE. $ NUMROC(N,NB,MYCOL,0,NPCOL) ) THEN H=NUMROC(N,NB,MYCOL,0,NPCOL)/2+1 @@ -543,7 +543,7 @@ PROGRAM PZPTDRIVER * * Loop over the different values for NRHS * - DO 20 HH = 1, NNR + DO HH = 1, NNR * IERR( 1 ) = 0 * @@ -853,7 +853,7 @@ PROGRAM PZPTDRIVER $ TMFLOPS2, PASSED * END IF - 20 CONTINUE + 20 END DO * * 30 CONTINUE diff --git a/TOOLS/pclaprnt.f b/TOOLS/pclaprnt.f index 22453eb2..672f5f52 100644 --- a/TOOLS/pclaprnt.f +++ b/TOOLS/pclaprnt.f @@ -162,7 +162,7 @@ SUBROUTINE PCLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -228,7 +228,7 @@ SUBROUTINE PCLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -239,7 +239,7 @@ SUBROUTINE PCLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -305,7 +305,7 @@ SUBROUTINE PCLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pclaread.f b/TOOLS/pclaread.f index c18b6bee..bfeaadc1 100644 --- a/TOOLS/pclaread.f +++ b/TOOLS/pclaread.f @@ -95,7 +95,7 @@ SUBROUTINE PCLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * DO 50 J = 1, N, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), N-J+1 ) - DO 40 H = 0, JB-1 + DO H = 0, JB-1 * * Loop over block of rows * @@ -128,7 +128,7 @@ SUBROUTINE PCLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * II = 1 ICURROW = DESCA( RSRC_ ) - 40 CONTINUE + 40 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pclawrite.f b/TOOLS/pclawrite.f index 7b3b5e74..5f0aa132 100644 --- a/TOOLS/pclawrite.f +++ b/TOOLS/pclawrite.f @@ -77,7 +77,7 @@ SUBROUTINE PCLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -137,7 +137,7 @@ SUBROUTINE PCLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -148,7 +148,7 @@ SUBROUTINE PCLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -210,7 +210,7 @@ SUBROUTINE PCLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pdlaprnt.f b/TOOLS/pdlaprnt.f index c613422a..d12106da 100644 --- a/TOOLS/pdlaprnt.f +++ b/TOOLS/pdlaprnt.f @@ -162,7 +162,7 @@ SUBROUTINE PDLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -222,7 +222,7 @@ SUBROUTINE PDLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -233,7 +233,7 @@ SUBROUTINE PDLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -293,7 +293,7 @@ SUBROUTINE PDLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pdlaread.f b/TOOLS/pdlaread.f index 8ec8a5ac..aede6b00 100644 --- a/TOOLS/pdlaread.f +++ b/TOOLS/pdlaread.f @@ -94,7 +94,7 @@ SUBROUTINE PDLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * DO 50 J = 1, N, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), N-J+1 ) - DO 40 H = 0, JB-1 + DO H = 0, JB-1 * * Loop over block of rows * @@ -125,7 +125,7 @@ SUBROUTINE PDLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * II = 1 ICURROW = DESCA( RSRC_ ) - 40 CONTINUE + 40 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pdlawrite.f b/TOOLS/pdlawrite.f index 631b0bf7..e62370c4 100644 --- a/TOOLS/pdlawrite.f +++ b/TOOLS/pdlawrite.f @@ -77,7 +77,7 @@ SUBROUTINE PDLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -133,7 +133,7 @@ SUBROUTINE PDLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -144,7 +144,7 @@ SUBROUTINE PDLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -200,7 +200,7 @@ SUBROUTINE PDLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pilaprnt.f b/TOOLS/pilaprnt.f index 41a5170f..0741e57f 100644 --- a/TOOLS/pilaprnt.f +++ b/TOOLS/pilaprnt.f @@ -162,7 +162,7 @@ SUBROUTINE PILAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -222,7 +222,7 @@ SUBROUTINE PILAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -233,7 +233,7 @@ SUBROUTINE PILAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -293,7 +293,7 @@ SUBROUTINE PILAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pslaprnt.f b/TOOLS/pslaprnt.f index bd48f32c..446292e5 100644 --- a/TOOLS/pslaprnt.f +++ b/TOOLS/pslaprnt.f @@ -162,7 +162,7 @@ SUBROUTINE PSLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -222,7 +222,7 @@ SUBROUTINE PSLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -233,7 +233,7 @@ SUBROUTINE PSLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -293,7 +293,7 @@ SUBROUTINE PSLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pslaread.f b/TOOLS/pslaread.f index 68946b13..bc3f089b 100644 --- a/TOOLS/pslaread.f +++ b/TOOLS/pslaread.f @@ -94,7 +94,7 @@ SUBROUTINE PSLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * DO 50 J = 1, N, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), N-J+1 ) - DO 40 H = 0, JB-1 + DO H = 0, JB-1 * * Loop over block of rows * @@ -125,7 +125,7 @@ SUBROUTINE PSLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * II = 1 ICURROW = DESCA( RSRC_ ) - 40 CONTINUE + 40 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pslawrite.f b/TOOLS/pslawrite.f index 2daafb9f..4a5172b1 100644 --- a/TOOLS/pslawrite.f +++ b/TOOLS/pslawrite.f @@ -77,7 +77,7 @@ SUBROUTINE PSLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -133,7 +133,7 @@ SUBROUTINE PSLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -144,7 +144,7 @@ SUBROUTINE PSLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -200,7 +200,7 @@ SUBROUTINE PSLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pzlaprnt.f b/TOOLS/pzlaprnt.f index 71d42868..fa4a9de9 100644 --- a/TOOLS/pzlaprnt.f +++ b/TOOLS/pzlaprnt.f @@ -162,7 +162,7 @@ SUBROUTINE PZLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -228,7 +228,7 @@ SUBROUTINE PZLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -239,7 +239,7 @@ SUBROUTINE PZLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRPRNT .AND. ICURCOL.EQ.ICPRNT ) THEN @@ -305,7 +305,7 @@ SUBROUTINE PZLAPRNT( M, N, A, IA, JA, DESCA, IRPRNT, ICPRNT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pzlaread.f b/TOOLS/pzlaread.f index 0a8134f7..184ca415 100644 --- a/TOOLS/pzlaread.f +++ b/TOOLS/pzlaread.f @@ -95,7 +95,7 @@ SUBROUTINE PZLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * DO 50 J = 1, N, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), N-J+1 ) - DO 40 H = 0, JB-1 + DO H = 0, JB-1 * * Loop over block of rows * @@ -128,7 +128,7 @@ SUBROUTINE PZLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK ) * II = 1 ICURROW = DESCA( RSRC_ ) - 40 CONTINUE + 40 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB diff --git a/TOOLS/pzlawrite.f b/TOOLS/pzlawrite.f index 2b3dc516..bfcc7513 100644 --- a/TOOLS/pzlawrite.f +++ b/TOOLS/pzlawrite.f @@ -77,7 +77,7 @@ SUBROUTINE PZLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) JB = JN-JA+1 - DO 60 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -137,7 +137,7 @@ SUBROUTINE PZLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 60 CONTINUE + 60 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB @@ -148,7 +148,7 @@ SUBROUTINE PZLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * DO 130 J = JN+1, JA+N-1, DESCA( NB_ ) JB = MIN( DESCA( NB_ ), JA+N-J ) - DO 120 H = 0, JB-1 + DO H = 0, JB-1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) IB = IN-IA+1 IF( ICURROW.EQ.IRWRIT .AND. ICURCOL.EQ.ICWRIT ) THEN @@ -210,7 +210,7 @@ SUBROUTINE PZLAWRITE( FILNAM, M, N, A, IA, JA, DESCA, IRWRIT, * II = IIA ICURROW = IAROW - 120 CONTINUE + 120 END DO * IF( MYCOL.EQ.ICURCOL ) $ JJ = JJ + JB From 1d7f504251b750bc7c467da1fe1d9ffb2aba9c43 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Sun, 29 Oct 2023 18:36:13 +0530 Subject: [PATCH 23/29] Trace and Logging feature enabled for 45 'double precision complex' data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: I108e21a25888e1a67b6f786e4db7767ae0831187 --- SRC/pzpbsv.f | 45 +++++++++++++++++++++++++++++++ SRC/pzpbtrf.f | 65 +++++++++++++++++++++++++++++++++++++++++++-- SRC/pzpbtrs.f | 72 ++++++++++++++++++++++++++++++++++++++++++++++---- SRC/pzpbtrsv.f | 71 ++++++++++++++++++++++++++++++++++++++++++++++--- SRC/pzpocon.f | 57 +++++++++++++++++++++++++++++++++++++++ SRC/pzpoequ.f | 46 ++++++++++++++++++++++++++++++++ SRC/pzporfs.f | 51 +++++++++++++++++++++++++++++++++++ SRC/pzposv.f | 40 ++++++++++++++++++++++++++++ SRC/pzposvx.f | 57 +++++++++++++++++++++++++++++++++++++++ SRC/pzpotf2.f | 51 ++++++++++++++++++++++++++++++++--- SRC/pzpotrf.f | 51 ++++++++++++++++++++++++++++++++--- SRC/pzpotri.f | 56 ++++++++++++++++++++++++++++++++++++--- SRC/pzpotrs.f | 49 ++++++++++++++++++++++++++++++++-- SRC/pzptsv.f | 45 +++++++++++++++++++++++++++++++ SRC/pzpttrf.f | 63 +++++++++++++++++++++++++++++++++++++++++-- SRC/pzpttrs.f | 72 ++++++++++++++++++++++++++++++++++++++++++++++---- SRC/pzpttrsv.f | 70 +++++++++++++++++++++++++++++++++++++++++++++--- SRC/pztrcon.f | 49 ++++++++++++++++++++++++++++++++++ SRC/pztrevc.f | 54 ++++++++++++++++++++++++++++++++++--- SRC/pztrrfs.f | 51 +++++++++++++++++++++++++++++++++++ SRC/pztrti2.f | 38 ++++++++++++++++++++++++++ SRC/pztrtri.f | 56 ++++++++++++++++++++++++++++++++++++--- SRC/pztrtrs.f | 59 ++++++++++++++++++++++++++++++++++++++--- SRC/pztzrzf.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzung2l.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzung2r.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzungl2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzunglq.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzungql.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzungqr.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzungr2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzungrq.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzunm2l.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunm2r.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmbr.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmhr.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunml2.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmlq.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmql.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmqr.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmr2.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmr3.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmrq.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmrz.f | 54 +++++++++++++++++++++++++++++++++++-- SRC/pzunmtr.f | 54 +++++++++++++++++++++++++++++++++++-- 45 files changed, 2339 insertions(+), 90 deletions(-) diff --git a/SRC/pzpbsv.f b/SRC/pzpbsv.f index b8768b50..5277bc2f 100644 --- a/SRC/pzpbsv.f +++ b/SRC/pzpbsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, IB, INFO, JA, LWORK, N, NRHS @@ -387,6 +394,28 @@ SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PZPBSV inputs: ,UPLO:',A5,', BW:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PZPBTRF and PZPBTRS. @@ -408,6 +437,10 @@ SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -430,6 +463,10 @@ SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PZPBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -443,9 +480,17 @@ SUBROUTINE PZPBSV( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPBSV diff --git a/SRC/pzpbtrf.f b/SRC/pzpbtrf.f index aaf34e17..7e2a44d0 100644 --- a/SRC/pzpbtrf.f +++ b/SRC/pzpbtrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, INFO, JA, LAF, LWORK, N @@ -394,6 +401,16 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -425,6 +442,21 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, MBW2 = BW * BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZPBTRF inputs: ,UPLO:',A5,', BW:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -477,6 +509,10 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZPBTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -485,6 +521,10 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZPBTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -500,6 +540,10 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZPBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -516,6 +560,10 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, $ 'PZPBTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -571,13 +619,22 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1500,6 +1557,10 @@ SUBROUTINE PZPBTRF( UPLO, N, BW, A, JA, DESCA, AF, LAF, WORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPBTRF diff --git a/SRC/pzpbtrs.f b/SRC/pzpbtrs.f index c5b9a7ad..d949c1ae 100644 --- a/SRC/pzpbtrs.f +++ b/SRC/pzpbtrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, $ AF, LAF, WORK, LWORK, INFO ) * @@ -6,8 +12,9 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 7, 2001 +* August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER BW, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -404,6 +411,16 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -461,6 +478,21 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, BW, IB, INFO, JA, LAF, + $ LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZPBTRS inputs: ,UPLO:',A5,', BW:',I9, + $ ', IB:',I9,', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -531,6 +563,10 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPBTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -539,6 +575,10 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPBTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -555,6 +595,10 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, $ 'PZPBTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -624,16 +668,30 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -746,6 +804,10 @@ SUBROUTINE PZPBTRS( UPLO, N, BW, NRHS, A, JA, DESCA, B, IB, DESCB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPBTRS diff --git a/SRC/pzpbtrsv.f b/SRC/pzpbtrsv.f index 33d87663..69a55adc 100644 --- a/SRC/pzpbtrsv.f +++ b/SRC/pzpbtrsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, $ IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER BW, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -411,6 +418,16 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -472,6 +489,22 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, MBW2 = BW * BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, BW, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZPBTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', BW:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', LAF:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -550,6 +583,10 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, CALL PXERBLA( ICTXT, $ 'PZPBTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -558,6 +595,10 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, CALL PXERBLA( ICTXT, $ 'PZPBTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -574,6 +615,10 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, $ 'PZPBTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -645,16 +690,30 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPBTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1555,6 +1614,10 @@ SUBROUTINE PZPBTRSV( UPLO, TRANS, N, BW, NRHS, A, JA, DESCA, B, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPBTRSV diff --git a/SRC/pzpocon.f b/SRC/pzpocon.f index 0225d904..e80fc328 100644 --- a/SRC/pzpocon.f +++ b/SRC/pzpocon.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LRWORK, LWORK, N @@ -212,11 +219,37 @@ SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LRWORK, + $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZPOCON inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9,', ANORM:',F9.4, + $ ', RCOND:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -279,8 +312,16 @@ SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOCON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -289,11 +330,23 @@ SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, RCOND = ZERO IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( ANORM.EQ.ZERO ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( N.EQ.1 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -406,6 +459,10 @@ SUBROUTINE PZPOCON( UPLO, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOCON diff --git a/SRC/pzpoequ.f b/SRC/pzpoequ.f index a802989a..4c177f75 100644 --- a/SRC/pzpoequ.f +++ b/SRC/pzpoequ.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, N DOUBLE PRECISION AMAX, SCOND @@ -181,11 +188,34 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, N, AMAX, SCOND, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZPOEQU inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', N:',I9,', AMAX:',F9.4, + $ ', SCOND:',F9.4,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -199,6 +229,10 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOEQU', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -207,6 +241,10 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, IF( N.EQ.0 ) THEN SCOND = ONE AMAX = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -330,6 +368,10 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * CALL IGAMN2D( ICTXT, 'All', ALLCTOP, 1, 1, INFO, 1, II, JJ, -1, $ -1, MYCOL ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * ELSE @@ -351,6 +393,10 @@ SUBROUTINE PZPOEQU( N, A, IA, JA, DESCA, SR, SC, SCOND, AMAX, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOEQU diff --git a/SRC/pzporfs.f b/SRC/pzporfs.f index ec756d7f..5be9e4d5 100644 --- a/SRC/pzporfs.f +++ b/SRC/pzporfs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, $ DESCAF, B, IB, JB, DESCB, X, IX, JX, DESCX, $ FERR, BERR, WORK, LWORK, RWORK, LRWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, @@ -306,6 +313,16 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * .. Initialize EST EST = (0.0, 0.0) * @@ -314,6 +331,24 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IAF, IB, INFO, IX, + $ JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZPORFS inputs: ,UPLO:',A5,', IA:',I9, + $ ', IAF:',I9,', IB:',I9,', INFO:',I9, + $ ', IX:',I9,', JA:',I9,', JAF:',I9,', JB:',I9, + $ ', JX:',I9,', LRWORK:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -430,8 +465,16 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPORFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -446,6 +489,10 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -865,6 +912,10 @@ SUBROUTINE PZPORFS( UPLO, N, NRHS, A, IA, JA, DESCA, AF, IAF, JAF, WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) RWORK( 1 ) = DBLE( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPORFS diff --git a/SRC/pzposv.f b/SRC/pzposv.f index 9a423fd6..358eb08a 100644 --- a/SRC/pzposv.f +++ b/SRC/pzposv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -192,11 +199,36 @@ SUBROUTINE PZPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZPOSV inputs: ,UPLO:',A5,', IA:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', JB:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -239,6 +271,10 @@ SUBROUTINE PZPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -256,6 +292,10 @@ SUBROUTINE PZPOSV( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOSV diff --git a/SRC/pzposvx.f b/SRC/pzposvx.f index 7616ffb7..f90a4890 100644 --- a/SRC/pzposvx.f +++ b/SRC/pzposvx.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, $ IAF, JAF, DESCAF, EQUED, SR, SC, B, IB, JB, $ DESCB, X, IX, JX, DESCX, RCOND, FERR, BERR, @@ -8,6 +14,7 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, FACT, UPLO INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, LRWORK, @@ -388,11 +395,41 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, FACT, UPLO, IA, IAF, + $ IB, INFO, IX, JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, + $ RCOND, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZPOSVX inputs: ,EQUED:',A5,', FACT:',A5, + $ ', UPLO:',A5,', IA:',I9,', IAF:',I9, + $ ', IB:',I9,', INFO:',I9,', IX:',I9, + $ ', JA:',I9,', JAF:',I9,', JB:',I9, + $ ', JX:',I9,', LRWORK:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9,', RCOND:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -545,8 +582,16 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOSVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -600,6 +645,10 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, IF( INFO.NE.0 ) THEN IF( INFO.GT.0 ) $ RCOND = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF END IF @@ -617,6 +666,10 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * IF( RCOND.LT.PDLAMCH( ICTXT, 'Epsilon' ) ) THEN INFO = IA + N +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -660,6 +713,10 @@ SUBROUTINE PZPOSVX( FACT, UPLO, N, NRHS, A, IA, JA, DESCA, AF, * WORK( 1 ) = DBLE( LWMIN ) RWORK( 1 ) = DBLE( LRWMIN ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOSVX diff --git a/SRC/pzpotf2.f b/SRC/pzpotf2.f index d96125e2..b1b98859 100644 --- a/SRC/pzpotf2.f +++ b/SRC/pzpotf2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -173,11 +180,34 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZPOTF2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -206,13 +236,22 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOTF2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -239,7 +278,7 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * Compute U(J,J) and test for non-positive-definiteness. * #ifdef F2C - CALL ZDOTC( TMP, J-JA, A( IOFFA ), 1, + CALL ZDOTC( TMP, J-JA, A( IOFFA ), 1, $ A( IOFFA ), 1 ) AJJ = DBLE( A( IDIAG ) ) - TMP #else @@ -311,7 +350,7 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * Compute L(J,J) and test for non-positive-definiteness. * #ifdef F2C - CALL ZDOTC( TMP, J-JA, A( IOFFA ), LDA, + CALL ZDOTC( TMP, J-JA, A( IOFFA ), LDA, & A( IOFFA ), LDA ) AJJ = DBLE( A( IDIAG ) ) - TMP #else @@ -368,6 +407,10 @@ SUBROUTINE PZPOTF2( UPLO, N, A, IA, JA, DESCA, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOTF2 diff --git a/SRC/pzpotrf.f b/SRC/pzpotrf.f index 750fde3e..ab055e60 100644 --- a/SRC/pzpotrf.f +++ b/SRC/pzpotrf.f @@ -1,8 +1,13 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 20, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * @@ -13,6 +18,7 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -159,6 +165,9 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -194,6 +203,16 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * .. Executable Statements .. * * Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Initialize framework context structure if not initialized * CALL AOCL_SCALAPACK_INIT( ) * @@ -202,6 +221,19 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZPOTRF inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -235,13 +267,22 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * #ifdef AOCL_PROGRESS * Set the AOCL progress variables related to rank, processes @@ -421,6 +462,10 @@ SUBROUTINE PZPOTRF( UPLO, N, A, IA, JA, DESCA, INFO ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOTRF diff --git a/SRC/pzpotri.f b/SRC/pzpotri.f index 1d475fde..bd7213d2 100644 --- a/SRC/pzpotri.f +++ b/SRC/pzpotri.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, N @@ -145,11 +152,34 @@ SUBROUTINE PZPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZPOTRI inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -182,25 +212,43 @@ SUBROUTINE PZPOTRI( UPLO, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOTRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Invert the triangular Cholesky factor U or L. * CALL PZTRTRI( UPLO, 'Non-unit', N, A, IA, JA, DESCA, INFO ) * - IF( INFO.GT.0 ) - $ RETURN + IF( INFO.GT.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Form inv(U)*inv(U)' or inv(L)'*inv(L). * CALL PZLAUUM( UPLO, N, A, IA, JA, DESCA ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOTRI diff --git a/SRC/pzpotrs.f b/SRC/pzpotrs.f index b5b134fe..b092a789 100644 --- a/SRC/pzpotrs.f +++ b/SRC/pzpotrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -173,11 +180,36 @@ SUBROUTINE PZPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZPOTRS inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', INFO:',I9,', JA:',I9,', JB:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -221,13 +253,22 @@ SUBROUTINE PZPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPOTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( UPPER ) THEN * @@ -259,6 +300,10 @@ SUBROUTINE PZPOTRS( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ JB, DESCB ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPOTRS diff --git a/SRC/pzptsv.f b/SRC/pzptsv.f index 2d02a658..e70578b0 100644 --- a/SRC/pzptsv.f +++ b/SRC/pzptsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IB, INFO, JA, LWORK, N, NRHS @@ -393,6 +400,28 @@ SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PZPTSV inputs: ,UPLO:',A5,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PZPTTRF and PZPTTRS. @@ -417,6 +446,10 @@ SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPTSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -438,6 +471,10 @@ SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PZPTSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -451,9 +488,17 @@ SUBROUTINE PZPTSV( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZPTSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPTSV diff --git a/SRC/pzpttrf.f b/SRC/pzpttrf.f index 5b679cdd..a7141e86 100644 --- a/SRC/pzpttrf.f +++ b/SRC/pzpttrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, $ INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, JA, LAF, LWORK, N * .. @@ -392,6 +399,16 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -427,6 +444,19 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZPTTRF inputs: ,INFO:',I9,', JA:',I9, + $ ', LAF:',I9,', LWORK:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -458,6 +488,10 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZPTTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -466,6 +500,10 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZPTTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -481,6 +519,10 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZPTTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -497,6 +539,10 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, $ 'PZPTTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -548,13 +594,22 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPTTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1029,6 +1084,10 @@ SUBROUTINE PZPTTRF( N, D, E, JA, DESCA, AF, LAF, WORK, LWORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPTTRF diff --git a/SRC/pzpttrs.f b/SRC/pzpttrs.f index 7a4bb32c..a2b75d06 100644 --- a/SRC/pzpttrs.f +++ b/SRC/pzpttrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, $ AF, LAF, WORK, LWORK, INFO ) * @@ -6,8 +12,9 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 7, 2001 +* August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -416,6 +423,16 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -481,6 +498,21 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IB, INFO, JA, LAF, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZPTTRS inputs: ,UPLO:',A5,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -538,6 +570,10 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPTTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -546,6 +582,10 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZPTTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -562,6 +602,10 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, $ 'PZPTTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -629,16 +673,30 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPTTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -791,6 +849,10 @@ SUBROUTINE PZPTTRS( UPLO, N, NRHS, D, E, JA, DESCA, B, IB, DESCB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPTTRS diff --git a/SRC/pzpttrsv.f b/SRC/pzpttrsv.f index 71033565..56bca46e 100644 --- a/SRC/pzpttrsv.f +++ b/SRC/pzpttrsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -420,6 +427,16 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -485,6 +502,21 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, IB, INFO, JA, + $ LAF, LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZPTTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', IB:',I9,', INFO:',I9,', JA:',I9, + $ ', LAF:',I9,', LWORK:',I9,', N:',I9, + $ ', NRHS:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -550,6 +582,10 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZPTTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -558,6 +594,10 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZPTTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -574,6 +614,10 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, $ 'PZPTTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -643,16 +687,30 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZPTTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1501,6 +1559,10 @@ SUBROUTINE PZPTTRSV( UPLO, TRANS, N, NRHS, D, E, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZPTTRSV diff --git a/SRC/pztrcon.f b/SRC/pztrcon.f index 8f472e1c..8baf249a 100644 --- a/SRC/pztrcon.f +++ b/SRC/pztrcon.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, $ WORK, LWORK, RWORK, LRWORK, INFO ) * @@ -7,6 +13,7 @@ SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * May 25, 2001 * * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER IA, JA, INFO, LRWORK, LWORK, N @@ -225,11 +232,37 @@ SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, INFO, + $ LRWORK, LWORK, N, RCOND, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZTRCON inputs: ,DIAG:',A5,', NORM:',A5, + $ ', UPLO:',A5,', IA:',I9,', JA:',I9, + $ ', INFO:',I9,', LRWORK:',I9,', LWORK:',I9, + $ ', N:',I9,', RCOND:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -308,8 +341,16 @@ SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTRCON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -317,6 +358,10 @@ SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, * IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -424,6 +469,10 @@ SUBROUTINE PZTRCON( NORM, UPLO, DIAG, N, A, IA, JA, DESCA, RCOND, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZTRCON diff --git a/SRC/pztrevc.f b/SRC/pztrevc.f index 3b272868..3e7ad83c 100644 --- a/SRC/pztrevc.f +++ b/SRC/pztrevc.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, $ VR, DESCVR, MM, M, WORK, RWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER HOWMNY, SIDE INTEGER INFO, M, MM, N @@ -247,9 +254,37 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) HOWMNY, SIDE, INFO, M, MM, + $ N, eos_str + 102 FORMAT('PZTREVC inputs: ,HOWMNY:',A5,', SIDE:',A5, + $ ', INFO:',I9,', M:',I9,', MM:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CONTXT = DESCT( CTXT_ ) RSRC = DESCT( RSRC_ ) @@ -301,13 +336,22 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, $ -1, -1 ) IF( INFO.LT.0 ) THEN CALL PXERBLA( CONTXT, 'PZTREVC', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible. * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Set the constants to control overflow. * @@ -562,6 +606,10 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, 110 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZTREVC diff --git a/SRC/pztrrfs.f b/SRC/pztrrfs.f index bf2c1a73..fc381392 100644 --- a/SRC/pztrrfs.f +++ b/SRC/pztrrfs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, $ B, IB, JB, DESCB, X, IX, JX, DESCX, FERR, $ BERR, WORK, LWORK, RWORK, LRWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, TRANS, UPLO INTEGER INFO, IA, IB, IX, JA, JB, JX, LRWORK, LWORK, @@ -291,11 +298,39 @@ SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, INFO, IA, + $ IB, IX, JA, JB, JX, LRWORK, LWORK, + $ N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZTRRFS inputs: ,DIAG:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', INFO:',I9,', IA:',I9, + $ ', IB:',I9,', IX:',I9,', JA:',I9, + $ ', JB:',I9,', JX:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -410,8 +445,16 @@ SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTRRFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -426,6 +469,10 @@ SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -799,6 +846,10 @@ SUBROUTINE PZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) RWORK( 1 ) = DBLE( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZTRRFS diff --git a/SRC/pztrti2.f b/SRC/pztrti2.f index 69d83e8c..b0129057 100644 --- a/SRC/pztrti2.f +++ b/SRC/pztrti2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER IA, INFO, JA, N @@ -149,11 +156,34 @@ SUBROUTINE PZTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZTRTI2 inputs: ,DIAG:',A5,', UPLO:',A5, + $ ', IA:',I9,', INFO:',I9,', JA:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -173,6 +203,10 @@ SUBROUTINE PZTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTRTI2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -271,6 +305,10 @@ SUBROUTINE PZTRTI2( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * END IF * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PZTRTI2 * END diff --git a/SRC/pztrtri.f b/SRC/pztrtri.f index 248b4f98..f3cc4f88 100644 --- a/SRC/pztrtri.f +++ b/SRC/pztrtri.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER IA, INFO, JA, N @@ -162,11 +169,34 @@ SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, UPLO, IA, INFO, JA, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZTRTRI inputs: ,DIAG:',A5,', UPLO:',A5, + $ ', IA:',I9,', INFO:',I9,', JA:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test input parameters * INFO = 0 @@ -210,13 +240,22 @@ SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTRTRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Check for singularity if non-unit. * @@ -265,8 +304,13 @@ SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) 30 CONTINUE CALL IGAMX2D( ICTXT, 'All', ' ', 1, 1, INFO, 1, IDUMMY, $ IDUMMY, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF * * Use blocked code @@ -346,6 +390,10 @@ SUBROUTINE PZTRTRI( UPLO, DIAG, N, A, IA, JA, DESCA, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PZTRTRI diff --git a/SRC/pztrtrs.f b/SRC/pztrtrs.f index de1c9ef1..ec136322 100644 --- a/SRC/pztrtrs.f +++ b/SRC/pztrtrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, $ B, IB, JB, DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, TRANS, UPLO INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -194,11 +201,37 @@ SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, TRANS, UPLO, IA, IB, + $ INFO, JA, JB, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZTRTRS inputs: ,DIAG:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', IA:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', JB:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test input parameters * INFO = 0 @@ -263,13 +296,22 @@ SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTRTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Check for singularity if non-unit. * @@ -319,8 +361,13 @@ SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, 30 CONTINUE CALL IGAMX2D( ICTXT, 'All', ' ', 1, 1, INFO, 1, IDUM, IDUM, $ -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF * * Solve A * x = b, A**T * x = b, or A**H * x = b. @@ -328,6 +375,10 @@ SUBROUTINE PZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, IA, JA, DESCA, CALL PZTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, IA, JA, $ DESCA, B, IB, JB, DESCB ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZTRTRS diff --git a/SRC/pztzrzf.f b/SRC/pztzrzf.f index ae6f7de9..8d7d0d1d 100644 --- a/SRC/pztzrzf.f +++ b/SRC/pztzrzf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -214,11 +221,34 @@ SUBROUTINE PZTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZTZRZF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -257,15 +287,28 @@ SUBROUTINE PZTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZTZRZF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( M.EQ.N ) THEN * @@ -328,6 +371,10 @@ SUBROUTINE PZTZRZF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZTZRZF diff --git a/SRC/pzung2l.f b/SRC/pzung2l.f index 8a5f35d9..1a86b0cf 100644 --- a/SRC/pzung2l.f +++ b/SRC/pzung2l.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -184,11 +191,34 @@ SUBROUTINE PZUNG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNG2L inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -221,15 +251,28 @@ SUBROUTINE PZUNG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNG2L', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -272,6 +315,10 @@ SUBROUTINE PZUNG2L( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNG2L diff --git a/SRC/pzung2r.f b/SRC/pzung2r.f index 06109dbb..d81af4ed 100644 --- a/SRC/pzung2r.f +++ b/SRC/pzung2r.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -185,11 +192,34 @@ SUBROUTINE PZUNG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNG2R inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -222,15 +252,28 @@ SUBROUTINE PZUNG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNG2R', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -275,6 +318,10 @@ SUBROUTINE PZUNG2R( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNG2R diff --git a/SRC/pzungl2.f b/SRC/pzungl2.f index 96a96265..ef83c027 100644 --- a/SRC/pzungl2.f +++ b/SRC/pzungl2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -184,11 +191,34 @@ SUBROUTINE PZUNGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGL2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -221,15 +251,28 @@ SUBROUTINE PZUNGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGL2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -283,6 +326,10 @@ SUBROUTINE PZUNGL2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGL2 diff --git a/SRC/pzunglq.f b/SRC/pzunglq.f index a34f6777..c8fe8494 100644 --- a/SRC/pzunglq.f +++ b/SRC/pzunglq.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -186,11 +193,34 @@ SUBROUTINE PZUNGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGLQ inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -233,15 +263,28 @@ SUBROUTINE PZUNGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGLQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+K-1 ) @@ -327,6 +370,10 @@ SUBROUTINE PZUNGLQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGLQ diff --git a/SRC/pzungql.f b/SRC/pzungql.f index 426ec4d6..cc652763 100644 --- a/SRC/pzungql.f +++ b/SRC/pzungql.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -185,11 +192,34 @@ SUBROUTINE PZUNGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGQL inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -231,15 +261,28 @@ SUBROUTINE PZUNGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGQL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( NB_ )*DESCA( NB_ ) + 1 JN = MIN( ICEIL( JA+N-K, DESCA( NB_ ) )*DESCA( NB_ ), JA+N-1 ) @@ -293,6 +336,10 @@ SUBROUTINE PZUNGQL( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGQL diff --git a/SRC/pzungqr.f b/SRC/pzungqr.f index 486ee99c..ee635a18 100644 --- a/SRC/pzungqr.f +++ b/SRC/pzungqr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -187,11 +194,34 @@ SUBROUTINE PZUNGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGQR inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -234,15 +264,28 @@ SUBROUTINE PZUNGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( NB_ )*DESCA( NB_ ) + 1 JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+K-1 ) @@ -329,6 +372,10 @@ SUBROUTINE PZUNGQR( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGQR diff --git a/SRC/pzungr2.f b/SRC/pzungr2.f index a8666db4..0009a419 100644 --- a/SRC/pzungr2.f +++ b/SRC/pzungr2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -184,11 +191,34 @@ SUBROUTINE PZUNGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGR2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -221,15 +251,28 @@ SUBROUTINE PZUNGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -277,6 +320,10 @@ SUBROUTINE PZUNGR2( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGR2 diff --git a/SRC/pzungrq.f b/SRC/pzungrq.f index e95577d5..1d02128b 100644 --- a/SRC/pzungrq.f +++ b/SRC/pzungrq.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, K, LWORK, M, N * .. @@ -186,11 +193,34 @@ SUBROUTINE PZUNGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, K, LWORK, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNGRQ inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', K:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -233,15 +263,28 @@ SUBROUTINE PZUNGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNGRQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.LE.0 ) - $ RETURN + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IPW = DESCA( MB_ )*DESCA( MB_ ) + 1 IN = MIN( ICEIL( IA+M-K, DESCA( MB_ ) )*DESCA( MB_ ), IA+M-1 ) @@ -295,6 +338,10 @@ SUBROUTINE PZUNGRQ( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNGRQ diff --git a/SRC/pzunm2l.f b/SRC/pzunm2l.f index 30dd4424..6a3a810d 100644 --- a/SRC/pzunm2l.f +++ b/SRC/pzunm2l.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PZUNM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNM2L inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -314,15 +347,28 @@ SUBROUTINE PZUNM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNM2L', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( DESCA( M_ ).EQ.1 ) THEN CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, @@ -438,6 +484,10 @@ SUBROUTINE PZUNM2L( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNM2L diff --git a/SRC/pzunm2r.f b/SRC/pzunm2r.f index ccbee1c8..01a86565 100644 --- a/SRC/pzunm2r.f +++ b/SRC/pzunm2r.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PZUNM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNM2R inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -315,15 +348,28 @@ SUBROUTINE PZUNM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNM2R', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( DESCA( M_ ).EQ.1 ) THEN CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, @@ -442,6 +488,10 @@ SUBROUTINE PZUNM2R( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNM2R diff --git a/SRC/pzunmbr.f b/SRC/pzunmbr.f index 4a41d8f1..b5bff4dc 100644 --- a/SRC/pzunmbr.f +++ b/SRC/pzunmbr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, VECT INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -311,11 +318,37 @@ SUBROUTINE PZUNMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, VECT, IA, IC, + $ INFO, JA, JC, K, LWORK, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMBR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', VECT:',A5,', IA:',I9,', IC:',I9, + $ ', INFO:',I9,', JA:',I9,', JC:',I9, + $ ', K:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -530,15 +563,28 @@ SUBROUTINE PZUNMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMBR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( APPLYQ ) THEN * @@ -584,6 +630,10 @@ SUBROUTINE PZUNMBR( VECT, SIDE, TRANS, M, N, K, A, IA, JA, DESCA, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMBR diff --git a/SRC/pzunmhr.f b/SRC/pzunmhr.f index 038916aa..7269b342 100644 --- a/SRC/pzunmhr.f +++ b/SRC/pzunmhr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, IHI, ILO, INFO, JA, JC, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, IHI, ILO, + $ INFO, JA, JC, LWORK, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMHR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', IHI:',I9, + $ ', ILO:',I9,', INFO:',I9,', JA:',I9, + $ ', JC:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -374,21 +407,38 @@ SUBROUTINE PZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMHR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PZUNMQR( SIDE, TRANS, MI, NI, NH, A, IAA, JAA, DESCA, TAU, $ C, ICC, JCC, DESCC, WORK, LWORK, IINFO ) * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMHR diff --git a/SRC/pzunml2.f b/SRC/pzunml2.f index e5d02d3d..5cf80e12 100644 --- a/SRC/pzunml2.f +++ b/SRC/pzunml2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -238,11 +245,37 @@ SUBROUTINE PZUNML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNML2 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -318,15 +351,28 @@ SUBROUTINE PZUNML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNML2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -395,6 +441,10 @@ SUBROUTINE PZUNML2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNML2 diff --git a/SRC/pzunmlq.f b/SRC/pzunmlq.f index 21693224..c312e60a 100644 --- a/SRC/pzunmlq.f +++ b/SRC/pzunmlq.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PZUNMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMLQ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -356,15 +389,28 @@ SUBROUTINE PZUNMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMLQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -445,6 +491,10 @@ SUBROUTINE PZUNMLQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMLQ diff --git a/SRC/pzunmql.f b/SRC/pzunmql.f index e8eeb7a3..dd0518e2 100644 --- a/SRC/pzunmql.f +++ b/SRC/pzunmql.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PZUNMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMQL inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -357,15 +390,28 @@ SUBROUTINE PZUNMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMQL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -452,6 +498,10 @@ SUBROUTINE PZUNMQL( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMQL diff --git a/SRC/pzunmqr.f b/SRC/pzunmqr.f index f7b28ca4..91d9bc43 100644 --- a/SRC/pzunmqr.f +++ b/SRC/pzunmqr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMQR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -357,15 +390,28 @@ SUBROUTINE PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -444,6 +490,10 @@ SUBROUTINE PZUNMQR( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMQR diff --git a/SRC/pzunmr2.f b/SRC/pzunmr2.f index b8c02509..fc3ad10b 100644 --- a/SRC/pzunmr2.f +++ b/SRC/pzunmr2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -237,11 +244,37 @@ SUBROUTINE PZUNMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMR2 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -313,15 +346,28 @@ SUBROUTINE PZUNMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -382,6 +428,10 @@ SUBROUTINE PZUNMR2( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMR2 diff --git a/SRC/pzunmr3.f b/SRC/pzunmr3.f index 3b0d42ba..72e8ff52 100644 --- a/SRC/pzunmr3.f +++ b/SRC/pzunmr3.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, L, LWORK, M, N @@ -239,11 +246,37 @@ SUBROUTINE PZUNMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, L, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMR3 inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', L:',I9, + $ ', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -317,15 +350,28 @@ SUBROUTINE PZUNMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMR3', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -388,6 +434,10 @@ SUBROUTINE PZUNMR3( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMR3 diff --git a/SRC/pzunmrq.f b/SRC/pzunmrq.f index fc25c4e1..19167158 100644 --- a/SRC/pzunmrq.f +++ b/SRC/pzunmrq.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, $ C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, LWORK, M, N @@ -248,11 +255,37 @@ SUBROUTINE PZUNMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMRQ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -368,15 +401,28 @@ SUBROUTINE PZUNMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMRQ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -469,6 +515,10 @@ SUBROUTINE PZUNMRQ( SIDE, TRANS, M, N, K, A, IA, JA, DESCA, TAU, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMRQ diff --git a/SRC/pzunmrz.f b/SRC/pzunmrz.f index 8d952190..2dc1fb2d 100644 --- a/SRC/pzunmrz.f +++ b/SRC/pzunmrz.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER IA, IC, INFO, JA, JC, K, L, LWORK, M, N @@ -253,11 +260,37 @@ SUBROUTINE PZUNMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, IA, IC, INFO, + $ JA, JC, K, L, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMRZ inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', IA:',I9,', IC:',I9,', INFO:',I9, + $ ', JA:',I9,', JC:',I9,', K:',I9,', L:',I9, + $ ', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -365,15 +398,28 @@ SUBROUTINE PZUNMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMRZ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -472,6 +518,10 @@ SUBROUTINE PZUNMRZ( SIDE, TRANS, M, N, K, L, A, IA, JA, DESCA, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMRZ diff --git a/SRC/pzunmtr.f b/SRC/pzunmtr.f index f2820a59..78807fb5 100644 --- a/SRC/pzunmtr.f +++ b/SRC/pzunmtr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZUNMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, $ TAU, C, IC, JC, DESCC, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZUNMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, UPLO INTEGER IA, IC, INFO, JA, JC, LWORK, M, N @@ -262,11 +269,37 @@ SUBROUTINE PZUNMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, UPLO, IA, IC, + $ INFO, JA, JC, LWORK, M, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZUNMTR inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', UPLO:',A5,', IA:',I9,', IC:',I9, + $ ', INFO:',I9,', JA:',I9,', JC:',I9, + $ ', LWORK:',I9,', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -402,15 +435,28 @@ SUBROUTINE PZUNMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZUNMTR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( UPPER ) THEN * @@ -430,6 +476,10 @@ SUBROUTINE PZUNMTR( SIDE, UPLO, TRANS, M, N, A, IA, JA, DESCA, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZUNMTR From eb132a5f5d3e388eadc4de59d41a01190ecc917e Mon Sep 17 00:00:00 2001 From: nprasadm Date: Sun, 29 Oct 2023 19:08:51 +0530 Subject: [PATCH 24/29] Trace and Logging feature enabled for 39 'double precision complex' data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: Ib05d82fa15bb69aa0b151e439a1df328b78a9e7e --- SRC/pzdbsv.f | 45 +++++++++++++++++++++++++++++++ SRC/pzdbtrf.f | 65 ++++++++++++++++++++++++++++++++++++++++++-- SRC/pzdbtrs.f | 73 ++++++++++++++++++++++++++++++++++++++++++++++---- SRC/pzdbtrsv.f | 71 +++++++++++++++++++++++++++++++++++++++++++++--- SRC/pzdrscl.f | 43 +++++++++++++++++++++++++++-- SRC/pzdtsv.f | 44 ++++++++++++++++++++++++++++++ SRC/pzdttrf.f | 63 +++++++++++++++++++++++++++++++++++++++++-- SRC/pzdttrs.f | 72 +++++++++++++++++++++++++++++++++++++++++++++---- SRC/pzdttrsv.f | 70 ++++++++++++++++++++++++++++++++++++++++++++--- SRC/pzgbsv.f | 45 +++++++++++++++++++++++++++++++ SRC/pzgbtrf.f | 65 ++++++++++++++++++++++++++++++++++++++++++-- SRC/pzgbtrs.f | 71 +++++++++++++++++++++++++++++++++++++++++++++--- SRC/pzgebd2.f | 46 +++++++++++++++++++++++++++++++ SRC/pzgebrd.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgecon.f | 57 +++++++++++++++++++++++++++++++++++++++ SRC/pzgeequ.f | 62 +++++++++++++++++++++++++++++++++++++++--- SRC/pzgehd2.f | 43 +++++++++++++++++++++++++++++ SRC/pzgehrd.f | 52 +++++++++++++++++++++++++++++++++-- SRC/pzgelq2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgelqf.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgels.f | 48 +++++++++++++++++++++++++++++++++ SRC/pzgeql2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgeqlf.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgeqpf.f | 57 ++++++++++++++++++++++++++++++++++++--- SRC/pzgeqr2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgeqrf.f | 55 ++++++++++++++++++++++++++++++++++--- SRC/pzgerfs.f | 51 +++++++++++++++++++++++++++++++++++ SRC/pzgerq2.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgerqf.f | 51 +++++++++++++++++++++++++++++++++-- SRC/pzgesv.f | 38 ++++++++++++++++++++++++++ SRC/pzgesvd.f | 43 +++++++++++++++++++++++++++++ SRC/pzgesvx.f | 57 +++++++++++++++++++++++++++++++++++++++ SRC/pzgetf2.f | 47 ++++++++++++++++++++++++++++++-- SRC/pzgetrf.f | 50 +++++++++++++++++++++++++++++++++- SRC/pzgetri.f | 70 ++++++++++++++++++++++++++++++++++++++++------- SRC/pzgetrs.f | 49 +++++++++++++++++++++++++++++++-- SRC/pzggqrf.f | 44 ++++++++++++++++++++++++++++++ SRC/pzggrqf.f | 44 ++++++++++++++++++++++++++++++ SRC/pzstein.f | 58 ++++++++++++++++++++++++++++++++++++--- 39 files changed, 2030 insertions(+), 76 deletions(-) diff --git a/SRC/pzdbsv.f b/SRC/pzdbsv.f index b45163f8..d50f53f9 100644 --- a/SRC/pzdbsv.f +++ b/SRC/pzdbsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -387,6 +394,28 @@ SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PZDBSV inputs: ,BWL:',I9,', BWU:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PZDBTRF and PZDBTRS. @@ -408,6 +437,10 @@ SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZDBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -430,6 +463,10 @@ SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PZDBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -443,9 +480,17 @@ SUBROUTINE PZDBSV( N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZDBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDBSV diff --git a/SRC/pzdbtrf.f b/SRC/pzdbtrf.f index 6c15e29d..8da87bc0 100644 --- a/SRC/pzdbtrf.f +++ b/SRC/pzdbtrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -392,6 +399,16 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -424,6 +441,21 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, MBW2 = MAX_BW * MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZDBTRF inputs: ,BWL:',I9,', BWU:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -473,6 +505,10 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZDBTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -481,6 +517,10 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZDBTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -496,6 +536,10 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, CALL PXERBLA( ICTXT, $ 'PZDBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -512,6 +556,10 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, $ 'PZDBTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,13 +615,22 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1258,6 +1315,10 @@ SUBROUTINE PZDBTRF( N, BWL, BWU, A, JA, DESCA, AF, LAF, WORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDBTRF diff --git a/SRC/pzdbtrs.f b/SRC/pzdbtrs.f index b1e68c5e..a847e8c8 100644 --- a/SRC/pzdbtrs.f +++ b/SRC/pzdbtrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,8 +12,9 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 7, 2001 +* August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -408,6 +415,16 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -465,6 +482,22 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWL, BWU, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZDBTRS inputs: ,TRANS:',A5,', BWL:',I9, + $ ', BWU:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', LAF:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -540,6 +573,10 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZDBTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -548,6 +585,10 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZDBTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -564,6 +605,10 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, $ 'PZDBTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -635,16 +680,30 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -757,6 +816,10 @@ SUBROUTINE PZDBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDBTRS diff --git a/SRC/pzdbtrsv.f b/SRC/pzdbtrsv.f index e6d17358..bd445307 100644 --- a/SRC/pzdbtrsv.f +++ b/SRC/pzdbtrsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER BWL, BWU, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -414,6 +421,16 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -476,6 +493,22 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, MBW2 = MAX_BW * MAX_BW * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, BWL, BWU, IB, + $ INFO, JA, LAF, LWORK, N, NRHS, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZDBTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', BWL:',I9,', BWU:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -559,6 +592,10 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PZDBTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,6 +604,10 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PZDBTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -583,6 +624,10 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, $ 'PZDBTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -656,16 +701,30 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDBTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1589,6 +1648,10 @@ SUBROUTINE PZDBTRSV( UPLO, TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDBTRSV diff --git a/SRC/pzdrscl.f b/SRC/pzdrscl.f index 274b569f..8c7a0063 100644 --- a/SRC/pzdrscl.f +++ b/SRC/pzdrscl.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IX, INCX, JX, N DOUBLE PRECISION SA @@ -144,15 +151,43 @@ SUBROUTINE PZDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IX, INCX, JX, N, SA, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZDRSCL inputs: ,IX:',I9,', INCX:',I9, + $ ', JX:',I9,', N:',I9,', SA:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get machine parameters * @@ -199,6 +234,10 @@ SUBROUTINE PZDRSCL( N, SA, SX, IX, JX, DESCX, INCX ) IF( .NOT.DONE ) $ GO TO 10 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDRSCL diff --git a/SRC/pzdtsv.f b/SRC/pzdtsv.f index bd44ba25..18029599 100644 --- a/SRC/pzdtsv.f +++ b/SRC/pzdtsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, $ WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IB, INFO, JA, LWORK, N, NRHS * .. @@ -397,6 +404,27 @@ SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IB, INFO, JA, LWORK, N, NRHS, + $ eos_str + 102 FORMAT('PZDTSV inputs: ,IB:',I9,', INFO:',I9,', JA:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PZDTTRF and PZDTTRS. @@ -421,6 +449,10 @@ SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, CALL PXERBLA( ICTXT, $ 'PZDTSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -443,6 +475,10 @@ SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PZDTSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -456,9 +492,17 @@ SUBROUTINE PZDTSV( N, NRHS, DL, D, DU, JA, DESCA, B, IB, DESCB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZDTSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDTSV diff --git a/SRC/pzdttrf.f b/SRC/pzdttrf.f index f334a746..4ba03d67 100644 --- a/SRC/pzdttrf.f +++ b/SRC/pzdttrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, $ INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, JA, LAF, LWORK, N * .. @@ -400,6 +407,16 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -435,6 +452,19 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, JA, LAF, LWORK, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZDTTRF inputs: ,INFO:',I9,', JA:',I9, + $ ', LAF:',I9,', LWORK:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -466,6 +496,10 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZDTTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -474,6 +508,10 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZDTTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -489,6 +527,10 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, CALL PXERBLA( ICTXT, $ 'PZDTTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -505,6 +547,10 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, $ 'PZDTTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -556,13 +602,22 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDTTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1071,6 +1126,10 @@ SUBROUTINE PZDTTRF( N, DL, D, DU, JA, DESCA, AF, LAF, WORK, LWORK, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDTTRF diff --git a/SRC/pzdttrs.f b/SRC/pzdttrs.f index 55bdbdb2..42f2dacd 100644 --- a/SRC/pzdttrs.f +++ b/SRC/pzdttrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, $ DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -6,8 +12,9 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 7, 2001 +* August 7, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -424,6 +431,16 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -489,6 +506,21 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IB, INFO, JA, LAF, LWORK, + $ N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZDTTRS inputs: ,TRANS:',A5,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -546,6 +578,10 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZDTTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -554,6 +590,10 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, CALL PXERBLA( ICTXT, $ 'PZDTTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -570,6 +610,10 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, $ 'PZDTTRS: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -637,16 +681,30 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDTTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -788,6 +846,10 @@ SUBROUTINE PZDTTRS( TRANS, N, NRHS, DL, D, DU, JA, DESCA, B, IB, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDTTRS diff --git a/SRC/pzdttrsv.f b/SRC/pzdttrsv.f index 5ec17470..58539aca 100644 --- a/SRC/pzdttrsv.f +++ b/SRC/pzdttrsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS, UPLO INTEGER IB, INFO, JA, LAF, LWORK, N, NRHS @@ -429,6 +436,16 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * INFO = 0 @@ -494,6 +511,21 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, UPLO, IB, INFO, JA, + $ LAF, LWORK, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZDTTRSV inputs: ,TRANS:',A5,', UPLO:',A5, + $ ', IB:',I9,', INFO:',I9,', JA:',I9, + $ ', LAF:',I9,', LWORK:',I9,', N:',I9, + $ ', NRHS:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -559,6 +591,10 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PZDTTRSV, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -567,6 +603,10 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, CALL PXERBLA( ICTXT, $ 'PZDTTRSV, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -583,6 +623,10 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, $ 'PZDTTRSV: worksize error', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -652,16 +696,30 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZDTTRSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1520,6 +1578,10 @@ SUBROUTINE PZDTTRSV( UPLO, TRANS, N, NRHS, DL, D, DU, JA, DESCA, WORK( 1 ) = WORK_SIZE_MIN * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZDTTRSV diff --git a/SRC/pzgbsv.f b/SRC/pzgbsv.f index cc4c86e0..363b3541 100644 --- a/SRC/pzgbsv.f +++ b/SRC/pzgbsv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, $ DESCB, WORK, LWORK, INFO ) * @@ -8,6 +14,7 @@ SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, IB, INFO, JA, LWORK, N, NRHS * .. @@ -392,6 +399,28 @@ SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, IB, INFO, JA, LWORK, + $ N, NRHS, eos_str + 102 FORMAT('PZGBSV inputs: ,BWL:',I9,', BWU:',I9,', IB:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Note: to avoid duplication, most error checking is not performed * in this routine and is left to routines * PZGBTRF and PZGBTRS. @@ -413,6 +442,10 @@ SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, CALL PXERBLA( ICTXT, $ 'PZGBSV', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -435,6 +468,10 @@ SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, IF( INFO .LT. 0 ) THEN CALL PXERBLA( ICTXT, 'PZGBSV', -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -448,9 +485,17 @@ SUBROUTINE PZGBSV( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, B, IB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGBSV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGBSV diff --git a/SRC/pzgbtrf.f b/SRC/pzgbtrf.f index 5dededb3..19528b74 100644 --- a/SRC/pzgbtrf.f +++ b/SRC/pzgbtrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, $ WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER BWL, BWU, INFO, JA, LAF, LWORK, N * .. @@ -401,6 +408,16 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -429,6 +446,21 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) BWL, BWU, INFO, JA, LAF, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGBTRF inputs: ,BWL:',I9,', BWU:',I9, + $ ', INFO:',I9,', JA:',I9,', LAF:',I9, + $ ', LWORK:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -480,6 +512,10 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PZGBTRF, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -488,6 +524,10 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PZGBTRF, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -503,6 +543,10 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, CALL PXERBLA( ICTXT, $ 'PZGBTRF: auxiliary storage error ', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -521,6 +565,10 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, $ 'PZGBTRF: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -576,13 +624,22 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZGBTRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1099,6 +1156,10 @@ SUBROUTINE PZGBTRF( N, BWL, BWU, A, JA, DESCA, IPIV, AF, LAF, ENDIF * * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGBTRF diff --git a/SRC/pzgbtrs.f b/SRC/pzgbtrs.f index c2d16aa6..6252fea4 100644 --- a/SRC/pzgbtrs.f +++ b/SRC/pzgbtrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, $ B, IB, DESCB, AF, LAF, WORK, LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER BWU, BWL, IB, INFO, JA, LAF, LWORK, N, NRHS @@ -414,6 +421,16 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * * Test the input parameters * @@ -472,6 +489,22 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * * CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, BWU, BWL, IB, INFO, + $ JA, LAF, LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZGBTRS inputs: ,TRANS:',A5,', BWU:',I9, + $ ', BWL:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', LAF:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NP = NPROW * NPCOL * * @@ -549,6 +582,10 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, CALL PXERBLA( ICTXT, $ 'PZGBTRS, D&C alg.: only 1 block per proc', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -557,6 +594,10 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, CALL PXERBLA( ICTXT, $ 'PZGBTRS, D&C alg.: NB too small', $ -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -574,6 +615,10 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, $ 'PZGBTRS: worksize error ', $ -INFO ) ENDIF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ENDIF * @@ -645,16 +690,30 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZGBTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file * - IF( NRHS.EQ.0 ) - $ RETURN + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* + IF( NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * Adjust addressing into matrix space to properly get into @@ -1172,6 +1231,10 @@ SUBROUTINE PZGBTRS( TRANS, N, BWL, BWU, NRHS, A, JA, DESCA, IPIV, * WORK( 1 ) = WORK_SIZE_MIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGBTRS diff --git a/SRC/pzgebd2.f b/SRC/pzgebd2.f index d735c9b9..fd67bfef 100644 --- a/SRC/pzgebd2.f +++ b/SRC/pzgebd2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -272,11 +279,34 @@ SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Test the input parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEBD2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -310,8 +340,16 @@ SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEBD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -337,6 +375,10 @@ SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, END IF IF( MYROW.EQ.IAROW ) $ TAUP( II ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -446,6 +488,10 @@ SUBROUTINE PZGEBD2( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEBD2 diff --git a/SRC/pzgebrd.f b/SRC/pzgebrd.f index 11a6a11f..82ba9fc1 100644 --- a/SRC/pzgebrd.f +++ b/SRC/pzgebrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -271,11 +278,34 @@ SUBROUTINE PZGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEBRD inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -314,16 +344,29 @@ SUBROUTINE PZGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * IF( INFO.LT.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEBRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * MN = MIN( M, N ) - IF( MN.EQ.0 ) - $ RETURN + IF( MN.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Initialize parameters. * @@ -407,6 +450,10 @@ SUBROUTINE PZGEBRD( M, N, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEBRD diff --git a/SRC/pzgecon.f b/SRC/pzgecon.f index 5522e715..b7a0cc31 100644 --- a/SRC/pzgecon.f +++ b/SRC/pzgecon.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM INTEGER IA, INFO, JA, LRWORK, LWORK, N @@ -218,11 +225,37 @@ SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, INFO, JA, LRWORK, + $ LWORK, N, ANORM, RCOND, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZGECON inputs: ,NORM:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9,', ANORM:',F9.4, + $ ', RCOND:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -285,8 +318,16 @@ SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGECON', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -295,11 +336,23 @@ SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, RCOND = ZERO IF( N.EQ.0 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( ANORM.EQ.ZERO ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( N.EQ.1 ) THEN RCOND = ONE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -415,6 +468,10 @@ SUBROUTINE PZGECON( NORM, N, A, IA, JA, DESCA, ANORM, RCOND, WORK, CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGECON diff --git a/SRC/pzgeequ.f b/SRC/pzgeequ.f index a51bdfd1..5b5587f8 100644 --- a/SRC/pzgeequ.f +++ b/SRC/pzgeequ.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, $ AMAX, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N DOUBLE PRECISION AMAX, COLCND, ROWCND @@ -195,11 +202,36 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, AMAX, COLCND, + $ ROWCND, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZGEEQU inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', AMAX:',F9.4, + $ ', COLCND:',F9.4,', ROWCND:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -213,6 +245,10 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEEQU', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -222,6 +258,10 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, ROWCND = ONE COLCND = ONE AMAX = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -293,8 +333,13 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 50 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -352,8 +397,13 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, 110 CONTINUE CALL IGAMX2D( ICTXT, 'Columnwise', COLCTOP, 1, 1, INFO, 1, $ IDUMM, IDUMM, -1, -1, MYCOL ) - IF( INFO.NE.0 ) - $ RETURN + IF( INFO.NE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE * * Invert the scale factors. @@ -368,6 +418,10 @@ SUBROUTINE PZGEEQU( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEEQU diff --git a/SRC/pzgehd2.f b/SRC/pzgehd2.f index 3a402a82..a2a876aa 100644 --- a/SRC/pzgehd2.f +++ b/SRC/pzgehd2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -216,11 +223,35 @@ SUBROUTINE PZGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEHD2 inputs: ,IA:',I9,', IHI:',I9,', ILO:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -256,8 +287,16 @@ SUBROUTINE PZGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEHD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -287,6 +326,10 @@ SUBROUTINE PZGEHD2( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEHD2 diff --git a/SRC/pzgehrd.f b/SRC/pzgehrd.f index 57197e53..2f08b586 100644 --- a/SRC/pzgehrd.f +++ b/SRC/pzgehrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IHI, ILO, INFO, JA, LWORK, N * .. @@ -230,11 +237,35 @@ SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IHI, ILO, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEHRD inputs: ,IA:',I9,', IHI:',I9,', ILO:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -288,8 +319,16 @@ SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEHRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -310,8 +349,13 @@ SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * * Quick return if possible * - IF( IHI-ILO.LE.0 ) - $ RETURN + IF( IHI-ILO.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) @@ -376,6 +420,10 @@ SUBROUTINE PZGEHRD( N, ILO, IHI, A, IA, JA, DESCA, TAU, WORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEHRD diff --git a/SRC/pzgelq2.f b/SRC/pzgelq2.f index c54125ad..8556ed23 100644 --- a/SRC/pzgelq2.f +++ b/SRC/pzgelq2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PZGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGELQ2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -223,15 +253,28 @@ SUBROUTINE PZGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGELQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -267,6 +310,10 @@ SUBROUTINE PZGELQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGELQ2 diff --git a/SRC/pzgelqf.f b/SRC/pzgelqf.f index 60e77699..ae0ef2dd 100644 --- a/SRC/pzgelqf.f +++ b/SRC/pzgelqf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PZGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGELQF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -231,15 +261,28 @@ SUBROUTINE PZGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGELQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -306,6 +349,10 @@ SUBROUTINE PZGELQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGELQF diff --git a/SRC/pzgels.f b/SRC/pzgels.f index f39baf19..ca881fa9 100644 --- a/SRC/pzgels.f +++ b/SRC/pzgels.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, $ DESCB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, NRHS @@ -268,11 +275,36 @@ SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ LWORK, M, N, NRHS, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZGELS inputs: ,TRANS:',A5,', IA:',I9, + $ ', IB:',I9,', INFO:',I9,', JA:',I9,', JB:',I9, + $ ', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -378,8 +410,16 @@ SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGELS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -388,6 +428,10 @@ SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, IF( MIN( M, N, NRHS ).EQ.0 ) THEN CALL PZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, $ IB, JB, DESCB ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -590,6 +634,10 @@ SUBROUTINE PZGELS( TRANS, M, N, NRHS, A, IA, JA, DESCA, B, IB, JB, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGELS diff --git a/SRC/pzgeql2.f b/SRC/pzgeql2.f index 97fcf828..aae59096 100644 --- a/SRC/pzgeql2.f +++ b/SRC/pzgeql2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PZGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEQL2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -225,15 +255,28 @@ SUBROUTINE PZGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEQL2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -302,6 +345,10 @@ SUBROUTINE PZGEQL2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEQL2 diff --git a/SRC/pzgeqlf.f b/SRC/pzgeqlf.f index af2fa316..4388fec9 100644 --- a/SRC/pzgeqlf.f +++ b/SRC/pzgeqlf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -192,11 +199,34 @@ SUBROUTINE PZGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEQLF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,15 +262,28 @@ SUBROUTINE PZGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEQLF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -304,6 +347,10 @@ SUBROUTINE PZGEQLF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEQLF diff --git a/SRC/pzgeqpf.f b/SRC/pzgeqpf.f index d9018c4b..c0d9eace 100644 --- a/SRC/pzgeqpf.f +++ b/SRC/pzgeqpf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * and University of California, Berkeley. * November 20, 2019 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, INFO, LRWORK, LWORK, M, N * .. @@ -189,9 +196,9 @@ SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * * References * ========== -* +* * For modifications introduced in Scalapack 2.1 -* LAWN 295 +* LAWN 295 * New robust ScaLAPACK routine for computing the QR factorization with column pivoting * Zvonimir Bujanovic, Zlatko Drmac * http://www.netlib.org/lapack/lawnspdf/lawn295.pdf @@ -239,11 +246,36 @@ SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, INFO, LRWORK, LWORK, + $ M, N, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGEQPF inputs: ,IA:',I9,', JA:',I9,', INFO:',I9, + $ ', LRWORK:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -292,15 +324,28 @@ SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEQPF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) @@ -569,6 +614,10 @@ SUBROUTINE PZGEQPF( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) RWORK( 1 ) = DBLE( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEQPF diff --git a/SRC/pzgeqr2.f b/SRC/pzgeqr2.f index fd638b30..e3e78ba3 100644 --- a/SRC/pzgeqr2.f +++ b/SRC/pzgeqr2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PZGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEQR2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -224,15 +254,28 @@ SUBROUTINE PZGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEQR2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -301,6 +344,10 @@ SUBROUTINE PZGEQR2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEQR2 diff --git a/SRC/pzgeqrf.f b/SRC/pzgeqrf.f index b1847de3..068226c5 100644 --- a/SRC/pzgeqrf.f +++ b/SRC/pzgeqrf.f @@ -1,8 +1,13 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 20, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) @@ -14,6 +19,7 @@ SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -182,6 +188,9 @@ SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -217,11 +226,34 @@ SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGEQRF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -257,15 +289,28 @@ SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGEQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( NB_ ) * DESCA( NB_ ) + 1 @@ -355,6 +400,10 @@ SUBROUTINE PZGEQRF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGEQRF diff --git a/SRC/pzgerfs.f b/SRC/pzgerfs.f index c22a7b89..8ece93b7 100644 --- a/SRC/pzgerfs.f +++ b/SRC/pzgerfs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, $ JAF, DESCAF, IPIV, B, IB, JB, DESCB, X, IX, $ JX, DESCX, FERR, BERR, WORK, LWORK, RWORK, @@ -8,6 +14,7 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IAF, IB, IX, INFO, JA, JAF, JB, JX, @@ -309,6 +316,16 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * .. Initialize EST EST = (0.0, 0.0) * @@ -317,6 +334,24 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IAF, IB, IX, INFO, + $ JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZGERFS inputs: ,TRANS:',A5,', IA:',I9, + $ ', IAF:',I9,', IB:',I9,', IX:',I9,', INFO:',I9, + $ ', JA:',I9,', JAF:',I9,', JB:',I9, + $ ', JX:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9,', NRHS:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * NOTRAN = LSAME( TRANS, 'N' ) @@ -437,8 +472,16 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGERFS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -453,6 +496,10 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, FERR( JJ ) = ZERO BERR( JJ ) = ZERO 10 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -891,6 +938,10 @@ SUBROUTINE PZGERFS( TRANS, N, NRHS, A, IA, JA, DESCA, AF, IAF, WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) RWORK( 1 ) = DBLE( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGERFS diff --git a/SRC/pzgerq2.f b/SRC/pzgerq2.f index 103d1bb9..feac630c 100644 --- a/SRC/pzgerq2.f +++ b/SRC/pzgerq2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -190,11 +197,34 @@ SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGERQ2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -223,15 +253,28 @@ SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGERQ2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Broadcast', 'Rowwise', ROWBTOP ) CALL PB_TOPGET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) @@ -264,6 +307,10 @@ SUBROUTINE PZGERQ2( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGERQ2 diff --git a/SRC/pzgerqf.f b/SRC/pzgerqf.f index b94fd8bd..dcaa151a 100644 --- a/SRC/pzgerqf.f +++ b/SRC/pzgerqf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LWORK, M, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PZGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LWORK, M, N, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGERQF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LWORK:',I9,', M:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -231,15 +261,28 @@ SUBROUTINE PZGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGERQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * K = MIN( M, N ) IPW = DESCA( MB_ ) * DESCA( MB_ ) + 1 @@ -303,6 +346,10 @@ SUBROUTINE PZGERQF( M, N, A, IA, JA, DESCA, TAU, WORK, LWORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGERQF diff --git a/SRC/pzgesv.f b/SRC/pzgesv.f index 2707c293..3605a878 100644 --- a/SRC/pzgesv.f +++ b/SRC/pzgesv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, $ DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * and University of California, Berkeley. * Jan 30, 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, N, NRHS * .. @@ -179,11 +186,34 @@ SUBROUTINE PZGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, N, NRHS, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGESV inputs: ,IA:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', N:',I9, + $ ', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -220,6 +250,10 @@ SUBROUTINE PZGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGESV', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -237,6 +271,10 @@ SUBROUTINE PZGESV( N, NRHS, A, IA, JA, DESCA, IPIV, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGESV diff --git a/SRC/pzgesvd.f b/SRC/pzgesvd.f index befed5ca..654d5169 100644 --- a/SRC/pzgesvd.f +++ b/SRC/pzgesvd.f @@ -1,4 +1,10 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, + VT,IVT,JVT,DESCVT,WORK,LWORK,RWORK,INFO) * @@ -8,6 +14,7 @@ SUBROUTINE PZGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * Jan 2006 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBU,JOBVT INTEGER IA,INFO,IU,IVT,JA,JU,JVT,LWORK,M,N @@ -328,7 +335,35 @@ SUBROUTINE PZGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, INTRINSIC DCMPLX * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBU,JOBVT, IA,INFO,IU,IVT, + $ JA,JU,JVT,LWORK,M,N, eos_str + 102 FORMAT('PZGESVD inputs: ,JOBU:',A5,', JOBVT:',A5, + $ ', IA:',I9,', INFO:',I9,', IU:',I9, + $ ', IVT:',I9,', JA:',I9,', JU:',I9, + $ ', JVT:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF (BLOCK_CYCLIC_2D*DTYPE_*LLD_*MB_*M_*NB_*N_.LT.0) RETURN * CALL BLACS_GRIDINFO(DESCA(CTXT_),NPROW,NPCOL,MYPROW,MYPCOL) @@ -480,6 +515,10 @@ SUBROUTINE PZGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * IF (INFO.NE.0) THEN CALL PXERBLA(DESCA(CTXT_),'PZGESVD',-INFO) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF (LWORK.EQ.-1) THEN GO TO 40 @@ -645,5 +684,9 @@ SUBROUTINE PZGESVD(JOBU,JOBVT,M,N,A,IA,JA,DESCA,S,U,IU,JU,DESCU, * * End of PZGESVD * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END diff --git a/SRC/pzgesvx.f b/SRC/pzgesvx.f index 6c427143..f1aeea07 100644 --- a/SRC/pzgesvx.f +++ b/SRC/pzgesvx.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, $ IAF, JAF, DESCAF, IPIV, EQUED, R, C, B, IB, $ JB, DESCB, X, IX, JX, DESCX, RCOND, FERR, @@ -8,6 +14,7 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, FACT, TRANS INTEGER IA, IAF, IB, INFO, IX, JA, JAF, JB, JX, LRWORK, @@ -449,11 +456,41 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, FACT, TRANS, IA, IAF, + $ IB, INFO, IX, JA, JAF, JB, JX, LRWORK, + $ LWORK, N, NRHS, + $ RCOND, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGESVX inputs: ,EQUED:',A5,', FACT:',A5, + $ ', TRANS:',A5,', IA:',I9,', IAF:',I9, + $ ', IB:',I9,', INFO:',I9,', IX:',I9, + $ ', JA:',I9,', JAF:',I9,', JB:',I9, + $ ', JX:',I9,', LRWORK:',I9,', LWORK:',I9, + $ ', N:',I9,', NRHS:',I9,', RCOND:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -651,8 +688,16 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGESVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -729,6 +774,10 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, IF( INFO.NE.0 ) THEN IF( INFO.GT.0 ) $ RCOND = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF END IF @@ -751,6 +800,10 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, * IF( RCOND.LT.PDLAMCH( ICTXT, 'Epsilon' ) ) THEN INFO = IA + N +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -823,6 +876,10 @@ SUBROUTINE PZGESVX( FACT, TRANS, N, NRHS, A, IA, JA, DESCA, AF, WORK( 1 ) = DBLE( LWMIN ) RWORK( 1 ) = DBLE( LRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGESVX diff --git a/SRC/pzgetf2.f b/SRC/pzgetf2.f index b0ac33cd..57fcf612 100644 --- a/SRC/pzgetf2.f +++ b/SRC/pzgetf2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -159,11 +166,34 @@ SUBROUTINE PZGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGETF2 inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters. * INFO = 0 @@ -189,13 +219,22 @@ SUBROUTINE PZGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGETF2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * MN = MIN( M, N ) CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, @@ -245,6 +284,10 @@ SUBROUTINE PZGETF2( M, N, A, IA, JA, DESCA, IPIV, INFO ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGETF2 diff --git a/SRC/pzgetrf.f b/SRC/pzgetrf.f index 550d9ffc..5c42d375 100644 --- a/SRC/pzgetrf.f +++ b/SRC/pzgetrf.f @@ -1,8 +1,13 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* * -- ScaLAPACK routine -- -* Copyright (c) 2020-22 Advanced Micro Devices, Inc.  All rights reserved. * June 10, 2022 * #include "SL_Context_fortran_include.h" +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * @@ -13,6 +18,7 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, M, N * .. @@ -161,6 +167,9 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * .. Declaring 'API NAME' and its length as const objects * .. API_NAME string terminated with 'NULL' character. +* +#include "SL_Context_fortran_include.h" +* CHARACTER*8, PARAMETER :: API_NAME = FUNCTION_NAME // C_NULL_CHAR INTEGER, PARAMETER :: LEN_API_NAME = 8 #endif @@ -190,11 +199,34 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGETRF inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -219,6 +251,10 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGETRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -226,8 +262,16 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) * IF( DESCA( M_ ).EQ.1 ) THEN IPIV( 1 ) = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -355,6 +399,10 @@ SUBROUTINE PZGETRF( M, N, A, IA, JA, DESCA, IPIV, INFO ) CALL PB_TOPSET( ICTXT, 'Broadcast', 'Columnwise', COLBTOP ) CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGETRF diff --git a/SRC/pzgetri.f b/SRC/pzgetri.f index 9817ed2f..05a1ec69 100644 --- a/SRC/pzgetri.f +++ b/SRC/pzgetri.f @@ -1,12 +1,19 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, $ IWORK, LIWORK, INFO ) * * -- ScaLAPACK routine (version 1.7.4) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* v1.7.4: May 10, 2006 +* v1.7.4: May 10, 2006 * v1.7: May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, INFO, JA, LIWORK, LWORK, N * .. @@ -191,11 +198,34 @@ SUBROUTINE PZGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, INFO, JA, LIWORK, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZGETRI inputs: ,IA:',I9,', INFO:',I9, + $ ', JA:',I9,', LIWORK:',I9,', LWORK:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -226,21 +256,21 @@ SUBROUTINE PZGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * LDW = LOCc( M_P + MOD(IP-1, MB_P) ) + * MB_P * CEIL( CEIL(LOCr(M_P)/MB_P) / (LCM/NPROW) ) * -* where +* where * M_P is the global length of the pivot vector * MP = DESCA( M_ ) + DESCA( MB_ ) * NPROW * I_P is IA * I_P = IA -* MB_P is the block size use for the block cyclic distribution of the +* MB_P is the block size use for the block cyclic distribution of the * pivot vector * MB_P = DESCA (MB_ ) -* LOCc ( . ) +* LOCc ( . ) * NUMROC ( . , DESCA ( NB_ ), MYCOL, DESCA ( CSRC_ ), NPCOL ) * LOCr ( . ) * NUMROC ( . , DESCA ( MB_ ), MYROW, DESCA ( RSRC_ ), NPROW ) * CEIL ( X / Y ) * ICEIL( X, Y ) -* LCM +* LCM * LCM = ILCM( NPROW, NPCOL ) * LCM = ILCM( NPROW, NPCOL ) @@ -285,22 +315,40 @@ SUBROUTINE PZGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGETRI', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Form inv(U). If INFO > 0 from PZTRTRI, then U is singular, * and the inverse is not computed. * CALL PZTRTRI( 'Upper', 'Non-unit', N, A, IA, JA, DESCA, INFO ) - IF( INFO.GT.0 ) - $ RETURN + IF( INFO.GT.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Define array descriptor for working array WORK * @@ -367,6 +415,10 @@ SUBROUTINE PZGETRI( N, A, IA, JA, DESCA, IPIV, WORK, LWORK, WORK( 1 ) = DBLE( LWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGETRI diff --git a/SRC/pzgetrs.f b/SRC/pzgetrs.f index aad4321e..994fadaf 100644 --- a/SRC/pzgetrs.f +++ b/SRC/pzgetrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, $ IB, JB, DESCB, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TRANS INTEGER IA, IB, INFO, JA, JB, N, NRHS @@ -179,11 +186,36 @@ SUBROUTINE PZGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TRANS, IA, IB, INFO, JA, JB, + $ N, NRHS, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGETRS inputs: ,TRANS:',A5,', IA:',I9, + $ ', IB:',I9,', INFO:',I9,', JA:',I9, + $ ', JB:',I9,', N:',I9,', NRHS:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -232,13 +264,22 @@ SUBROUTINE PZGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGETRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL DESCSET( DESCIP, DESCA( M_ ) + DESCA( MB_ )*NPROW, 1, $ DESCA( MB_ ), 1, DESCA( RSRC_ ), MYCOL, ICTXT, @@ -284,6 +325,10 @@ SUBROUTINE PZGETRS( TRANS, N, NRHS, A, IA, JA, DESCA, IPIV, B, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGETRS diff --git a/SRC/pzggqrf.f b/SRC/pzggqrf.f index 16891465..a41cf960 100644 --- a/SRC/pzggqrf.f +++ b/SRC/pzggqrf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -281,11 +288,36 @@ SUBROUTINE PZGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGGQRF inputs: ,IA:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', P:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -341,8 +373,16 @@ SUBROUTINE PZGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGGQRF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -363,6 +403,10 @@ SUBROUTINE PZGGQRF( N, M, P, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PZGERQF( N, P, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = DCMPLX( DBLE( MAX( LWMIN, INT( WORK( 1 ) ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGGQRF diff --git a/SRC/pzggrqf.f b/SRC/pzggrqf.f index 68f546d1..b9342e20 100644 --- a/SRC/pzggrqf.f +++ b/SRC/pzggrqf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, $ DESCB, TAUB, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, INFO, JA, JB, LWORK, M, N, P * .. @@ -281,11 +288,36 @@ SUBROUTINE PZGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, INFO, JA, JB, LWORK, + $ M, N, P, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZGGRQF inputs: ,IA:',I9,', IB:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', P:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -341,8 +373,16 @@ SUBROUTINE PZGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZGGRQF', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -363,6 +403,10 @@ SUBROUTINE PZGGRQF( M, P, N, A, IA, JA, DESCA, TAUA, B, IB, JB, CALL PZGEQRF( P, N, B, IB, JB, DESCB, TAUB, WORK, LWORK, INFO ) WORK( 1 ) = DCMPLX( DBLE( MAX( LWMIN, INT( WORK( 1 ) ) ) ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZGGRQF diff --git a/SRC/pzstein.f b/SRC/pzstein.f index 5d397314..7a217249 100644 --- a/SRC/pzstein.f +++ b/SRC/pzstein.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, $ JZ, DESCZ, WORK, LWORK, IWORK, LIWORK, IFAIL, $ ICLUSTR, GAP, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INFO, IZ, JZ, LIWORK, LWORK, M, N DOUBLE PRECISION ORFAC @@ -296,9 +303,37 @@ SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, INTEGER IDUM1( 1 ), IDUM2( 1 ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INFO, IZ, JZ, LIWORK, LWORK, + $ M, N, ORFAC, eos_str + 102 FORMAT('PZSTEIN inputs: ,INFO:',I9,', IZ:',I9, + $ ', JZ:',I9,', LIWORK:',I9,', LWORK:',I9, + $ ', M:',I9,', N:',I9,', ORFAC:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) SELF = MYROW*NPCOL + MYCOL @@ -376,8 +411,16 @@ SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCZ( CTXT_ ), 'PZSTEIN', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -396,8 +439,13 @@ SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, * * Quick return if possible * - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. M.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( ORFAC.GE.ZERO ) THEN TMPFAC = ORFAC @@ -638,6 +686,10 @@ SUBROUTINE PZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, ORFAC, Z, IZ, WORK( 1 ) = ( LGCLSIZ+LOAD-1 )*N + INDRW IWORK( 1 ) = 3*N + P + 1 * +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F +* * End of PZSTEIN * END From d3e898a5c53e1e3802308e096c47e7ee66df90b0 Mon Sep 17 00:00:00 2001 From: nprasadm Date: Sun, 29 Oct 2023 18:51:47 +0530 Subject: [PATCH 25/29] Trace and Logging feature enabled for 57 'double precision complex' data type APIs. Signed-off-by: Nagendra AMD-Internal: [CPUPL-3507] Change-Id: I5129f4b4fdffae2409c7c11cbdef5c8f30b72bf8 --- SRC/pzheev.f | 61 ++++++++++- SRC/pzheevd.f | 63 ++++++++++- SRC/pzheevr.f | 272 +++++++++++++++++++++++++++++++----------------- SRC/pzheevx.f | 68 +++++++++++- SRC/pzhegs2.f | 54 +++++++++- SRC/pzhegst.f | 54 +++++++++- SRC/pzhegvx.f | 62 ++++++++++- SRC/pzhengst.f | 58 ++++++++++- SRC/pzhentrd.f | 58 ++++++++++- SRC/pzhetd2.f | 51 ++++++++- SRC/pzhetrd.f | 51 ++++++++- SRC/pzhettrd.f | 58 ++++++++++- SRC/pzlabrd.f | 42 +++++++- SRC/pzlacgv.f | 51 ++++++++- SRC/pzlacon.f | 63 ++++++++++- SRC/pzlaconsb.f | 40 +++++++ SRC/pzlacp2.f | 60 +++++++++-- SRC/pzlacp3.f | 40 ++++++- SRC/pzlacpy.f | 42 +++++++- SRC/pzlaevswp.f | 39 ++++++- SRC/pzlahqr.f | 59 ++++++++++- SRC/pzlahrd.f | 41 +++++++- SRC/pzlamr1d.f | 48 ++++++++- SRC/pzlange.f | 34 ++++++ SRC/pzlanhe.f | 34 ++++++ SRC/pzlanhs.f | 33 ++++++ SRC/pzlansy.f | 34 ++++++ SRC/pzlantr.f | 34 ++++++ SRC/pzlapiv.f | 54 +++++++++- SRC/pzlapv2.f | 51 ++++++++- SRC/pzlaqge.f | 37 +++++++ SRC/pzlaqsy.f | 37 +++++++ SRC/pzlarf.f | 42 +++++++- SRC/pzlarfb.f | 43 +++++++- SRC/pzlarfc.f | 42 +++++++- SRC/pzlarfg.f | 57 +++++++++- SRC/pzlarft.f | 42 +++++++- SRC/pzlarz.f | 42 +++++++- SRC/pzlarzb.f | 47 ++++++++- SRC/pzlarzc.f | 42 +++++++- SRC/pzlarzt.f | 38 +++++++ SRC/pzlascl.f | 49 ++++++++- SRC/pzlase2.f | 60 +++++++++-- SRC/pzlaset.f | 42 +++++++- SRC/pzlasmsub.f | 38 +++++++ SRC/pzlassq.f | 52 ++++++++- SRC/pzlaswp.f | 42 +++++++- SRC/pzlatra.f | 37 +++++++ SRC/pzlatrd.f | 42 +++++++- SRC/pzlatrs.f | 46 +++++++- SRC/pzlatrz.f | 40 ++++++- SRC/pzlattrs.f | 50 ++++++++- SRC/pzlauu2.f | 44 +++++++- SRC/pzlauum.f | 40 ++++++- SRC/pzlawil.f | 44 +++++++- SRC/pzmax1.f | 65 +++++++++++- 56 files changed, 2660 insertions(+), 209 deletions(-) diff --git a/SRC/pzheev.f b/SRC/pzheev.f index 6db851f7..380ae244 100644 --- a/SRC/pzheev.f +++ b/SRC/pzheev.f @@ -1,11 +1,18 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHEEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, $ DESCZ, WORK, LWORK, RWORK, LRWORK, INFO ) * * -- ScaLAPACK routine (version 1.7) -- * University of Tennessee, Knoxville, Oak Ridge National Laboratory, * and University of California, Berkeley. -* August 14, 2001 +* August 14, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, UPLO INTEGER IA, INFO, IZ, JA, JZ, LRWORK, LWORK, N @@ -283,14 +290,48 @@ SUBROUTINE PZHEEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LRWORK, LWORK, N, eos_str + 102 FORMAT('PZHEEV inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I9,', INFO:',I9,', IZ:',I9, + $ ', JA:',I9,', JZ:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Quick return * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Test the input arguments. * @@ -499,10 +540,18 @@ SUBROUTINE PZHEEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, CALL PXERBLA( DESCA( CTXT_ ), 'PZHEEV', -INFO ) IF( WANTZ ) $ CALL BLACS_GRIDEXIT( CONTEXTC ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) THEN IF( WANTZ ) $ CALL BLACS_GRIDEXIT( CONTEXTC ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -629,6 +678,10 @@ SUBROUTINE PZHEEV( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, 50 CONTINUE RWORK( 1 ) = LRMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEEV diff --git a/SRC/pzheevd.f b/SRC/pzheevd.f index 52d09559..ecdcb2b7 100644 --- a/SRC/pzheevd.f +++ b/SRC/pzheevd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, $ DESCZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) @@ -7,6 +13,7 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * and University of California, Berkeley. * March 25, 2002 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, UPLO INTEGER IA, INFO, IZ, JA, JZ, LIWORK, LRWORK, LWORK, N @@ -15,7 +22,7 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, INTEGER DESCA( * ), DESCZ( * ), IWORK( * ) DOUBLE PRECISION RWORK( * ), W( * ) COMPLEX*16 A( * ), WORK( * ), Z( * ) -* +* * * Purpose * ======= @@ -203,16 +210,50 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, INTRINSIC DCMPLX, ICHAR, MAX, MIN, MOD, DBLE, SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, UPLO, IA, INFO, IZ, JA, + $ JZ, LIWORK, LRWORK, LWORK, N, eos_str + 102 FORMAT('PZHEEVD inputs: ,JOBZ:',A5,', UPLO:',A5, + $ ', IA:',I9,', INFO:',I9,', IZ:',I9, + $ ', JA:',I9,', JZ:',I9,', LIWORK:',I9, + $ ', LRWORK:',I9,', LWORK:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * INFO = 0 * * Quick return * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Test the input arguments. * @@ -221,7 +262,7 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * IF( NPROW.EQ.-1 ) THEN INFO = -( 700+CTXT_ ) - ELSE + ELSE CALL CHK1MAT( N, 3, N, 3, IA, JA, DESCA, 7, INFO ) CALL CHK1MAT( N, 3, N, 3, IZ, JZ, DESCZ, 12, INFO ) IF( INFO.EQ.0 ) THEN @@ -300,8 +341,16 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, * IF( INFO.NE.0 ) THEN CALL PXERBLA( DESCA( CTXT_ ), 'PZHEEVD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -435,6 +484,10 @@ SUBROUTINE PZHEEVD( JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ, RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEEVD diff --git a/SRC/pzheevr.f b/SRC/pzheevr.f index 4b7715d7..b17f938f 100644 --- a/SRC/pzheevr.f +++ b/SRC/pzheevr.f @@ -1,9 +1,16 @@ - SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* + SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ DESCA, VL, VU, IL, IU, M, NZ, W, Z, IZ, - $ JZ, DESCZ, + $ JZ, DESCZ, $ WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, $ INFO ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK routine (version 2.0.2) -- @@ -12,7 +19,6 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO - INTEGER IA, IL, INFO, IU, IZ, JA, JZ, LIWORK, LRWORK, $ LWORK, M, N, NZ DOUBLE PRECISION VL, VU @@ -28,14 +34,14 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * * PZHEEVR computes selected eigenvalues and, optionally, eigenvectors * of a complex Hermitian matrix A distributed in 2D blockcyclic format -* by calling the recommended sequence of ScaLAPACK routines. +* by calling the recommended sequence of ScaLAPACK routines. * * First, the matrix A is reduced to real symmetric tridiagonal form. * Then, the eigenproblem is solved using the parallel MRRR algorithm. * Last, if eigenvectors have been computed, a backtransformation is done. * * Upon successful completion, each processor stores a copy of all computed -* eigenvalues in W. The eigenvector matrix Z is stored in +* eigenvalues in W. The eigenvector matrix Z is stored in * 2D blockcyclic format distributed over all processors. * * For constructive feedback and comments, please contact cvoemel@lbl.gov @@ -67,7 +73,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * A (local input/workspace) 2D block cyclic COMPLEX*16 array, * global dimension (N, N), * local dimension ( LLD_A, LOCc(JA+N-1) ) -* (see Notes below for more detailed explanation of 2d arrays) +* (see Notes below for more detailed explanation of 2d arrays) * * On entry, the symmetric matrix A. If UPLO = 'U', only the * upper triangular part of A is used to define the elements of @@ -92,16 +98,16 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * DESCA (global and local input) INTEGER array of dimension DLEN_. * (The ScaLAPACK descriptor length is DLEN_ = 9.) * The array descriptor for the distributed matrix A. -* The descriptor stores details about the 2D block-cyclic -* storage, see the notes below. +* The descriptor stores details about the 2D block-cyclic +* storage, see the notes below. * If DESCA is incorrect, PZHEEVR cannot work correctly. * Also note the array alignment requirements specified below * -* VL (global input) DOUBLE PRECISION +* VL (global input) DOUBLE PRECISION * If RANGE='V', the lower bound of the interval to be searched * for eigenvalues. Not referenced if RANGE = 'A' or 'I'. * -* VU (global input) DOUBLE PRECISION +* VU (global input) DOUBLE PRECISION * If RANGE='V', the upper bound of the interval to be searched * for eigenvalues. Not referenced if RANGE = 'A' or 'I'. * @@ -122,7 +128,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Total number of eigenvectors computed. 0 <= NZ <= M. * The number of columns of Z that are filled. * If JOBZ .NE. 'V', NZ is not referenced. -* If JOBZ .EQ. 'V', NZ = M +* If JOBZ .EQ. 'V', NZ = M * * W (global output) DOUBLE PRECISION array, dimension (N) * On normal exit, the first M entries contain the selected @@ -161,7 +167,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * LWORK >= N + MAX( NB * ( NP00 + 1 ), NB * 3 ) * If eigenvectors are requested: * LWORK >= N + ( NP00 + MQ00 + NB ) * NB -* For definitions of NP00 & MQ00, see LRWORK. +* For definitions of NP00 & MQ00, see LRWORK. * * For optimal performance, greater workspace is needed, i.e. * LWORK >= MAX( LWORK, NHETRD_LWORK ) @@ -232,7 +238,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Let NNP = MAX( N, NPROW*NPCOL + 1, 4 ). Then: * LIWORK >= 12*NNP + 2*N when the eigenvectors are desired * LIWORK >= 10*NNP + 2*N when only the eigenvalues have to be computed -* +* * If LIWORK = -1, then LIWORK is global input and a workspace * query is assumed; the routine only calculates the minimum * and optimal size for all work arrays. Each of these @@ -300,7 +306,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A * -* PZHEEVR assumes IEEE 754 standard compliant arithmetic. +* PZHEEVR assumes IEEE 754 standard compliant arithmetic. * * Alignment requirements * ====================== @@ -308,9 +314,9 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * The distributed submatrices A(IA:*, JA:*) and Z(IZ:IZ+M-1,JZ:JZ+N-1) * must satisfy the following alignment properties: * -* 1.Identical (quadratic) dimension: +* 1.Identical (quadratic) dimension: * DESCA(M_) = DESCZ(M_) = DESCA(N_) = DESCZ(N_) -* 2.Quadratic conformal blocking: +* 2.Quadratic conformal blocking: * DESCA(MB_) = DESCA(NB_) = DESCZ(MB_) = DESCZ(NB_) * DESCA(RSRC_) = DESCZ(RSRC_) * 3.MOD( IA-1, MB_A ) = MOD( IZ-1, MB_Z ) = 0 @@ -368,6 +374,16 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * INFO = 0 @@ -395,7 +411,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** * * Set up pointers into the (complex) WORK array -* +* *********************************************************************** INDTAU = 1 INDWORK = INDTAU + N @@ -404,7 +420,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** * * Set up pointers into the RWORK array -* +* *********************************************************************** INDRTAU = 1 INDD = INDRTAU + N @@ -420,6 +436,26 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * *********************************************************************** CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, + $ INFO, IU, IZ, JA, JZ, LIWORK, LRWORK, + $ LWORK, M, N, NZ, + $ VL, VU, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZHEEVR inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I9,', IL:',I9, + $ ', INFO:',I9,', IU:',I9,', IZ:',I9, + $ ', JA:',I9,', JZ:',I9,', LIWORK:',I9, + $ ', LRWORK:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NZ:',I9,', VL:',F9.4, + $ ', VU:',F9.4,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF NPROCS = NPROW * NPCOL @@ -445,10 +481,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Take upper bound for VALEIG case MZ = N END IF -* +* NB = DESCA( NB_ ) NP00 = NUMROC( N, NB, 0, 0, NPROW ) - MQ00 = NUMROC( MZ, NB, 0, 0, NPCOL ) + MQ00 = NUMROC( MZ, NB, 0, 0, NPCOL ) IF ( WANTZ ) THEN INDRW = INDRWORK + MAX(18*N, NP00*MQ00 + 2*NB*NB) LRWMIN = INDRW - 1 + (ICEIL(MZ, NPROCS) + 2)*N @@ -456,7 +492,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, ELSE INDRW = INDRWORK + 12*N LRWMIN = INDRW - 1 - LWMIN = N + MAX( NB*( NP00 + 1 ), 3 * NB ) + LWMIN = N + MAX( NB*( NP00 + 1 ), 3 * NB ) END IF * The code that validates the input requires 3 workspace entries @@ -480,7 +516,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** NNP = MAX( N, NPROCS+1, 4 ) IF ( WANTZ ) THEN - LIWMIN = 12*NNP + 2*N + LIWMIN = 12*NNP + 2*N ELSE LIWMIN = 10*NNP + 2*N END IF @@ -488,12 +524,12 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, *********************************************************************** * * Set up pointers into the IWORK array -* +* *********************************************************************** * Pointer to eigenpair distribution over processors - INDILU = LIWMIN - 2*NPROCS + 1 - SIZE2 = INDILU - 2*N - + INDILU = LIWMIN - 2*NPROCS + 1 + SIZE2 = INDILU - 2*N + *********************************************************************** * @@ -532,9 +568,9 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, INFO = -( 800+NB_ ) END IF IF( WANTZ ) THEN - IAROW = INDXG2P( 1, DESCA( NB_ ), MYROW, + IAROW = INDXG2P( 1, DESCA( NB_ ), MYROW, $ DESCA( RSRC_ ), NPROW ) - IZROW = INDXG2P( 1, DESCA( NB_ ), MYROW, + IZROW = INDXG2P( 1, DESCA( NB_ ), MYROW, $ DESCZ( RSRC_ ), NPROW ) IF( IAROW.NE.IZROW ) THEN INFO = -19 @@ -595,8 +631,16 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHEEVR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -613,6 +657,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, WORK( 1 ) = DCMPLX( LWOPT ) RWORK( 1 ) = DBLE( LRWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -641,6 +689,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'PZHENTRD', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -650,25 +702,25 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * *********************************************************************** OFFSET = 0 - IF( IA.EQ.1 .AND. JA.EQ.1 .AND. + IF( IA.EQ.1 .AND. JA.EQ.1 .AND. $ DESCA( RSRC_ ).EQ.0 .AND. DESCA( CSRC_ ).EQ.0 ) $ THEN - CALL PDLARED1D( N, IA, JA, DESCA, RWORK( INDD ), + CALL PDLARED1D( N, IA, JA, DESCA, RWORK( INDD ), $ RWORK( INDD2 ), RWORK( INDRWORK ), LLRWORK ) * - CALL PDLARED1D( N, IA, JA, DESCA, RWORK( INDE ), + CALL PDLARED1D( N, IA, JA, DESCA, RWORK( INDE ), $ RWORK( INDE2 ), RWORK( INDRWORK ), LLRWORK ) IF( .NOT.LOWER ) $ OFFSET = 1 ELSE DO 10 I = 1, N - CALL PZELGET( 'A', ' ', WORK( INDWORK ), A, + CALL PZELGET( 'A', ' ', WORK( INDWORK ), A, $ I+IA-1, I+JA-1, DESCA ) RWORK( INDD2+I-1 ) = DBLE( WORK( INDWORK ) ) 10 CONTINUE IF( LSAME( UPLO, 'U' ) ) THEN DO 20 I = 1, N - 1 - CALL PZELGET( 'A', ' ', WORK( INDWORK ), A, + CALL PZELGET( 'A', ' ', WORK( INDWORK ), A, $ I+IA-1, I+JA, DESCA ) RWORK( INDE2+I-1 ) = DBLE( WORK( INDWORK ) ) 20 CONTINUE @@ -689,16 +741,16 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * SET IIL, IIU * *********************************************************************** - IF ( ALLEIG ) THEN + IF ( ALLEIG ) THEN IIL = 1 IIU = N ELSE IF ( INDEIG ) THEN IIL = IL IIU = IU ELSE IF ( VALEIG ) THEN - CALL DLARRC('T', N, VLL, VUU, RWORK( INDD2 ), + CALL DLARRC('T', N, VLL, VUU, RWORK( INDD2 ), $ RWORK( INDE2 + OFFSET ), SAFMIN, EIGCNT, IIL, IIU, INFO) -* Refine upper bound N that was taken +* Refine upper bound N that was taken MZ = EIGCNT IIL = IIL + 1 ENDIF @@ -710,6 +762,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF WORK( 1 ) = DBLE( LWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF @@ -755,10 +811,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - MYIL + 1 CALL DSTEGR2( JOBZ, 'I', N, RWORK( INDD2 ), $ RWORK( INDE2+OFFSET ), VLL, VUU, MYIL, MYIU, - $ IM, W( 1 ), RWORK( INDRW ), N, + $ IM, W( 1 ), RWORK( INDRW ), N, $ MYIU - MYIL + 1, - $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, + $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, $ DOL, DOU, ZOFFSET, IINFO ) * DSTEGR2 zeroes out the entire W array, so we can't just give * it the part of W we need. So here we copy the W entries into @@ -771,6 +827,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'DSTEGR2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ELSEIF ( WANTZ .AND. NPROCS.EQ.1 ) THEN @@ -783,20 +843,24 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - IIL + 1 CALL DSTEGR2( JOBZ, 'I', N, RWORK( INDD2 ), $ RWORK( INDE2+OFFSET ), VLL, VUU, IIL, IIU, - $ IM, W( 1 ), RWORK( INDRW ), N, + $ IM, W( 1 ), RWORK( INDRW ), N, $ N, - $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, + $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, $ IWORK( 2*N+1 ), SIZE2, DOL, DOU, $ ZOFFSET, IINFO ) ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'DSTEGR2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ELSEIF ( WANTZ ) THEN * Compute representations in parallel. * Share eigenvalue computation for root between all processors -* Then compute the eigenvectors. +* Then compute the eigenvectors. IINFO = 0 * Part 1. compute root representations and root eigenvalues IF ( MYIL.GT.0 ) THEN @@ -804,20 +868,24 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, DOU = MYIU - IIL + 1 CALL DSTEGR2A( JOBZ, 'I', N, RWORK( INDD2 ), $ RWORK( INDE2+OFFSET ), VLL, VUU, IIL, IIU, - $ IM, W( 1 ), RWORK( INDRW ), N, - $ N, RWORK( INDRWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, DOL, + $ IM, W( 1 ), RWORK( INDRW ), N, + $ N, RWORK( INDRWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, DOL, $ DOU, NEEDIL, NEEDIU, $ INDERR, NSPLIT, PIVMIN, SCALE, WL, WU, $ IINFO ) ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'DSTEGR2A', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * The second part of parallel MRRR, the representation tree -* construction begins. Upon successful completion, the +* construction begins. Upon successful completion, the * eigenvectors have been computed. This is indicated by * the flag FINISH. * @@ -836,13 +904,13 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * 2.) POINT2POINT between collaborators (those processors working * jointly on a cluster. * For efficiency, BROADCAST has been disabled. -* At a later stage, other more efficient communication algorithms +* At a later stage, other more efficient communication algorithms * might be implemented, e. g. group or tree-based communication. DOBCST = .FALSE. IF(DOBCST) THEN * First gather everything on the first processor. -* Then use BROADCAST-based communication +* Then use BROADCAST-based communication DO 45 I = 2, NPROCS IF (MYPROC .EQ. (I - 1)) THEN DSTROW = 0 @@ -855,25 +923,25 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI = 0 ENDIF IWORK(2) = LENGTHI - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF (( STARTI.GE.1 ) .AND. ( LENGTHI.GE.1 )) THEN LENGTHI2 = 2*LENGTHI * Copy eigenvalues into communication buffer CALL DCOPY(LENGTHI,W( STARTI ),1, - $ RWORK( INDD ), 1) + $ RWORK( INDD ), 1) * Copy uncertainties into communication buffer CALL DCOPY(LENGTHI,RWORK(IINDERR+STARTI-1),1, - $ RWORK( INDD+LENGTHI ), 1) + $ RWORK( INDD+LENGTHI ), 1) * send buffer - CALL DGESD2D( ICTXT, LENGTHI2, + CALL DGESD2D( ICTXT, LENGTHI2, $ 1, RWORK( INDD ), LENGTHI2, $ DSTROW, DSTCOL ) END IF ELSE IF (MYPROC .EQ. 0) THEN SRCROW = (I-1) / NPCOL SRCCOL = MOD(I-1, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) STARTI = IWORK(1) LENGTHI = IWORK(2) @@ -884,10 +952,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ RWORK(INDD), LENGTHI2, SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL DCOPY( LENGTHI, RWORK(INDD), 1, - $ W( STARTI ), 1) + $ W( STARTI ), 1) * copy uncertainties (errors) from communication buffer CALL DCOPY(LENGTHI,RWORK(INDD+LENGTHI),1, - $ RWORK( IINDERR+STARTI-1 ), 1) + $ RWORK( IINDERR+STARTI-1 ), 1) END IF END IF 45 CONTINUE @@ -895,10 +963,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI2 = LENGTHI * 2 IF (MYPROC .EQ. 0) THEN * Broadcast eigenvalues and errors to all processors - CALL DCOPY(LENGTHI,W ,1, RWORK( INDD ), 1) + CALL DCOPY(LENGTHI,W ,1, RWORK( INDD ), 1) CALL DCOPY(LENGTHI,RWORK( IINDERR ),1, - $ RWORK( INDD+LENGTHI ), 1) - CALL DGEBS2D( ICTXT, 'A', ' ', LENGTHI2, 1, + $ RWORK( INDD+LENGTHI ), 1) + CALL DGEBS2D( ICTXT, 'A', ' ', LENGTHI2, 1, $ RWORK(INDD), LENGTHI2 ) ELSE SRCROW = 0 @@ -907,14 +975,14 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ RWORK(INDD), LENGTHI2, SRCROW, SRCCOL ) CALL DCOPY( LENGTHI, RWORK(INDD), 1, W, 1) CALL DCOPY(LENGTHI,RWORK(INDD+LENGTHI),1, - $ RWORK( IINDERR ), 1) + $ RWORK( IINDERR ), 1) END IF ELSE * Enable point2point communication between collaborators -* Find collaborators of MYPROC +* Find collaborators of MYPROC IF( (NPROCS.GT.1).AND.(MYIL.GT.0) ) THEN - CALL PMPCOL( MYPROC, NPROCS, IIL, NEEDIL, NEEDIU, + CALL PMPCOL( MYPROC, NPROCS, IIL, NEEDIL, NEEDIU, $ IWORK(INDILU), IWORK(INDILU+NPROCS), $ COLBRT, FRSTCL, LASTCL ) ELSE @@ -923,34 +991,34 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, IF(COLBRT) THEN * If the processor collaborates with others, -* communicate information. +* communicate information. DO 47 IPROC = FRSTCL, LASTCL IF (MYPROC .EQ. IPROC) THEN STARTI = DOL IWORK(1) = STARTI LENGTHI = MYIU - MYIL + 1 IWORK(2) = LENGTHI - + IF ((STARTI.GE.1) .AND. (LENGTHI.GE.1)) THEN * Copy eigenvalues into communication buffer CALL DCOPY(LENGTHI,W( STARTI ),1, - $ RWORK(INDD), 1) + $ RWORK(INDD), 1) * Copy uncertainties into communication buffer CALL DCOPY(LENGTHI, $ RWORK( IINDERR+STARTI-1 ),1, - $ RWORK(INDD+LENGTHI), 1) + $ RWORK(INDD+LENGTHI), 1) ENDIF - DO 46 I = FRSTCL, LASTCL + DO 46 I = FRSTCL, LASTCL IF(I.EQ.MYPROC) GOTO 46 DSTROW = I/ NPCOL DSTCOL = MOD(I, NPCOL) - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1) .AND. (LENGTHI.GE.1)) THEN LENGTHI2 = 2*LENGTHI * send buffer - CALL DGESD2D( ICTXT, LENGTHI2, + CALL DGESD2D( ICTXT, LENGTHI2, $ 1, RWORK(INDD), LENGTHI2, $ DSTROW, DSTCOL ) END IF @@ -958,7 +1026,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, ELSE SRCROW = IPROC / NPCOL SRCCOL = MOD(IPROC, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) RSTARTI = IWORK(1) RLENGTHI = IWORK(2) @@ -969,10 +1037,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL DCOPY( RLENGTHI,RWORK(INDE), 1, - $ W( RSTARTI ), 1) + $ W( RSTARTI ), 1) * copy uncertainties (errors) from communication buffer CALL DCOPY(RLENGTHI,RWORK(INDE+RLENGTHI),1, - $ RWORK( IINDERR+RSTARTI-1 ), 1) + $ RWORK( IINDERR+RSTARTI-1 ), 1) END IF END IF 47 CONTINUE @@ -984,17 +1052,17 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * is constructed in parallel from top to bottom, * on level at a time, until all eigenvectors * have been computed. -* +* 100 CONTINUE IF ( MYIL.GT.0 ) THEN CALL DSTEGR2B( JOBZ, N, RWORK( INDD2 ), - $ RWORK( INDE2+OFFSET ), + $ RWORK( INDE2+OFFSET ), $ IM, W( 1 ), RWORK( INDRW ), N, N, - $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, - $ IWORK( 2*N+1 ), SIZE2, DOL, + $ IWORK( 1 ), RWORK( INDRWORK ), SIZE1, + $ IWORK( 2*N+1 ), SIZE2, DOL, $ DOU, NEEDIL, NEEDIU, INDWLC, $ PIVMIN, SCALE, WL, WU, - $ VSTART, FINISH, + $ VSTART, FINISH, $ MAXCLS, NDEPTH, PARITY, ZOFFSET, IINFO ) IINDWLC = INDRWORK + INDWLC - 1 IF(.NOT.FINISH) THEN @@ -1008,7 +1076,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LASTCL = MYPROC ENDIF * -* Check if this processor collaborates, i.e. +* Check if this processor collaborates, i.e. * communication is needed. * IF(COLBRT) THEN @@ -1026,23 +1094,23 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, * Copy eigenvalues into communication buffer CALL DCOPY(LENGTHI, $ RWORK( IINDWLC+STARTI-1 ),1, - $ RWORK(INDD), 1) + $ RWORK(INDD), 1) * Copy uncertainties into communication buffer CALL DCOPY(LENGTHI, $ RWORK( IINDERR+STARTI-1 ),1, - $ RWORK(INDD+LENGTHI), 1) + $ RWORK(INDD+LENGTHI), 1) ENDIF - - DO 146 I = FRSTCL, LASTCL + + DO 146 I = FRSTCL, LASTCL IF(I.EQ.MYPROC) GOTO 146 DSTROW = I/ NPCOL DSTCOL = MOD(I, NPCOL) - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1).AND.(LENGTHI.GE.1)) THEN LENGTHI2 = 2*LENGTHI * send buffer - CALL DGESD2D( ICTXT, LENGTHI2, + CALL DGESD2D( ICTXT, LENGTHI2, $ 1, RWORK(INDD), LENGTHI2, $ DSTROW, DSTCOL ) END IF @@ -1050,7 +1118,7 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, ELSE SRCROW = IPROC / NPCOL SRCCOL = MOD(IPROC, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) RSTARTI = IWORK(1) RLENGTHI = IWORK(2) @@ -1061,19 +1129,23 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, $ SRCROW, SRCCOL ) * copy eigenvalues from communication buffer CALL DCOPY(RLENGTHI,RWORK(INDE), 1, - $ RWORK( IINDWLC+RSTARTI-1 ), 1) + $ RWORK( IINDWLC+RSTARTI-1 ), 1) * copy uncertainties (errors) from communication buffer CALL DCOPY(RLENGTHI,RWORK(INDE+RLENGTHI), - $ 1,RWORK( IINDERR+RSTARTI-1 ), 1) + $ 1,RWORK( IINDERR+RSTARTI-1 ), 1) END IF END IF 147 CONTINUE ENDIF - GOTO 100 + GOTO 100 ENDIF ENDIF IF (IINFO .NE. 0) THEN CALL PXERBLA( ICTXT, 'DSTEGR2B', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1106,17 +1178,17 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, LENGTHI = 0 ENDIF IWORK(2) = LENGTHI - CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, + CALL IGESD2D( ICTXT, 2, 1, IWORK, 2, $ DSTROW, DSTCOL ) IF ((STARTI.GE.1).AND.(LENGTHI.GE.1)) THEN - CALL DGESD2D( ICTXT, LENGTHI, + CALL DGESD2D( ICTXT, LENGTHI, $ 1, W( STARTI ), LENGTHI, $ DSTROW, DSTCOL ) ENDIF ELSE IF (MYPROC .EQ. 0) THEN SRCROW = (I-1) / NPCOL SRCCOL = MOD(I-1, NPCOL) - CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, + CALL IGERV2D( ICTXT, 2, 1, IWORK, 2, $ SRCROW, SRCCOL ) STARTI = IWORK(1) LENGTHI = IWORK(2) @@ -1151,12 +1223,16 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, CALL DLASRT2( 'I', M, W, IWORK( NPROCS+2 ), IINFO ) IF (IINFO.NE.0) THEN CALL PXERBLA( ICTXT, 'DLASRT2', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF *********************************************************************** * -* TRANSFORM Z FROM 1D WORKSPACE INTO 2D BLOCKCYCLIC STORAGE +* TRANSFORM Z FROM 1D WORKSPACE INTO 2D BLOCKCYCLIC STORAGE * *********************************************************************** IF ( WANTZ ) THEN @@ -1178,11 +1254,11 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, 180 CONTINUE IF ( FIRST ) THEN - CALL PZLAEVSWP(N, RWORK( INDRW ), N, Z, IZ, JZ, - $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), RWORK( INDRWORK ), + CALL PZLAEVSWP(N, RWORK( INDRW ), N, Z, IZ, JZ, + $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), RWORK( INDRWORK ), $ SIZE1 ) ELSE - CALL PZLAEVSWP(N, RWORK( INDRW + N ), N, Z, IZ, JZ, + CALL PZLAEVSWP(N, RWORK( INDRW + N ), N, Z, IZ, JZ, $ DESCZ, IWORK( 1 ), IWORK( NPROCS+M+2 ), RWORK( INDRWORK ), $ SIZE1 ) END IF @@ -1202,6 +1278,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, END IF IF (IINFO.NE.0) THEN CALL PXERBLA( ICTXT, 'PZUNMTR', -IINFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1212,6 +1292,10 @@ SUBROUTINE PZHEEVR( JOBZ, RANGE, UPLO, N, A, IA, JA, RWORK( 1 ) = DBLE( LRWOPT ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEEVR diff --git a/SRC/pzheevx.f b/SRC/pzheevx.f index e09d80b0..5996f9d5 100644 --- a/SRC/pzheevx.f +++ b/SRC/pzheevx.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, $ VU, IL, IU, ABSTOL, M, NZ, W, ORFAC, Z, IZ, $ JZ, DESCZ, WORK, LWORK, RWORK, LRWORK, IWORK, @@ -8,6 +14,7 @@ SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO INTEGER IA, IL, INFO, IU, IZ, JA, JZ, LIWORK, LRWORK, @@ -517,10 +524,49 @@ SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IL, + $ INFO, IU, IZ, JA, JZ, LIWORK, LRWORK, + $ LWORK, M, N, NZ, + $ ABSTOL, ORFAC, VL, VU, eos_str + 102 FORMAT('PZHEEVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I9,', IL:',I9, + $ ', INFO:',I9,', IU:',I9,', IZ:',I9, + $ ', JA:',I9,', JZ:',I9,', LIWORK:',I9, + $ ', LRWORK:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NZ:',I9,', ABSTOL:',F9.4, + $ ', ORFAC:',F9.4,', VL:',F9.4, + $ ', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file * + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF +* +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F QUICKRETURN = ( N.EQ.0 ) * * Test the input arguments. @@ -761,13 +807,25 @@ SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHEEVX', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F IF( QUICKRETURN ) THEN IF( WANTZ ) THEN NZ = 0 @@ -777,6 +835,10 @@ SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, WORK( 1 ) = DCMPLX( LWOPT ) RWORK( 1 ) = DBLE( LRWMIN ) IWORK( 1 ) = LIWMIN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -997,6 +1059,10 @@ SUBROUTINE PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, VL, RWORK( 1 ) = DBLE( LRWOPT ) IWORK( 1 ) = LIWMIN * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEEVX diff --git a/SRC/pzhegs2.f b/SRC/pzhegs2.f index 6f10d3eb..a8985fa2 100644 --- a/SRC/pzhegs2.f +++ b/SRC/pzhegs2.f @@ -1,4 +1,10 @@ * +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZHEGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, INFO ) @@ -8,6 +14,7 @@ SUBROUTINE PZHEGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, N @@ -193,9 +200,37 @@ SUBROUTINE PZHEGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, EXTERNAL LSAME, INDXG2P * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, eos_str + 102 FORMAT('PZHEGS2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', IBTYPE:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -255,13 +290,22 @@ SUBROUTINE PZHEGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHEGS2', -INFO ) CALL BLACS_EXIT( ICTXT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. ( MYROW.NE.IAROW .OR. MYCOL.NE.IACOL ) ) - $ RETURN + IF( N.EQ.0 .OR. ( MYROW.NE.IAROW .OR. MYCOL.NE.IACOL ) ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -426,6 +470,10 @@ SUBROUTINE PZHEGS2( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEGS2 diff --git a/SRC/pzhegst.f b/SRC/pzhegst.f index 979ca510..51dd7ee1 100644 --- a/SRC/pzhegst.f +++ b/SRC/pzhegst.f @@ -1,4 +1,10 @@ * +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, INFO ) @@ -8,6 +14,7 @@ SUBROUTINE PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, N @@ -200,9 +207,37 @@ SUBROUTINE PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, EXTERNAL LSAME, ICEIL, INDXG2P * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, N, SCALE, eos_str + 102 FORMAT('PZHEGST inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', IBTYPE:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', N:',I9,', SCALE:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -271,13 +306,22 @@ SUBROUTINE PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHEGST', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( IBTYPE.EQ.1 ) THEN IF( UPPER ) THEN @@ -436,6 +480,10 @@ SUBROUTINE PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEGST diff --git a/SRC/pzhegvx.f b/SRC/pzhegvx.f index d0926364..ed290e5a 100644 --- a/SRC/pzhegvx.f +++ b/SRC/pzhegvx.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, $ DESCA, B, IB, JB, DESCB, VL, VU, IL, IU, $ ABSTOL, M, NZ, W, ORFAC, Z, IZ, JZ, DESCZ, @@ -9,6 +15,7 @@ SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO INTEGER IA, IB, IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ, @@ -532,9 +539,46 @@ SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, $ SQRT * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) JOBZ, RANGE, UPLO, IA, IB, + $ IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ, + $ LIWORK, LRWORK, + $ LWORK, M, N, NZ, ABSTOL, ORFAC, VL, + $ VU, eos_str + 102 FORMAT('PZHEGVX inputs: ,JOBZ:',A5,', RANGE:',A5, + $ ', UPLO:',A5,', IA:',I9,', IB:',I9, + $ ', IBTYPE:',I9,', IL:',I9,', INFO:',I9, + $ ', IU:',I9,', IZ:',I9,', JA:',I9, + $ ', JB:',I9,', JZ:',I9,', LIWORK:',I9, + $ ', LRWORK:',I9,', LWORK:',I9,', M:',I9, + $ ', N:',I9,', NZ:',I9,', ABSTOL:',F9.4, + $ ', ORFAC:',F9.4,', VL:',F9.4, + $ ', VU:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -760,8 +804,16 @@ SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHEGVX ', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -774,6 +826,10 @@ SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, RWORK( 1 ) = DBLE( LRWOPT ) IFAIL( 1 ) = INFO INFO = IERRNPD +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -829,6 +885,10 @@ SUBROUTINE PZHEGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, IWORK( 1 ) = LIWMIN WORK( 1 ) = DCMPLX( DBLE( LWOPT ) ) RWORK( 1 ) = DBLE( LRWOPT ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHEGVX diff --git a/SRC/pzhengst.f b/SRC/pzhengst.f index a93e6faa..e9a22d11 100644 --- a/SRC/pzhengst.f +++ b/SRC/pzhengst.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, WORK, LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, LWORK, N @@ -240,8 +247,34 @@ SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, INTRINSIC DBLE, DCMPLX, DCONJG, ICHAR, MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, IBTYPE, INFO, + $ JA, JB, LWORK, N, SCALE, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZHENGST inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', IBTYPE:',I9,', INFO:',I9, + $ ', JA:',I9,', JB:',I9,', LWORK:',I9, + $ ', N:',I9,', SCALE:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF SCALE = 1.0D0 * NB = DESCA( MB_ ) @@ -319,20 +352,37 @@ SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHENGST', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * IF( IBTYPE.NE.1 .OR. UPPER .OR. LWORK.LT.LWOPT ) THEN CALL PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB, SCALE, INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -423,5 +473,9 @@ SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, * WORK( 1 ) = DCMPLX( DBLE( LWOPT ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END diff --git a/SRC/pzhentrd.f b/SRC/pzhentrd.f index 7b2b81d2..5f90a285 100644 --- a/SRC/pzhentrd.f +++ b/SRC/pzhentrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHENTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, RWORK, LRWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZHENTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LRWORK, LWORK, N @@ -305,9 +312,37 @@ SUBROUTINE PZHENTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LRWORK, + $ LWORK, N, eos_str + 102 FORMAT('PZHENTRD inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LRWORK:',I9, + $ ', LWORK:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * Get grid parameters * ICTXT = DESCA( CTXT_ ) @@ -382,15 +417,28 @@ SUBROUTINE PZHENTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHENTRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * ONEPMIN = N*N + 3*N + 1 @@ -580,6 +628,10 @@ SUBROUTINE PZHENTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, WORK( 1 ) = DCMPLX( DBLE( TTLWMIN ) ) RWORK( 1 ) = DBLE( TTLRWMIN ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHENTRD diff --git a/SRC/pzhetd2.f b/SRC/pzhetd2.f index 3fd9db2a..80e021ec 100644 --- a/SRC/pzhetd2.f +++ b/SRC/pzhetd2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHETD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZHETD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -250,11 +257,34 @@ SUBROUTINE PZHETD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZHETD2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -285,15 +315,28 @@ SUBROUTINE PZHETD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHETD2', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Compute local information * @@ -481,6 +524,10 @@ SUBROUTINE PZHETD2( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHETD2 diff --git a/SRC/pzhetrd.f b/SRC/pzhetrd.f index 97f8b4db..f6ffcce5 100644 --- a/SRC/pzhetrd.f +++ b/SRC/pzhetrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHETRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZHETRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -256,11 +263,34 @@ SUBROUTINE PZHETRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZHETRD inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * INFO = 0 @@ -310,15 +340,28 @@ SUBROUTINE PZHETRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHETRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN ELSE IF( LQUERY ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP ) CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP ) @@ -421,6 +464,10 @@ SUBROUTINE PZHETRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * WORK( 1 ) = DCMPLX( DBLE( LWMIN ) ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHETRD diff --git a/SRC/pzhettrd.f b/SRC/pzhettrd.f index ad797f45..af4c2f91 100644 --- a/SRC/pzhettrd.f +++ b/SRC/pzhettrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, $ LWORK, INFO ) * @@ -5,6 +11,7 @@ SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, INFO, JA, LWORK, N @@ -461,9 +468,37 @@ SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * * * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, INFO, JA, LWORK, + $ N, eos_str + 102 FORMAT('PZHETTRD inputs: ,UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', LWORK:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * @@ -570,13 +605,22 @@ SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHETTRD', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * * @@ -660,6 +704,10 @@ SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZHETTRD', -INFO ) WORK( 1 ) = DCMPLX( LWMIN ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -1196,6 +1244,10 @@ SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, * * WORK( 1 ) = DCMPLX( LWMIN ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZHETTRD diff --git a/SRC/pzlabrd.f b/SRC/pzlabrd.f index 5ff8e7bc..692c504c 100644 --- a/SRC/pzlabrd.f +++ b/SRC/pzlabrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, $ X, IX, JX, DESCX, Y, IY, JY, DESCY, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IX, IY, JA, JX, JY, M, N, NB * .. @@ -274,10 +281,37 @@ SUBROUTINE PZLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IX, IY, JA, JX, JY, M, + $ N, NB, eos_str + 102 FORMAT('PZLABRD inputs: ,IA:',I9,', IX:',I9,', IY:',I9, + $ ', JA:',I9,', JX:',I9,', JY:',I9, + $ ', M:',I9,', N:',I9,', NB:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -508,6 +542,10 @@ SUBROUTINE PZLABRD( M, N, NB, A, IA, JA, DESCA, D, E, TAUQ, TAUP, 20 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLABRD diff --git a/SRC/pzlacgv.f b/SRC/pzlacgv.f index fed667cc..0dc90cf2 100644 --- a/SRC/pzlacgv.f +++ b/SRC/pzlacgv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INCX, IX, JX, N * .. @@ -131,11 +138,33 @@ SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INCX, IX, JX, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZLACGV inputs: ,INCX:',I9,', IX:',I9, + $ ', JX:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Figure local indexes * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, @@ -146,8 +175,13 @@ SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * * sub( X ) is rowwise distributed. * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ICOFFX = MOD( JX-1, DESCX( NB_ ) ) NQ = NUMROC( N+ICOFFX, DESCX( NB_ ), MYCOL, IXCOL, NPCOL ) IF( MYCOL.EQ.IXCOL ) @@ -165,8 +199,13 @@ SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * * sub( X ) is columnwise distributed. * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFFX = MOD( IX-1, DESCX( MB_ ) ) NP = NUMROC( N+IROFFX, DESCX( MB_ ), MYROW, IXROW, NPROW ) IF( MYROW.EQ.IXROW ) @@ -181,6 +220,10 @@ SUBROUTINE PZLACGV( N, X, IX, JX, DESCX, INCX ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACGV diff --git a/SRC/pzlacon.f b/SRC/pzlacon.f index 5e4a51c4..4e498c71 100644 --- a/SRC/pzlacon.f +++ b/SRC/pzlacon.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, $ KASE ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IV, IX, JV, JX, KASE, N DOUBLE PRECISION EST @@ -184,15 +191,43 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IV, IX, JV, JX, KASE, N, EST, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLACON inputs: ,IV:',I9,', IX:',I9,', JV:',I9, + $ ', JX:',I9,', KASE:',I9,', N:',I9, + $ ', EST:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIVX, JJVX, IVXROW, IVXCOL ) - IF( MYCOL.NE.IVXCOL ) - $ RETURN + IF( MYCOL.NE.IVXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFF = MOD( IX-1, DESCX( MB_ ) ) NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IVXROW, NPROW ) IF( MYROW.EQ.IVXROW ) @@ -206,6 +241,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 10 CONTINUE KASE = 1 JUMP = 1 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -246,6 +285,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 30 CONTINUE KASE = 2 JUMP = 2 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 2) @@ -280,6 +323,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, END IF KASE = 1 JUMP = 3 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 3) @@ -311,6 +358,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 80 CONTINUE KASE = 2 JUMP = 4 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 4) @@ -353,6 +404,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 110 CONTINUE KASE = 1 JUMP = 5 +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * ................ ENTRY (JUMP = 5) @@ -377,6 +432,10 @@ SUBROUTINE PZLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, EST, 130 CONTINUE KASE = 0 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACON diff --git a/SRC/pzlaconsb.f b/SRC/pzlaconsb.f index eca25084..69d32e8a 100644 --- a/SRC/pzlaconsb.f +++ b/SRC/pzlaconsb.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, $ LWORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, L, LWORK, M COMPLEX*16 H33, H43H34, H44 @@ -192,12 +199,37 @@ SUBROUTINE PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) LDA = DESCA( LLD_ ) ULP = PDLAMCH( CONTXT, 'PRECISION' ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, L, LWORK, M, H33, H43H34, + $ H44, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLACONSB inputs: ,I:',I9,', L:',I9,', LWORK:',I9, + $ ', M:',I9,', H33:',F9.4, A, F9.4, + $ ', H43H34:',F9.4, A, F9.4,', H44:',F9.4, A, F9.4, + $ ', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -222,6 +254,10 @@ SUBROUTINE PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, END IF IF( LWORK.LT.7*ISTR2 ) THEN CALL PXERBLA( CONTXT, 'PZLACONSB', 10 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF ISTR3 = 3*ISTR2 @@ -578,6 +614,10 @@ SUBROUTINE PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34, BUF, * CALL IGAMX2D( CONTXT, 'ALL', ' ', 1, 1, M, 1, L, L, -1, -1, -1 ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACONSB diff --git a/SRC/pzlacp2.f b/SRC/pzlacp2.f index 65cedf2c..1501996e 100644 --- a/SRC/pzlacp2.f +++ b/SRC/pzlacp2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -5,6 +11,7 @@ SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -168,8 +175,35 @@ SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PZLACP2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', JA:',I9,', JB:',I9,', M:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -228,8 +262,13 @@ SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYCOL.EQ.IACOL ) THEN * MP = NUMROC( M+IROFFA, MBA, MYROW, IAROW, NPROW ) - IF( MP.LE.0 ) - $ RETURN + IF( MP.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYROW.EQ.IAROW ) $ MP = MP - IROFFA MYDIST = MOD( MYROW-IAROW+NPROW, NPROW ) @@ -326,8 +365,13 @@ SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, IF( MYROW.EQ.IAROW ) THEN * NQ = NUMROC( N+ICOFFA, NBA, MYCOL, IACOL, NPCOL ) - IF( NQ.LE.0 ) - $ RETURN + IF( NQ.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYCOL.EQ.IACOL ) $ NQ = NQ - ICOFFA MYDIST = MOD( MYCOL-IACOL+NPCOL, NPCOL ) @@ -398,6 +442,10 @@ SUBROUTINE PZLACP2( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACP2 diff --git a/SRC/pzlacp3.f b/SRC/pzlacp3.f index aa9b9ccd..76ae06b8 100644 --- a/SRC/pzlacp3.f +++ b/SRC/pzlacp3.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, II, JJ, LDB, M, REV * .. @@ -161,8 +168,33 @@ SUBROUTINE PZLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) * .. * .. Executable Statements .. * - IF( M.LE.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, II, JJ, LDB, M, REV, eos_str + 102 FORMAT('PZLACP3 inputs: ,I:',I9,', II:',I9,', JJ:',I9, + $ ', LDB:',I9,', M:',I9,', REV:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) @@ -305,6 +337,10 @@ SUBROUTINE PZLACP3( M, I, A, DESCA, B, LDB, II, JJ, REV ) IF( IDJ.LE.IFIN ) $ GO TO 30 END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACP3 diff --git a/SRC/pzlacpy.f b/SRC/pzlacpy.f index 8eade09a..b1226bc0 100644 --- a/SRC/pzlacpy.f +++ b/SRC/pzlacpy.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, $ DESCB ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IB, JA, JB, M, N @@ -162,8 +169,35 @@ SUBROUTINE PZLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IB, JA, JB, M, N, + $ eos_str + 102 FORMAT('PZLACPY inputs: ,UPLO:',A5,', IA:',I9, + $ ', IB:',I9,', JA:',I9,', JB:',I9,', M:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IN = MIN( ICEIL( IA, DESCA( MB_ ) ) * DESCA( MB_ ), IA+M-1 ) JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) @@ -224,6 +258,10 @@ SUBROUTINE PZLACPY( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLACPY diff --git a/SRC/pzlaevswp.f b/SRC/pzlaevswp.f index 53cb4175..96446b1b 100644 --- a/SRC/pzlaevswp.f +++ b/SRC/pzlaevswp.f @@ -1,4 +1,10 @@ * +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE PZLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, $ RWORK, LRWORK ) @@ -8,6 +14,7 @@ SUBROUTINE PZLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, * and University of California, Berkeley. * April 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IZ, JZ, LDZI, LRWORK, N * .. @@ -154,9 +161,35 @@ SUBROUTINE PZLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, INTRINSIC DCMPLX, MAX, MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IZ, JZ, LDZI, LRWORK, N, eos_str + 102 FORMAT('PZLAEVSWP inputs: ,IZ:',I9,', JZ:',I9, + $ ', LDZI:',I9,', LRWORK:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF CALL BLACS_GRIDINFO( DESCZ( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) IAM = MYROW + MYCOL*NPROW IAM = MYROW*NPCOL + MYCOL @@ -280,6 +313,10 @@ SUBROUTINE PZLAEVSWP( N, ZIN, LDZI, Z, IZ, JZ, DESCZ, NVS, KEY, 100 CONTINUE * 110 CONTINUE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAEVSWP diff --git a/SRC/pzlahqr.f b/SRC/pzlahqr.f index b715455c..02ae574e 100644 --- a/SRC/pzlahqr.f +++ b/SRC/pzlahqr.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, $ IHIZ, Z, DESCZ, WORK, LWORK, IWORK, ILWORK, $ INFO ) @@ -9,6 +15,7 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, * modification suggested by Mark Fahey and Greg Henry * 1.7.0: July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. LOGICAL WANTT, WANTZ INTEGER IHI, IHIZ, ILO, ILOZ, ILWORK, INFO, LWORK, N @@ -308,12 +315,40 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) WANTT, WANTZ, IHI, IHIZ, ILO, + $ ILOZ, ILWORK, INFO, LWORK, N, eos_str + 102 FORMAT('PZLAHQR inputs: ,WANTT:',L1,', WANTZ:',L1, + $ ', IHI:',I9,', IHIZ:',I9,', ILO:',I9, + $ ', ILOZ:',I9,', ILWORK:',I9,', INFO:',I9, + $ ', LWORK:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * INFO = 0 * ITERMAX = 30*( IHI-ILO+1 ) - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * NODE (IAFIRST,JAFIRST) OWNS A(1,1) * @@ -348,6 +383,10 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, JJ = JJ + MAX( 2*N, ( 8*LCMRC+2 )**2 ) IF( LWORK.EQ.-1 ) THEN WORK( 1 ) = JJ +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF IF( LWORK.LT.JJ ) THEN @@ -384,6 +423,10 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, $ -1, -1 ) IF( INFO.LT.0 ) THEN CALL PXERBLA( CONTXT, 'PZLAHQR', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -411,6 +454,10 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, ELSE W( ILO ) = ZERO END IF +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -2465,6 +2512,10 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, * Failure to converge in remaining number of iterations * INFO = I +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * 550 CONTINUE @@ -2543,6 +2594,10 @@ SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ, * 570 CONTINUE CALL ZGSUM2D( CONTXT, 'All', ' ', N, 1, W, N, -1, -1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * END OF PZLAHQR diff --git a/SRC/pzlahrd.f b/SRC/pzlahrd.f index 5cf94742..647f8ea2 100644 --- a/SRC/pzlahrd.f +++ b/SRC/pzlahrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, $ DESCY, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IY, JA, JY, K, N, NB * .. @@ -161,10 +168,36 @@ SUBROUTINE PZLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IY, JA, JY, K, N, NB, eos_str + 102 FORMAT('PZLAHRD inputs: ,IA:',I9,', IY:',I9,', JA:',I9, + $ ', JY:',I9,', K:',I9,', N:',I9, + $ ', NB:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.1 ) - $ RETURN + IF( N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -283,6 +316,10 @@ SUBROUTINE PZLAHRD( N, K, NB, A, IA, JA, DESCA, TAU, T, Y, IY, JY, * CALL PZELSET( A, K+NB+IA-1, J, DESCA, EI ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAHRD diff --git a/SRC/pzlamr1d.f b/SRC/pzlamr1d.f index 16e02697..dfdde8d8 100644 --- a/SRC/pzlamr1d.f +++ b/SRC/pzlamr1d.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) * and University of California, Berkeley. * October 15, 1999 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, IB, JA, JB, N * .. @@ -106,14 +113,45 @@ SUBROUTINE PZLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) EXTERNAL NUMROC * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, IB, JA, JB, N, eos_str + 102 FORMAT('PZLAMR1D inputs: ,IA:',I9,', IB:',I9,', JA:',I9, + $ ', JB:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * This is just to keep ftnchek and toolpack/1 happy IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_* - $ RSRC_.LT.0 )RETURN + $ RSRC_.LT.0 )THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * DO 10 I = 1, DLEN_ DESCAA( I ) = DESCA( I ) @@ -137,6 +175,10 @@ SUBROUTINE PZLAMR1D( N, A, IA, JA, DESCA, B, IB, JB, DESCB ) CALL ZGEBR2D( ICTXT, 'C', ' ', NQ, 1, B, NQ, 0, MYCOL ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAMR1D diff --git a/SRC/pzlange.f b/SRC/pzlange.f index 4ae08772..8d9ccb31 100644 --- a/SRC/pzlange.f +++ b/SRC/pzlange.f @@ -1,5 +1,12 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* DOUBLE PRECISION FUNCTION PZLANGE( NORM, M, N, A, IA, JA, DESCA, $ WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -178,10 +185,33 @@ DOUBLE PRECISION FUNCTION PZLANGE( NORM, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, JA, M, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', IA:',I9,', JA:',I9, + $ ', M:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, JJ, $ IAROW, IACOL ) @@ -333,6 +363,10 @@ DOUBLE PRECISION FUNCTION PZLANGE( NORM, M, N, A, IA, JA, DESCA, * PZLANGE = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLANGE diff --git a/SRC/pzlanhe.f b/SRC/pzlanhe.f index d6cc5804..b52f5d23 100644 --- a/SRC/pzlanhe.f +++ b/SRC/pzlanhe.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* DOUBLE PRECISION FUNCTION PZLANHE( NORM, UPLO, N, A, IA, JA, $ DESCA, WORK ) * @@ -6,6 +12,7 @@ DOUBLE PRECISION FUNCTION PZLANHE( NORM, UPLO, N, A, IA, JA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER IA, JA, N @@ -195,10 +202,33 @@ DOUBLE PRECISION FUNCTION PZLANHE( NORM, UPLO, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters and local indexes. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, UPLO, IA, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, $ IIA, JJA, IAROW, IACOL ) * @@ -942,6 +972,10 @@ DOUBLE PRECISION FUNCTION PZLANHE( NORM, UPLO, N, A, IA, JA, * PZLANHE = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLANHE diff --git a/SRC/pzlanhs.f b/SRC/pzlanhs.f index 5e26cff2..46132925 100644 --- a/SRC/pzlanhs.f +++ b/SRC/pzlanhs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* DOUBLE PRECISION FUNCTION PZLANHS( NORM, N, A, IA, JA, DESCA, $ WORK ) * @@ -6,6 +12,7 @@ DOUBLE PRECISION FUNCTION PZLANHS( NORM, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER NORM INTEGER IA, JA, N @@ -172,10 +179,32 @@ DOUBLE PRECISION FUNCTION PZLANHS( NORM, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, IA, JA, N, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', IA:',I9,', JA:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, $ IAROW, IACOL ) @@ -734,6 +763,10 @@ DOUBLE PRECISION FUNCTION PZLANHS( NORM, N, A, IA, JA, DESCA, * PZLANHS = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLANHS diff --git a/SRC/pzlansy.f b/SRC/pzlansy.f index 4f1807d6..d6a1e9cd 100644 --- a/SRC/pzlansy.f +++ b/SRC/pzlansy.f @@ -1,5 +1,12 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* DOUBLE PRECISION FUNCTION PZLANSY( NORM, UPLO, N, A, IA, JA, $ DESCA, WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -196,10 +203,33 @@ DOUBLE PRECISION FUNCTION PZLANSY( NORM, UPLO, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters and local indexes. * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) NORM, UPLO, IA, JA, N, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,NORM:',A5,', UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', N:',I9,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, $ IIA, JJA, IAROW, IACOL ) * @@ -858,6 +888,10 @@ DOUBLE PRECISION FUNCTION PZLANSY( NORM, UPLO, N, A, IA, JA, * PZLANSY = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLANSY diff --git a/SRC/pzlantr.f b/SRC/pzlantr.f index 82cf76a8..87a4294a 100644 --- a/SRC/pzlantr.f +++ b/SRC/pzlantr.f @@ -1,5 +1,12 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* DOUBLE PRECISION FUNCTION PZLANTR( NORM, UPLO, DIAG, M, N, A, $ IA, JA, DESCA, WORK ) + USE LINK_TO_C_GLOBALS IMPLICIT NONE * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -194,10 +201,33 @@ DOUBLE PRECISION FUNCTION PZLANTR( NORM, UPLO, DIAG, M, N, A, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORM, UPLO, IA, JA, M, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT(' inputs: ,DIAG:',A5,', NORM:',A5,', UPLO:',A5, + $ ', IA:',I9,', JA:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * UDIAG = LSAME( DIAG, 'U' ) CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, JJA, @@ -1098,6 +1128,10 @@ DOUBLE PRECISION FUNCTION PZLANTR( NORM, UPLO, DIAG, M, N, A, * PZLANTR = VALUE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLANTR diff --git a/SRC/pzlapiv.f b/SRC/pzlapiv.f index 7e988743..22276edc 100644 --- a/SRC/pzlapiv.f +++ b/SRC/pzlapiv.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, $ DESCA, IPIV, IP, JP, DESCIP, IWORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * and University of California, Berkeley. * November 15, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER*1 DIREC, PIVROC, ROWCOL INTEGER IA, IP, JA, JP, M, N @@ -224,17 +231,47 @@ SUBROUTINE PZLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, PIVROC, ROWCOL, IA, + $ IP, JA, JP, M, N, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT('PZLAPIV inputs: ,DIREC:',A2,', PIVROC:',A2, + $ ', ROWCOL:',A2,', IA:',I9,', IP:',I9, + $ ', JA:',I9,', JP:',I9,', M:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF ROWPVT = LSAME( ROWCOL, 'R' ) * * If we're pivoting the rows of sub( A ) * IF( ROWPVT ) THEN - IF( M.LE.1 .OR. N.LT.1 ) - $ RETURN + IF( M.LE.1 .OR. N.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * If the pivot vector is already distributed correctly * @@ -293,8 +330,13 @@ SUBROUTINE PZLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, * Otherwise, we're pivoting the columns of sub( A ) * ELSE - IF( M.LT.1 .OR. N.LE.1 ) - $ RETURN + IF( M.LT.1 .OR. N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * If the pivot vector is already distributed correctly * @@ -349,6 +391,10 @@ SUBROUTINE PZLAPIV( DIREC, ROWCOL, PIVROC, M, N, A, IA, JA, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAPIV diff --git a/SRC/pzlapv2.f b/SRC/pzlapv2.f index c2e46cb5..34004285 100644 --- a/SRC/pzlapv2.f +++ b/SRC/pzlapv2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, $ IP, JP, DESCIP ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIREC, ROWCOL INTEGER IA, IP, JA, JP, M, N @@ -168,14 +175,46 @@ SUBROUTINE PZLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, INTRINSIC MIN, MOD * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, IP, JA, + $ JP, M, N, eos_str + 102 FORMAT('PZLAPV2 inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I9,', IP:',I9,', JA:',I9, + $ ', JP:',I9,', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF * ROWPVT = LSAME( ROWCOL, 'R' ) IF( ROWPVT ) THEN - IF( M.LE.1 .OR. N.LT.1 ) - $ RETURN + IF( M.LE.1 .OR. N.LT.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ELSE - IF( M.LT.1 .OR. N.LE.1 ) - $ RETURN + IF( M.LT.1 .OR. N.LE.1 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF END IF FORWRD = LSAME( DIREC, 'F' ) * @@ -406,6 +445,10 @@ SUBROUTINE PZLAPV2( DIREC, ROWCOL, M, N, A, IA, JA, DESCA, IPIV, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PZLAPV2 diff --git a/SRC/pzlaqge.f b/SRC/pzlaqge.f index 79d9ff75..6d9754dc 100644 --- a/SRC/pzlaqge.f +++ b/SRC/pzlaqge.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, $ AMAX, EQUED ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED INTEGER IA, JA, M, N @@ -180,10 +187,36 @@ SUBROUTINE PZLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, IA, JA, M, N, AMAX, + $ COLCND, ROWCND, eos_str + 102 FORMAT('PZLAQGE inputs: ,EQUED:',A5,', IA:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', AMAX:',F9.4, + $ ', COLCND:',F9.4,', ROWCND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) THEN EQUED = 'N' +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -264,6 +297,10 @@ SUBROUTINE PZLAQGE( M, N, A, IA, JA, DESCA, R, C, ROWCND, COLCND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAQGE diff --git a/SRC/pzlaqsy.f b/SRC/pzlaqsy.f index 272f3c9f..299828f5 100644 --- a/SRC/pzlaqsy.f +++ b/SRC/pzlaqsy.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, $ AMAX, EQUED ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER EQUED, UPLO INTEGER IA, JA, N @@ -182,10 +189,36 @@ SUBROUTINE PZLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) EQUED, UPLO, IA, JA, N, AMAX, + $ SCOND, eos_str + 102 FORMAT('PZLAQSY inputs: ,EQUED:',A5,', UPLO:',A5, + $ ', IA:',I9,', JA:',I9,', N:',I9,', AMAX:',F9.4, + $ ', SCOND:',F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * IF( N.LE.0 ) THEN EQUED = 'N' +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -353,6 +386,10 @@ SUBROUTINE PZLAQSY( UPLO, N, A, IA, JA, DESCA, SR, SC, SCOND, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAQSY diff --git a/SRC/pzlarf.f b/SRC/pzlarf.f index 7bff2875..167152c1 100644 --- a/SRC/pzlarf.f +++ b/SRC/pzlarf.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, $ C, IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, M, N @@ -260,10 +267,37 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ M, N, eos_str + 102 FORMAT('PZLARF inputs: ,SIDE:',A5,', IC:',I9,', INCV:',I9, + $ ', IV:',I9,', JC:',I9,', JV:',I9, + $ ', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -807,6 +841,10 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARF diff --git a/SRC/pzlarfb.f b/SRC/pzlarfb.f index 8a9e375c..58510452 100644 --- a/SRC/pzlarfb.f +++ b/SRC/pzlarfb.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, $ JV, DESCV, T, C, IC, JC, DESCC, WORK ) * @@ -5,6 +11,7 @@ SUBROUTINE PZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE, TRANS, DIRECT, STOREV INTEGER IC, IV, JC, JV, K, M, N @@ -250,10 +257,38 @@ SUBROUTINE PZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, TRANS, DIRECT, STOREV, + $ IC, IV, JC, JV, K, M, N, eos_str + 102 FORMAT('PZLARFB inputs: ,SIDE:',A5,', TRANS:',A5, + $ ', DIRECT:',A5,', STOREV:',A5,', IC:',I9, + $ ', IV:',I9,', JC:',I9,', JV:',I9, + $ ', K:',I9,', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -881,6 +916,10 @@ SUBROUTINE PZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, IV, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARFB diff --git a/SRC/pzlarfc.f b/SRC/pzlarfc.f index ddd7ec6a..ff45e6e7 100644 --- a/SRC/pzlarfc.f +++ b/SRC/pzlarfc.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, $ C, IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, M, N @@ -260,10 +267,37 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ M, N, eos_str + 102 FORMAT('PZLARFC inputs: ,SIDE:',A5,', IC:',I9, + $ ', INCV:',I9,', IV:',I9,', JC:',I9,', JV:',I9, + $ ', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -803,6 +837,10 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARFC diff --git a/SRC/pzlarfg.f b/SRC/pzlarfg.f index 89b8f8d3..8e78cacb 100644 --- a/SRC/pzlarfg.f +++ b/SRC/pzlarfg.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, $ TAU ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IAX, INCX, IX, JAX, JX, N COMPLEX*16 ALPHA @@ -172,10 +179,34 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IAX, INCX, IX, JAX, JX, N, + $ ALPHA, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLARFG inputs: ,IAX:',I9,', INCX:',I9, + $ ', IX:',I9,', JAX:',I9,', JX:',I9,', N:',I9, + $ ', ALPHA:',F9.4, A, F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( INCX.EQ.DESCX( M_ ) ) THEN * @@ -184,8 +215,13 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, CALL INFOG2L( IX, JAX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIAX, JJAX, IXROW, IXCOL ) * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Broadcast X(IAX,JAX) across the process row. * @@ -207,8 +243,13 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, CALL INFOG2L( IAX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, $ IIAX, JJAX, IXROW, IXCOL ) * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Broadcast X(IAX,JAX) across the process column. * @@ -227,6 +268,10 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, * IF( N.LE.0 ) THEN TAU( INDXTAU ) = ZERO +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -296,6 +341,10 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARFG diff --git a/SRC/pzlarft.f b/SRC/pzlarft.f index 10b45c1b..502310d5 100644 --- a/SRC/pzlarft.f +++ b/SRC/pzlarft.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, $ T, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, STOREV INTEGER IV, JV, K, N @@ -200,10 +207,37 @@ SUBROUTINE PZLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, + $ N, eos_str + 102 FORMAT('PZLARFT inputs: ,DIRECT:',A5,', STOREV:',A5, + $ ', IV:',I9,', JV:',I9,', K:',I9, + $ ', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCV( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -536,6 +570,10 @@ SUBROUTINE PZLARFT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARFT diff --git a/SRC/pzlarz.f b/SRC/pzlarz.f index abf62886..44f7d4d6 100644 --- a/SRC/pzlarz.f +++ b/SRC/pzlarz.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, $ IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, L, M, N @@ -269,10 +276,37 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ L, M, N, eos_str + 102 FORMAT('PZLARZ inputs: ,SIDE:',A5,', IC:',I9,', INCV:',I9, + $ ', IV:',I9,', JC:',I9,', JV:',I9, + $ ', L:',I9,', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -909,6 +943,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARZ diff --git a/SRC/pzlarzb.f b/SRC/pzlarzb.f index 45cd672f..e5b859c9 100644 --- a/SRC/pzlarzb.f +++ b/SRC/pzlarzb.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, $ IV, JV, DESCV, T, C, IC, JC, DESCC, WORK ) * @@ -5,6 +11,7 @@ SUBROUTINE PZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver * May 1 2012 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS INTEGER IC, IV, JC, JV, K, L, M, N @@ -256,10 +263,38 @@ SUBROUTINE PZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, SIDE, STOREV, TRANS, + $ IC, IV, JC, JV, K, L, M, N, eos_str + 102 FORMAT('PZLARZB inputs: ,DIRECT:',A5,', SIDE:',A5, + $ ', STOREV:',A5,', TRANS:',A5,', IC:',I9, + $ ', IV:',I9,', JC:',I9,', JV:',I9, + $ ', K:',I9,', L:',I9,', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -277,6 +312,10 @@ SUBROUTINE PZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZLARZB', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -618,6 +657,10 @@ SUBROUTINE PZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARZB diff --git a/SRC/pzlarzc.f b/SRC/pzlarzc.f index 2c574ff5..63f27b09 100644 --- a/SRC/pzlarzc.f +++ b/SRC/pzlarzc.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, $ IC, JC, DESCC, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * and University of California, Berkeley. * May 25, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER SIDE INTEGER IC, INCV, IV, JC, JV, L, M, N @@ -269,10 +276,37 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) SIDE, IC, INCV, IV, JC, JV, + $ L, M, N, eos_str + 102 FORMAT('PZLARZC inputs: ,SIDE:',A5,', IC:',I9, + $ ', INCV:',I9,', IV:',I9,', JC:',I9,', JV:',I9, + $ ', L:',I9,', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN + IF( M.LE.0 .OR. N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters. * @@ -911,6 +945,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARZC diff --git a/SRC/pzlarzt.f b/SRC/pzlarzt.f index 59769283..0ef9cdbb 100644 --- a/SRC/pzlarzt.f +++ b/SRC/pzlarzt.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, $ T, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIRECT, STOREV INTEGER IV, JV, K, N @@ -211,11 +218,34 @@ SUBROUTINE PZLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCV( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIRECT, STOREV, IV, JV, K, + $ N, NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLARZT inputs: ,DIRECT:',A5,', STOREV:',A5, + $ ', IV:',I9,', JV:',I9,', K:',I9, + $ ', N:',I9,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Check for currently supported options * INFO = 0 @@ -227,6 +257,10 @@ SUBROUTINE PZLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZLARZT', -INFO ) CALL BLACS_ABORT( ICTXT, 1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -294,6 +328,10 @@ SUBROUTINE PZLARZT( DIRECT, STOREV, N, K, V, IV, JV, DESCV, TAU, * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLARZT diff --git a/SRC/pzlascl.f b/SRC/pzlascl.f index 91f08987..3c3769f4 100644 --- a/SRC/pzlascl.f +++ b/SRC/pzlascl.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, $ INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER TYPE INTEGER IA, INFO, JA, M, N @@ -163,11 +170,36 @@ SUBROUTINE PZLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) TYPE, IA, INFO, JA, M, N, CFROM, + $ CTO, NPROW, NPCOL, MYROW, MYCOL, + $ eos_str + 102 FORMAT('PZLASCL inputs: ,TYPE:',A5,', IA:',I9, + $ ', INFO:',I9,', JA:',I9,', M:',I9,', N:',I9, + $ ', CFROM:',F9.4,', CTO:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Test the input parameters * IF( NPROW.EQ.-1 ) THEN @@ -199,13 +231,22 @@ SUBROUTINE PZLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, * IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PZLASCL', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN + IF( N.EQ.0 .OR. M.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get machine parameters * @@ -521,6 +562,10 @@ SUBROUTINE PZLASCL( TYPE, CFROM, CTO, M, N, A, IA, JA, DESCA, IF( .NOT.DONE ) $ GO TO 10 * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLASCL diff --git a/SRC/pzlase2.f b/SRC/pzlase2.f index fb89012c..23c881c1 100644 --- a/SRC/pzlase2.f +++ b/SRC/pzlase2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, M, N @@ -156,8 +163,35 @@ SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PZLASE2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', ALPHA:',F9.4, A, F9.4, + $ ', BETA:',F9.4, A, F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -212,8 +246,13 @@ SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) IF( MYCOL.EQ.IACOL ) THEN * MPA = NUMROC( M+IROFFA, MBA, MYROW, IAROW, NPROW ) - IF( MPA.LE.0 ) - $ RETURN + IF( MPA.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYROW.EQ.IAROW ) $ MPA = MPA - IROFFA MYDIST = MOD( MYROW-IAROW+NPROW, NPROW ) @@ -321,8 +360,13 @@ SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) IF( MYROW.EQ.IAROW ) THEN * NQA = NUMROC( N+ICOFFA, NBA, MYCOL, IACOL, NPCOL ) - IF( NQA.LE.0 ) - $ RETURN + IF( NQA.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IF( MYCOL.EQ.IACOL ) $ NQA = NQA - ICOFFA MYDIST = MOD( MYCOL-IACOL+NPCOL, NPCOL ) @@ -404,6 +448,10 @@ SUBROUTINE PZLASE2( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLASE2 diff --git a/SRC/pzlaset.f b/SRC/pzlaset.f index 2d50d72b..6c51bf74 100644 --- a/SRC/pzlaset.f +++ b/SRC/pzlaset.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, M, N @@ -151,8 +158,35 @@ SUBROUTINE PZLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, M, N, ALPHA, + $ BETA, eos_str + 102 FORMAT('PZLASET inputs: ,UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', M:',I9,', N:',I9,', ALPHA:',F9.4, A, F9.4, + $ ', BETA:',F9.4, A, F9.4, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( M.LE.( DESCA( MB_ ) - MOD( IA-1, DESCA( MB_ ) ) ) .OR. $ N.LE.( DESCA( NB_ ) - MOD( JA-1, DESCA( NB_ ) ) ) ) THEN @@ -213,6 +247,10 @@ SUBROUTINE PZLASET( UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLASET diff --git a/SRC/pzlasmsub.f b/SRC/pzlasmsub.f index 969514e3..85ca437b 100644 --- a/SRC/pzlasmsub.f +++ b/SRC/pzlasmsub.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER I, K, L, LWORK DOUBLE PRECISION SMLNUM @@ -175,12 +182,35 @@ SUBROUTINE PZLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) LDA = DESCA( LLD_ ) ULP = PDLAMCH( CONTXT, 'PRECISION' ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) I, K, L, LWORK, SMLNUM, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLASMSUB inputs: ,I:',I9,', K:',I9,', L:',I9, + $ ', LWORK:',I9,', SMLNUM:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -204,6 +234,10 @@ SUBROUTINE PZLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) * * Error! * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF CALL INFOG2L( I, I, DESCA, NPROW, NPCOL, MYROW, MYCOL, IROW1, @@ -370,6 +404,10 @@ SUBROUTINE PZLASMSUB( A, DESCA, I, L, K, SMLNUM, BUF, LWORK ) 50 CONTINUE CALL IGAMX2D( CONTXT, 'ALL', ' ', 1, 1, K, 1, ITMP1, ITMP2, -1, $ -1, -1 ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLASMSUB diff --git a/SRC/pzlassq.f b/SRC/pzlassq.f index d4b5b522..13ded98b 100644 --- a/SRC/pzlassq.f +++ b/SRC/pzlassq.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IX, INCX, JX, N DOUBLE PRECISION SCALE, SUMSQ @@ -168,11 +175,34 @@ SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters. * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IX, INCX, JX, N, SCALE, SUMSQ, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLASSQ inputs: ,IX:',I9,', INCX:',I9, + $ ', JX:',I9,', N:',I9,', SCALE:',F9.4, + $ ', SUMSQ:',F9.4,', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Figure local indexes * CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, IIX, JJX, @@ -183,8 +213,13 @@ SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * X is rowwise distributed. * - IF( MYROW.NE.IXROW ) - $ RETURN + IF( MYROW.NE.IXROW ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF ICOFF = MOD( JX, DESCX( NB_ ) ) NQ = NUMROC( N+ICOFF, DESCX( NB_ ), MYCOL, IXCOL, NPCOL ) IF( MYCOL.EQ.IXCOL ) @@ -232,8 +267,13 @@ SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * * X is columnwise distributed. * - IF( MYCOL.NE.IXCOL ) - $ RETURN + IF( MYCOL.NE.IXCOL ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF IROFF = MOD( IX, DESCX( MB_ ) ) NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IXROW, NPROW ) IF( MYROW.EQ.IXROW ) @@ -279,6 +319,10 @@ SUBROUTINE PZLASSQ( N, X, IX, JX, DESCX, INCX, SCALE, SUMSQ ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLASSQ diff --git a/SRC/pzlaswp.f b/SRC/pzlaswp.f index f90332f9..81daeea0 100644 --- a/SRC/pzlaswp.f +++ b/SRC/pzlaswp.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, $ IPIV ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIREC, ROWCOL INTEGER IA, JA, K1, K2, N @@ -152,10 +159,37 @@ SUBROUTINE PZLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIREC, ROWCOL, IA, JA, K1, + $ K2, N, eos_str + 102 FORMAT('PZLASWP inputs: ,DIREC:',A5,', ROWCOL:',A5, + $ ', IA:',I9,', JA:',I9,', K1:',I9, + $ ', K2:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) * @@ -201,6 +235,10 @@ SUBROUTINE PZLASWP( DIREC, ROWCOL, N, A, IA, JA, DESCA, K1, K2, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End PZLASWP diff --git a/SRC/pzlatra.f b/SRC/pzlatra.f index 69af3859..9e217b23 100644 --- a/SRC/pzlatra.f +++ b/SRC/pzlatra.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* COMPLEX*16 FUNCTION PZLATRA( N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ COMPLEX*16 FUNCTION PZLATRA( N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, N * .. @@ -125,13 +132,39 @@ COMPLEX*16 FUNCTION PZLATRA( N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * CALL BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, N, NPROW, NPCOL, MYROW, + $ MYCOL, eos_str + 102 FORMAT(' inputs: ,IA:',I9,', JA:',I9,', N:',I9, + $ ', NPROW: ', I9,', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * TRACE = ZERO IF( N.EQ.0 ) THEN PZLATRA = TRACE +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -180,6 +213,10 @@ COMPLEX*16 FUNCTION PZLATRA( N, A, IA, JA, DESCA ) * PZLATRA = TRACE * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLATRA diff --git a/SRC/pzlatrd.f b/SRC/pzlatrd.f index 054fcd9a..e7a3ed36 100644 --- a/SRC/pzlatrd.f +++ b/SRC/pzlatrd.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, $ IW, JW, DESCW, WORK ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, IW, JA, JW, N, NB @@ -253,10 +260,37 @@ SUBROUTINE PZLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, IW, JA, JW, N, NB, + $ eos_str + 102 FORMAT('PZLATRD inputs: ,UPLO:',A5,', IA:',I9, + $ ', IW:',I9,', JA:',I9,', JW:',I9,', N:',I9, + $ ', NB:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) @@ -428,6 +462,10 @@ SUBROUTINE PZLATRD( UPLO, N, NB, A, IA, JA, DESCA, D, E, TAU, W, END IF END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLATRD diff --git a/SRC/pzlatrs.f b/SRC/pzlatrs.f index 8a6dde28..7234b185 100644 --- a/SRC/pzlatrs.f +++ b/SRC/pzlatrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, $ JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM, $ WORK ) @@ -7,6 +13,7 @@ SUBROUTINE PZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, NORMIN, TRANS, UPLO INTEGER IA, IX, JA, JX, N @@ -49,15 +56,46 @@ SUBROUTINE PZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORMIN, TRANS, UPLO, + $ IA, IX, JA, JX, N, SCALE, NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZLATRS inputs: ,DIAG:',A5,', NORMIN:',A5, + $ ', TRANS:',A5,', UPLO:',A5,', IA:',I9, + $ ', IX:',I9,', JA:',I9,', JX:',I9, + $ ', N:',I9,', SCALE:',F9.4,', NPROW: ', I9, + $ ', NPCOL: ', I9 ,', MYROW: ', I9, + $ ', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * ***** NO SCALING ***** Call PZTRSV for all cases ***** * @@ -80,6 +118,10 @@ SUBROUTINE PZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, $ LDX, MYROW, IXCOL ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLATRS diff --git a/SRC/pzlatrz.f b/SRC/pzlatrz.f index b37da0da..2b61346d 100644 --- a/SRC/pzlatrz.f +++ b/SRC/pzlatrz.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * and University of California, Berkeley. * December 31, 1998 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER IA, JA, L, M, N * .. @@ -196,10 +203,35 @@ SUBROUTINE PZLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) IA, JA, L, M, N, eos_str + 102 FORMAT('PZLATRZ inputs: ,IA:',I9,', JA:',I9,', L:',I9, + $ ', M:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN + IF( M.EQ.0 .OR. N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters * @@ -248,6 +280,10 @@ SUBROUTINE PZLATRZ( M, N, L, A, IA, JA, DESCA, TAU, WORK ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLATRZ diff --git a/SRC/pzlattrs.f b/SRC/pzlattrs.f index f69c529a..7b1d1c6b 100644 --- a/SRC/pzlattrs.f +++ b/SRC/pzlattrs.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, $ DESCA, X, IX, JX, DESCX, SCALE, CNORM, INFO ) * @@ -6,6 +12,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER DIAG, NORMIN, TRANS, UPLO INTEGER IA, INFO, IX, JA, JX, N @@ -306,6 +313,16 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, $ ABS( DIMAG( ZDUM ) / 2.D0 ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * INFO = 0 UPPER = LSAME( UPLO, 'U' ) @@ -337,16 +354,41 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, END IF * CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) DIAG, NORMIN, TRANS, UPLO, + $ IA, INFO, IX, JA, JX, N, SCALE, NPROW, + $ NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLATTRS inputs: ,DIAG:',A5,', NORMIN:',A5, + $ ', TRANS:',A5,', UPLO:',A5,', IA:',I9, + $ ', INFO:',I9,', IX:',I9,', JA:',I9, + $ ', JX:',I9,', N:',I9,', SCALE:',F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF * IF( INFO.NE.0 ) THEN CALL PXERBLA( CONTXT, 'PZLATTRS', -INFO ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Determine machine dependent parameters to control overflow. * @@ -1280,6 +1322,10 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, CALL DSCAL( N, ONE / TSCAL, CNORM, 1 ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLATTRS diff --git a/SRC/pzlauu2.f b/SRC/pzlauu2.f index 1b46fdde..a8efc5a7 100644 --- a/SRC/pzlauu2.f +++ b/SRC/pzlauu2.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, N @@ -141,7 +148,7 @@ SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) * .. * .. External Functions .. LOGICAL LSAME - + #ifndef F2C COMPLEX*16 ZDOTC #endif @@ -152,10 +159,35 @@ SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PZLAUU2 inputs: ,UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Get grid parameters and compute local indexes * @@ -204,7 +236,7 @@ SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) ICURR = IDIAG + 1 #ifdef F2C CALL ZDOTC( TMP, N-NA, A( ICURR ), 1, - $ A( ICURR ), 1 ) + $ A( ICURR ), 1 ) A( IDIAG ) = AII*AII + DBLE( TMP) #else A( IDIAG ) = AII*AII + DBLE( ZDOTC( N-NA, A( ICURR ), 1, @@ -225,6 +257,10 @@ SUBROUTINE PZLAUU2( UPLO, N, A, IA, JA, DESCA ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAUU2 diff --git a/SRC/pzlauum.f b/SRC/pzlauum.f index f80d8d0a..d68f94d3 100644 --- a/SRC/pzlauum.f +++ b/SRC/pzlauum.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAUUM( UPLO, N, A, IA, JA, DESCA ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLAUUM( UPLO, N, A, IA, JA, DESCA ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. CHARACTER UPLO INTEGER IA, JA, N @@ -143,10 +150,35 @@ SUBROUTINE PZLAUUM( UPLO, N, A, IA, JA, DESCA ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) UPLO, IA, JA, N, eos_str + 102 FORMAT('PZLAUUM inputs: ,UPLO:',A5,', IA:',I9, + $ ', JA:',I9,', N:',I9, A1 ) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN + IF( N.EQ.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * JN = MIN( ICEIL( JA, DESCA( NB_ ) ) * DESCA( NB_ ), JA+N-1 ) IF( LSAME( UPLO, 'U' ) ) THEN @@ -213,6 +245,10 @@ SUBROUTINE PZLAUUM( UPLO, N, A, IA, JA, DESCA ) 20 CONTINUE END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAUUM diff --git a/SRC/pzlawil.f b/SRC/pzlawil.f index 7e502ef9..226e39ce 100644 --- a/SRC/pzlawil.f +++ b/SRC/pzlawil.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * * -- ScaLAPACK routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) * and University of California, Berkeley. * July 31, 2001 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER II, JJ, M COMPLEX*16 H33, H43H34, H44 @@ -142,11 +149,35 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * HBL = DESCA( MB_ ) CONTXT = DESCA( CTXT_ ) LDA = DESCA( LLD_ ) CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL ) +* +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) II, JJ, M, H33, H43H34, H44, + $ NPROW, NPCOL, MYROW, MYCOL, eos_str + 102 FORMAT('PZLAWIL inputs: ,II:',I9,', JJ:',I9,', M:',I9, + $ ', H33:',F9.4, A, F9.4,', H43H34:',F9.4, A, F9.4, + $ ', H44:',F9.4, A, F9.4, + $ ', NPROW: ', I9,', NPCOL: ', I9 , + $ ', MYROW: ', I9,', MYCOL: ', I9, A1) + AOCL_DTL_LOG_ENTRY_F + END IF LEFT = MOD( MYCOL+NPCOL-1, NPCOL ) RIGHT = MOD( MYCOL+1, NPCOL ) UP = MOD( MYROW+NPROW-1, NPROW ) @@ -240,8 +271,13 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) END IF END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) - $ RETURN + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * IF( MODKM1.GT.1 ) THEN CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, @@ -265,6 +301,10 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) V( 2 ) = V2 V( 3 ) = V3( 1 ) * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZLAWIL diff --git a/SRC/pzmax1.f b/SRC/pzmax1.f index 8849f47d..d88262ed 100644 --- a/SRC/pzmax1.f +++ b/SRC/pzmax1.f @@ -1,3 +1,9 @@ +* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc.  All rights reserved. +* +* +#include "SL_Context_fortran_include.h" +* SUBROUTINE PZMAX1( N, AMAX, INDX, X, IX, JX, DESCX, INCX ) * * -- ScaLAPACK auxiliary routine (version 1.7) -- @@ -5,6 +11,7 @@ SUBROUTINE PZMAX1( N, AMAX, INDX, X, IX, JX, DESCX, INCX ) * and University of California, Berkeley. * May 1, 1997 * + USE LINK_TO_C_GLOBALS * .. Scalar Arguments .. INTEGER INDX, INCX, IX, JX, N COMPLEX*16 AMAX @@ -176,17 +183,46 @@ SUBROUTINE PZMAX1( N, AMAX, INDX, X, IX, JX, DESCX, INCX ) * .. * .. Executable Statements .. * +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F +* * Get grid parameters * ICTXT = DESCX( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) * +* Update the log buffer with the scalar arguments details, +* MPI process grid information and write to the log file +* + IF( SCALAPACK_CONTEXT%IS_LOG_ENABLED.EQ.1 ) THEN + WRITE(LOG_BUF,102) INDX, INCX, IX, JX, N, real(AMAX), + $ ' + i ',aimag(AMAX), NPROW, NPCOL, + $ MYROW, MYCOL, eos_str + 102 FORMAT('PZMAX1 inputs: ,INDX:',I5,', INCX:',I5, + $ ', IX:',I5,', JX:',I5,', N:',I5, + $ ', AMAX:',F9.4, A, F9.4,', NPROW: ', I5, + $ ', NPCOL: ', I5 ,', MYROW: ', I5,', MYCOL: ', I5,A1) + AOCL_DTL_LOG_ENTRY_F + END IF +* * Quick return if possible. * INDX = 0 AMAX = ZERO - IF( N.LE.0 ) - $ RETURN + IF( N.LE.0 ) THEN +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F + RETURN + END IF * * Retrieve local information for vector X. * @@ -197,6 +233,10 @@ SUBROUTINE PZMAX1( N, AMAX, INDX, X, IX, JX, DESCX, INCX ) IF( INCX.EQ.1 .AND. DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN INDX = JX AMAX = X( IIX+(JJX-1)*LDX ) +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN END IF * @@ -350,11 +390,18 @@ SUBROUTINE PZMAX1( N, AMAX, INDX, X, IX, JX, DESCX, INCX ) * END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of PZMAX1 * END +* +* +#include "SL_Context_fortran_include.h" * SUBROUTINE ZCOMBAMAX1 ( V1, V2 ) * @@ -390,12 +437,26 @@ SUBROUTINE ZCOMBAMAX1 ( V1, V2 ) INTRINSIC ABS, DBLE * .. * .. Executable Statements .. +* +* Initialize framework context structure if not initialized +* +* + CALL AOCL_SCALAPACK_INIT( ) +* +* +* Capture the subroutine entry in the trace file +* + AOCL_DTL_TRACE_ENTRY_F * IF( ABS( DBLE( V1( 1 ) ) ).LT.ABS( DBLE( V2( 1 ) ) ) ) THEN V1( 1 ) = V2( 1 ) V1( 2 ) = V2( 2 ) END IF * +* +* Capture the subroutine exit in the trace file +* + AOCL_DTL_TRACE_EXIT_F RETURN * * End of ZCOMBAMAX1 From 4a5761be67fe2bb4f9712b2e1c677c1e347b6965 Mon Sep 17 00:00:00 2001 From: Srinidhi S Date: Wed, 8 Nov 2023 17:08:52 +0530 Subject: [PATCH 26/29] Added coverage flag and script to genrate coverage reports. Signed-off-by: Srinidhi AMD-Internal: [CPUPL-2701] Change-Id: I50bb4a593ce8648ca558d222f8967f261c74388a --- CMakeLists.txt | 7 +++++++ SCRIPTS/generate_code_coverage_html.sh | 7 +++++++ 2 files changed, 14 insertions(+) create mode 100644 SCRIPTS/generate_code_coverage_html.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index edd72749..f56e0814 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -32,6 +32,9 @@ option(ENABLE_DTL "Enable DTL feature " OFF) # ASAN testing option option(ENABLE_ASAN_TESTS "Enable Address sanitizer tests " OFF) +# Coverage option +option(ENABLE_COVERAGE "Enable code coverage" OFF) + # Option: Include build number in the version string. option (ENABLE_SET_LIB_VERSION "Set library version" OFF) @@ -436,6 +439,10 @@ if (UNIX) target_link_libraries( scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) scalapack_install_library(scalapack) endif(CUSTOM_BLACS_FOUND) + if(ENABLE_COVERAGE) + target_compile_options(scalapack PUBLIC -fprofile-arcs -ftest-coverage) + target_link_options(scalapack PUBLIC -fprofile-arcs -ftest-coverage) + endif(ENABLE_COVERAGE) else (UNIX) # Need to separate Fortran and C Code if (CMAKE_C_COMPILER_ID MATCHES MSVC) # create Fortran objects and add to scalapack library first diff --git a/SCRIPTS/generate_code_coverage_html.sh b/SCRIPTS/generate_code_coverage_html.sh new file mode 100644 index 00000000..bcbc071a --- /dev/null +++ b/SCRIPTS/generate_code_coverage_html.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +lcov --rc lcov_branch_coverage=1 --capture --directory . --output-file coverage.info; +lcov --remove --rc lcov_branch_coverage=1 coverage.info '/usr/*' '*TESTING*' '*AOCL_DTL*' -o filtered_coverage.info + +genhtml --rc genhtml_branch_coverage=1 --title "SCALAPACK COVERAGE REPORT" filtered_coverage.info --prefix $PWD --function-coverage --branch-coverage --legend --output-directory out; +cd out; pushd <index.html; python3 -m http.server 9999; popd; From be2386531cc857a0702b73ef135acd0ff9a075e7 Mon Sep 17 00:00:00 2001 From: varajago Date: Tue, 28 Nov 2023 10:06:56 +0530 Subject: [PATCH 27/29] aocl-scaLAPACK: Fix for test build error Fix for intermittent failure of test code compilation. Order of compilation of files changed for xstrd testto fix the issue Signed-off-by: Vasanthakumar R AMD-Internal: CPUPL-4046 Change-Id: Iac78bb25661bb86401b08cbb80d26112e59555c2 --- TESTING/EIG/CMakeLists.txt | 326 ++++++++++++++-------------- TESTING/EIG/SL_Context_module_eig.f | 46 ++++ 2 files changed, 209 insertions(+), 163 deletions(-) create mode 100644 TESTING/EIG/SL_Context_module_eig.f diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt index 19451dc4..ff8c1e52 100644 --- a/TESTING/EIG/CMakeLists.txt +++ b/TESTING/EIG/CMakeLists.txt @@ -1,163 +1,163 @@ -##Copyright (C) 2021, Advanced Micro Devices, Inc. All rights reserved.## - -set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/TESTING) - -set (smatgen psmatgen.f pmatgeninc.f) -set (dmatgen pdmatgen.f pmatgeninc.f) -set (cmatgen pcmatgen.f pmatgeninc.f) -set (zmatgen pzmatgen.f pmatgeninc.f) -set (TTRD_SRC ${CMAKE_SOURCE_DIR}/SRC) -set (FRAMEWORK_SRC ${CMAKE_SOURCE_DIR}/FRAMEWORK) - -if (WIN32 AND CMAKE_C_COMPILER_ID MATCHES Clang) - add_definitions(-D__STDC__) -endif () - -add_executable(xsbrd psbrddriver.f psbrdinfo.f psgebdrv.f pslafchk.f ${smatgen}) -add_executable(xdbrd pdbrddriver.f pdbrdinfo.f pdgebdrv.f pdlafchk.f ${dmatgen}) -add_executable(xcbrd pcbrddriver.f pcbrdinfo.f pcgebdrv.f pclafchk.f ${cmatgen}) -add_executable(xzbrd pzbrddriver.f pzbrdinfo.f pzgebdrv.f pzlafchk.f ${zmatgen}) - -add_executable(xshrd pshrddriver.f pshrdinfo.f psgehdrv.f pslafchk.f ${smatgen}) -add_executable(xdhrd pdhrddriver.f pdhrdinfo.f pdgehdrv.f pdlafchk.f ${dmatgen}) -add_executable(xchrd pchrddriver.f pchrdinfo.f pcgehdrv.f pclafchk.f ${cmatgen}) -add_executable(xzhrd pzhrddriver.f pzhrdinfo.f pzgehdrv.f pzlafchk.f ${zmatgen}) - -if(MSVC) -add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f ${TTRD_SRC}/pssyttrd.f xpjlaenv.f ${smatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) -add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f ${TTRD_SRC}/pdsyttrd.f xpjlaenv.f ${dmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) -add_executable(xctrd pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f ${TTRD_SRC}/pchettrd.f xpjlaenv.f ${cmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) -add_executable(xztrd pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f ${TTRD_SRC}/pzhettrd.f xpjlaenv.f ${zmatgen} ${FRAMEWORK_SRC}/SL_Context_module.f) -else() -add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f xpjlaenv.f ${smatgen}) -add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f xpjlaenv.f ${dmatgen}) -add_executable(xctrd pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f xpjlaenv.f ${cmatgen}) -add_executable(xztrd pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f xpjlaenv.f ${zmatgen}) -endif() - -add_executable(xssvd pssvddriver.f pslagge.f pssvdchk.f pssvdcmp.f pssvdtst.f ${smatgen}) -add_executable(xdsvd pdsvddriver.f pdlagge.f pdsvdchk.f pdsvdcmp.f pdsvdtst.f ${dmatgen}) - -add_executable(xssep psseptst.f pssepsubtst.f pssepchk.f pssepqtq.f pslagsy.f pslatms.f pslasizesep.f pslasizesyevx.f pssepdriver.f pssepreq.f pssepinfo.f pslasizesyev.f pssqpsubtst.f pslasizesqp.f pssdpsubtst.f ${smatgen}) -add_executable(xdsep pdseptst.f pdsepsubtst.f pdsepchk.f pdsepqtq.f pdlagsy.f pdlatms.f pdlasizesep.f pdlasizesyevx.f pdsepdriver.f pdsepreq.f pdsepinfo.f pdlasizesyev.f pdsqpsubtst.f pdlasizesqp.f pdsdpsubtst.f ${dmatgen}) -add_executable(xcsep pcseptst.f pcsepsubtst.f pcsepchk.f pcsepqtq.f pclagsy.f pclatms.f pclasizesep.f pclasizeheevx.f pcsepdriver.f pcsepreq.f pssepinfo.f pcsdpsubtst.f ${cmatgen}) -add_executable(xzsep pzseptst.f pzsepsubtst.f pzsepchk.f pzsepqtq.f pzlagsy.f pzlatms.f pzlasizesep.f pzlasizeheevx.f pzsepdriver.f pzsepreq.f pdsepinfo.f pzsdpsubtst.f ${zmatgen}) - -add_executable(xsgsep psgseptst.f psgsepsubtst.f psgsepchk.f pslagsy.f pslatms.f pslasizesyevx.f pslasizegsep.f pslasizesep.f psgsepdriver.f psgsepreq.f pssepinfo.f ${smatgen}) -add_executable(xdgsep pdgseptst.f pdgsepsubtst.f pdgsepchk.f pdlagsy.f pdlatms.f pdlasizesyevx.f pdlasizegsep.f pdlasizesep.f pdgsepdriver.f pdgsepreq.f pdsepinfo.f ${dmatgen}) -add_executable(xcgsep pcgseptst.f pcgsepsubtst.f pcgsepchk.f pclagsy.f pclatms.f pclasizegsep.f pclasizeheevx.f pclasizesep.f pcgsepdriver.f pcgsepreq.f pssepinfo.f ${cmatgen}) -add_executable(xzgsep pzgseptst.f pzgsepsubtst.f pzgsepchk.f pzlagsy.f pzlatms.f pzlasizegsep.f pzlasizeheevx.f pzlasizesep.f pzgsepdriver.f pzgsepreq.f pdsepinfo.f ${zmatgen}) - -add_executable(xsnep psnepdriver.f psnepinfo.f psnepfchk.f ${smatgen}) -add_executable(xdnep pdnepdriver.f pdnepinfo.f pdnepfchk.f ${dmatgen}) -add_executable(xcnep pcnepdriver.f pcnepinfo.f pcnepfchk.f ${cmatgen}) -add_executable(xznep pznepdriver.f pznepinfo.f pznepfchk.f ${zmatgen}) - -add_executable(xcevc pcevcdriver.f pcevcinfo.f pcget22.f ${cmatgen}) -add_executable(xzevc pzevcdriver.f pzevcinfo.f pzget22.f ${zmatgen}) - -add_executable(xssyevr pslasizesepr.f pslasizesyevr.f psseprdriver.f psseprreq.f psseprsubtst.f -pssepchk.f pssepqtq.f pslatms.f psseprtst.f pssepinfo.f pslagsy.f pslasizesep.f ${smatgen}) -add_executable(xdsyevr pdlasizesepr.f pdlasizesyevr.f pdseprdriver.f pdseprreq.f pdseprsubtst.f -pdsepchk.f pdsepqtq.f pdlatms.f pdseprtst.f pdsepinfo.f pdlagsy.f pdlasizesep.f ${dmatgen}) -add_executable(xcheevr pclasizesepr.f pclasizeheevr.f pcseprdriver.f pcseprreq.f pcseprsubtst.f -pcsepchk.f pcsepqtq.f pclatms.f pcseprtst.f pssepinfo.f pclagsy.f pclasizesep.f ${cmatgen}) -add_executable(xzheevr pzlasizesepr.f pzlasizeheevr.f pzseprdriver.f pzseprreq.f pzseprsubtst.f -pzsepchk.f pzsepqtq.f pzlatms.f pzseprtst.f pdsepinfo.f pzlagsy.f pzlasizesep.f ${zmatgen}) - -add_executable(xshseqr pshseqrdriver.f psmatgen2.f ${cmatgen}) -add_executable(xdhseqr pdhseqrdriver.f pdmatgen2.f ${cmatgen}) - -if(WIN32) - target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - - target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) - target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) -else(WIN32) - target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - - target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -endif(WIN32) - -if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory -endif() +##Copyright (C) 2021, Advanced Micro Devices, Inc. All rights reserved.## + +set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/TESTING) + +set (smatgen psmatgen.f pmatgeninc.f) +set (dmatgen pdmatgen.f pmatgeninc.f) +set (cmatgen pcmatgen.f pmatgeninc.f) +set (zmatgen pzmatgen.f pmatgeninc.f) +set (TTRD_SRC ${CMAKE_SOURCE_DIR}/SRC) +set (FRAMEWORK_SRC ${CMAKE_SOURCE_DIR}/FRAMEWORK) + +if (WIN32 AND CMAKE_C_COMPILER_ID MATCHES Clang) + add_definitions(-D__STDC__) +endif () + +add_executable(xsbrd psbrddriver.f psbrdinfo.f psgebdrv.f pslafchk.f ${smatgen}) +add_executable(xdbrd pdbrddriver.f pdbrdinfo.f pdgebdrv.f pdlafchk.f ${dmatgen}) +add_executable(xcbrd pcbrddriver.f pcbrdinfo.f pcgebdrv.f pclafchk.f ${cmatgen}) +add_executable(xzbrd pzbrddriver.f pzbrdinfo.f pzgebdrv.f pzlafchk.f ${zmatgen}) + +add_executable(xshrd pshrddriver.f pshrdinfo.f psgehdrv.f pslafchk.f ${smatgen}) +add_executable(xdhrd pdhrddriver.f pdhrdinfo.f pdgehdrv.f pdlafchk.f ${dmatgen}) +add_executable(xchrd pchrddriver.f pchrdinfo.f pcgehdrv.f pclafchk.f ${cmatgen}) +add_executable(xzhrd pzhrddriver.f pzhrdinfo.f pzgehdrv.f pzlafchk.f ${zmatgen}) + +if(MSVC) +add_executable(xstrd xpjlaenv.f SL_Context_module_eig.f pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f ${TTRD_SRC}/pssyttrd.f ${smatgen}) +add_executable(xdtrd xpjlaenv.f SL_Context_module_eig.f pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f ${TTRD_SRC}/pdsyttrd.f ${dmatgen}) +add_executable(xctrd xpjlaenv.f SL_Context_module_eig.f pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f ${TTRD_SRC}/pchettrd.f ${cmatgen}) +add_executable(xztrd xpjlaenv.f SL_Context_module_eig.f pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f ${TTRD_SRC}/pzhettrd.f ${zmatgen}) +else() +add_executable(xstrd pstrddriver.f psttrdtester.f pslatran.f pstrdinfo.f pssytdrv.f pslafchk.f xpjlaenv.f ${smatgen}) +add_executable(xdtrd pdtrddriver.f pdttrdtester.f pdlatran.f pdtrdinfo.f pdsytdrv.f pdlafchk.f xpjlaenv.f ${dmatgen}) +add_executable(xctrd pctrddriver.f pcttrdtester.f pclatran.f pctrdinfo.f pchetdrv.f pclafchk.f xpjlaenv.f ${cmatgen}) +add_executable(xztrd pztrddriver.f pzttrdtester.f pzlatran.f pztrdinfo.f pzhetdrv.f pzlafchk.f xpjlaenv.f ${zmatgen}) +endif() + +add_executable(xssvd pssvddriver.f pslagge.f pssvdchk.f pssvdcmp.f pssvdtst.f ${smatgen}) +add_executable(xdsvd pdsvddriver.f pdlagge.f pdsvdchk.f pdsvdcmp.f pdsvdtst.f ${dmatgen}) + +add_executable(xssep psseptst.f pssepsubtst.f pssepchk.f pssepqtq.f pslagsy.f pslatms.f pslasizesep.f pslasizesyevx.f pssepdriver.f pssepreq.f pssepinfo.f pslasizesyev.f pssqpsubtst.f pslasizesqp.f pssdpsubtst.f ${smatgen}) +add_executable(xdsep pdseptst.f pdsepsubtst.f pdsepchk.f pdsepqtq.f pdlagsy.f pdlatms.f pdlasizesep.f pdlasizesyevx.f pdsepdriver.f pdsepreq.f pdsepinfo.f pdlasizesyev.f pdsqpsubtst.f pdlasizesqp.f pdsdpsubtst.f ${dmatgen}) +add_executable(xcsep pcseptst.f pcsepsubtst.f pcsepchk.f pcsepqtq.f pclagsy.f pclatms.f pclasizesep.f pclasizeheevx.f pcsepdriver.f pcsepreq.f pssepinfo.f pcsdpsubtst.f ${cmatgen}) +add_executable(xzsep pzseptst.f pzsepsubtst.f pzsepchk.f pzsepqtq.f pzlagsy.f pzlatms.f pzlasizesep.f pzlasizeheevx.f pzsepdriver.f pzsepreq.f pdsepinfo.f pzsdpsubtst.f ${zmatgen}) + +add_executable(xsgsep psgseptst.f psgsepsubtst.f psgsepchk.f pslagsy.f pslatms.f pslasizesyevx.f pslasizegsep.f pslasizesep.f psgsepdriver.f psgsepreq.f pssepinfo.f ${smatgen}) +add_executable(xdgsep pdgseptst.f pdgsepsubtst.f pdgsepchk.f pdlagsy.f pdlatms.f pdlasizesyevx.f pdlasizegsep.f pdlasizesep.f pdgsepdriver.f pdgsepreq.f pdsepinfo.f ${dmatgen}) +add_executable(xcgsep pcgseptst.f pcgsepsubtst.f pcgsepchk.f pclagsy.f pclatms.f pclasizegsep.f pclasizeheevx.f pclasizesep.f pcgsepdriver.f pcgsepreq.f pssepinfo.f ${cmatgen}) +add_executable(xzgsep pzgseptst.f pzgsepsubtst.f pzgsepchk.f pzlagsy.f pzlatms.f pzlasizegsep.f pzlasizeheevx.f pzlasizesep.f pzgsepdriver.f pzgsepreq.f pdsepinfo.f ${zmatgen}) + +add_executable(xsnep psnepdriver.f psnepinfo.f psnepfchk.f ${smatgen}) +add_executable(xdnep pdnepdriver.f pdnepinfo.f pdnepfchk.f ${dmatgen}) +add_executable(xcnep pcnepdriver.f pcnepinfo.f pcnepfchk.f ${cmatgen}) +add_executable(xznep pznepdriver.f pznepinfo.f pznepfchk.f ${zmatgen}) + +add_executable(xcevc pcevcdriver.f pcevcinfo.f pcget22.f ${cmatgen}) +add_executable(xzevc pzevcdriver.f pzevcinfo.f pzget22.f ${zmatgen}) + +add_executable(xssyevr pslasizesepr.f pslasizesyevr.f psseprdriver.f psseprreq.f psseprsubtst.f +pssepchk.f pssepqtq.f pslatms.f psseprtst.f pssepinfo.f pslagsy.f pslasizesep.f ${smatgen}) +add_executable(xdsyevr pdlasizesepr.f pdlasizesyevr.f pdseprdriver.f pdseprreq.f pdseprsubtst.f +pdsepchk.f pdsepqtq.f pdlatms.f pdseprtst.f pdsepinfo.f pdlagsy.f pdlasizesep.f ${dmatgen}) +add_executable(xcheevr pclasizesepr.f pclasizeheevr.f pcseprdriver.f pcseprreq.f pcseprsubtst.f +pcsepchk.f pcsepqtq.f pclatms.f pcseprtst.f pssepinfo.f pclagsy.f pclasizesep.f ${cmatgen}) +add_executable(xzheevr pzlasizesepr.f pzlasizeheevr.f pzseprdriver.f pzseprreq.f pzseprsubtst.f +pzsepchk.f pzsepqtq.f pzlatms.f pzseprtst.f pdsepinfo.f pzlagsy.f pzlasizesep.f ${zmatgen}) + +add_executable(xshseqr pshseqrdriver.f psmatgen2.f ${cmatgen}) +add_executable(xdhseqr pdhseqrdriver.f pdmatgen2.f ${cmatgen}) + +if(WIN32) + target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + + target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) + target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${OpenMP_libomp_LIBRARY}) +else(WIN32) + target_link_libraries(xsbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzbrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xshrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xchrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzhrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xstrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdtrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xctrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xztrd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsvd scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzgsep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xsnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcnep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xznep scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xcevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzevc scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xssyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdsyevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xcheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + + target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) + target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) +endif(WIN32) + +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory +endif() diff --git a/TESTING/EIG/SL_Context_module_eig.f b/TESTING/EIG/SL_Context_module_eig.f new file mode 100644 index 00000000..26dde5b7 --- /dev/null +++ b/TESTING/EIG/SL_Context_module_eig.f @@ -0,0 +1,46 @@ + +* ************************************************************************ +* Copyright (c) 2023 Advanced Micro Devices, Inc. +* +* Permission is hereby granted, free of charge, to any person obtaining a copy +* of this software and associated documentation files (the "Software"), to deal +* in the Software without restriction, including without limitation the rights +* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +* copies of the Software, and to permit persons to whom the Software is +* furnished to do so, subject to the following conditions: +* +* The above copyright notice and this permission notice shall be included in +* all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +* THE SOFTWARE. +* +* ************************************************************************ */ + MODULE LINK_TO_C_GLOBALS + USE, INTRINSIC::ISO_C_BINDING + TYPE, BIND(C)::AOCL_SCALAPACK_GLOBAL_CONTEXT + INTEGER(C_INT)::NUM_THREADS + INTEGER(C_INT)::IS_TRACE_ENABLED + INTEGER(C_INT)::IS_LOG_ENABLED + INTEGER(C_INT)::IS_PROGRESS_ENABLED + INTEGER(C_INT)::RANK + INTEGER(C_INT)::NUM_PROCS + END TYPE + TYPE(AOCL_SCALAPACK_GLOBAL_CONTEXT),BIND(C)::SCALAPACK_CONTEXT +* .. +* .. LOG variables declaration .. +* .. LOG BUFFER size is large enough to capture the scalar argument +* .. values.. + CHARACTER LOG_BUF*1024 +!$omp threadprivate(LOG_BUF) +* .. +* .. Variable to hold the 'End of string' character in C language + CHARACTER*2, PARAMETER :: eos_str = '' // C_NULL_CHAR +* .. +* .. + END MODULE LINK_TO_C_GLOBALS \ No newline at end of file From 430116328a400ef29873478acc671ab7f2e463d7 Mon Sep 17 00:00:00 2001 From: rahulraj Date: Tue, 12 Dec 2023 16:18:35 +0530 Subject: [PATCH 28/29] AOCL-ScalaPACK version bumped to 4.2.0 AMD-Internal: [CPUPL-4304] Change-Id: I4d3c3289ef7505ad23c6cb1e76a07f8ed7552c10 --- SRC/get_aocl_scalapack_version.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/SRC/get_aocl_scalapack_version.c b/SRC/get_aocl_scalapack_version.c index 26c0f3ef..0e6c141f 100644 --- a/SRC/get_aocl_scalapack_version.c +++ b/SRC/get_aocl_scalapack_version.c @@ -3,7 +3,7 @@ /* --------------------------------------------------------------------- * * -- AOCL ScaLAPACK routine -- -* Copyright (c) 2020-2022 Advanced Micro Devices, Inc.  All rights reserved. +* Copyright (c) 2020-2023 Advanced Micro Devices, Inc.  All rights reserved. * * --------------------------------------------------------------------- */ @@ -27,7 +27,7 @@ void get_aocl_scalapack_version_( version ) #endif { #ifdef AOCL_SCALAPACK_VERSION - char slmainversion[] = "AOCL-ScaLAPACK 4.1.1 "; + char slmainversion[] = "AOCL-ScaLAPACK 4.2.0 "; char slversion[1000]; char scalapackversion[] = ", supports ScaLAPACK 2.2.0"; int length, i; @@ -52,7 +52,7 @@ void get_aocl_scalapack_version_( version ) slversion[length] = '\0'; strcpy(version, slversion); #else - strcpy(version, "AOCL-ScaLAPACK 4.1.1, supports ScaLAPACK 2.2.0"); + strcpy(version, "AOCL-ScaLAPACK 4.2.0, supports ScaLAPACK 2.2.0"); #endif return; } From e5792d74781bb29a89072769513e4d40d537fb4c Mon Sep 17 00:00:00 2001 From: nphaniku Date: Fri, 15 Dec 2023 20:52:16 +0530 Subject: [PATCH 29/29] Scalapack library API Fortran to C name mangling configuration For FORTRAN API to call a ScaLAPACK's C routine, 'CDEFS' option in CMake is now updated to choose one among following values during build configuration: NoChange UpCase and Add_. AMD Internal : [CPUPL-4323] Change-Id: I1995594bce9bada78b0c9ce03dfdbf593c2ab9df --- CMakeLists.txt | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f56e0814..01b258d5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -19,6 +19,9 @@ set(CMAKE_MODULE_PATH "${SCALAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) set(SL_FRAMEWORK_INCLUDE_PATH "${SCALAPACK_SOURCE_DIR}/FRAMEWORK") # ------ Build Options List ----------- +# Fortran to C Name Mangling build option +set(CDEFS "NoChange" CACHE STRING "Naming strategy needed for a fortran routine to call a C routine") +set_property(CACHE CDEFS PROPERTY STRINGS "NoChange" "UpCase" "Add_") # ILP64 build option option(ENABLE_ILP64 "Enable ILP64 " OFF) @@ -49,6 +52,12 @@ if (WIN32 AND CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set (CMAKE_IFORT_LIBDEPS_DIR "C:/Program Files (x86)/IntelSWTools/compilers_and_libraries/windows/compiler/lib/intel64_win" CACHE STRING "") # set the "FORCE:MULTIPLE" option to handle linker errors due to some # of the common functions of scalapack and lapack in case of static build. + if("${CDEFS}" STREQUAL "NoChange") + set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /names:lowercase") + elseif("${CDEFS}" STREQUAL "Add_") + set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /names:lowercase") + set (CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /assume:underscore") + endif () set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} /FORCE:MULTIPLE") endif() @@ -213,14 +222,15 @@ set(PKG_CONFIG_DIR ${libdir}/pkgconfig) # BLACS Internal variables # # Fortran Mangling, MPI Tests and BLACS settings -# +if(UNIX OR "${CDEFS}" STREQUAL "UpCase") include(FortranMangling) COMPILE(install_COMPILED) FORTRAN_MANGLING(CDEFS) -#MESSAGE(STATUS "Setting CDEFS = ${CDEFS}") -#set(CDEFS ${CDEFS} CACHE STRING "Fortran Mangling" FORCE) -MESSAGE(STATUS "=========") +endif() +MESSAGE(STATUS "Setting CDEFS = ${CDEFS}") +#set(CDEFS ${CDEFS} CACHE STRING "Fortran Mangling") + MESSAGE(STATUS "=========") # -------------------------------------------------- # Compiler Flags