/* * ******************************************************************** * This is a main function that creates threads to execute the Fortran * test subroutines. * ******************************************************************** */ #include <pthread.h> #include <stdio.h> #include <errno.h> extern char *sys_errlist[]; extern char *optarg; extern int optind; static char *prog_name; #define MAX_NUM_THREADS 100 void *f_mt_exec(void *); void f_pre_mt_exec(void); void f_post_mt_exec(int *); void usage(void) { fprintf(stderr, "Usage: %s -t number_of_threads.\n", prog_name); exit(-1); } main(int argc, char *argv[]) { int i, c, rc; int num_of_threads, n[MAX_NUM_THREADS]; char *num_of_threads_p; pthread_attr_t attr; pthread_t tid[MAX_NUM_THREADS]; prog_name = argv[0]; while ((c = getopt(argc, argv, "t")) != EOF) { switch (c) { case 't': break; default: usage(); break; } }
argc -= optind; argv += optind; if (argc < 1) { usage(); } num_of_threads_p = argv[0]; if ((num_of_threads = atoi(num_of_threads_p)) == 0) { fprintf(stderr, "%s: Invalid number of threads to be created <%s>\n", prog_name, num_of_threads_p); exit(1); } else if (num_of_threads > MAX_NUM_THREADS) { fprintf(stderr, "%s: Cannot create more than 100 threads.\n", prog_name); exit(1); } pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_UNDETACHED); /* **************************************************************** * Execute the Fortran subroutine that prepares for multi-threaded * execution. * **************************************************************** */ f_pre_mt_exec(); for (i = 0; i < num_of_threads; i++) { n[i] = i; rc = pthread_create(&tid[i], &attr, f_mt_exec, (void *)&n[i]); if (rc != 0) { fprintf(stderr, "Failed to create thread %d.\n", i); fprintf(stderr, "Error is %s\n", sys_errlist[rc]); exit(1); } } /* The attribute is no longer needed after threads are created. */ pthread_attr_destroy(&attr);
for (i = 0; i < num_of_threads; i++) { rc = pthread_join(tid[i], NULL); if (rc != 0) { fprintf(stderr, "Failed to join thread %d. \n", i); fprintf(stderr, "Error is %s\n", sys_errlist[rc]); } } /* * Execute the Fortran subroutine that does the check after * multi-threaded execution. */ f_post_mt_exec(&num_of_threads); exit(0); } ! *********************************************************************** ! This test case tests the writing list-directed to a single external ! file by many threads. ! *********************************************************************** subroutine f_pre_mt_exec() integer array(1000) common /x/ array do i = 1, 1000 array(i) = i end do open(10, file="fun10.out", form="formatted", status="replace") end
subroutine f_post_mt_exec(number_of_threads) integer array(1000), array1(1000) common /x/ array close(10) open(10, file="fun10.out", form="formatted") do j = 1, number_of_threads read(10, *) array1 do i = 1, 1000 if (array1(i) /= array(i)) then print *, "Result is wrong." stop endif end do end do close(10, status="delete") print *, "Normal ending." end subroutine f_mt_exec(thread_number) integer thread_number integer array(1000) common /x/ array write(10, *) array end