XL Fortran for AIX 8.1

User's Guide


Example 2 - Valid C Routine Source File

/*
 * ********************************************************************
 * 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
 


[ Top of Page | Previous Page | Next Page | Table of Contents | Index ]