MohidWiki - User contributions [en]

Consolidate Domain Decomposition

2015-03-09T15:52:47Z

Miranda ricardo: /* Run the program */

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Run the program ==
Both Windows and *NIX systems run the same way. This application runs from the command line.
To run the program go to the directory where the file "Tree.dat" is. Most likely you will run on a single machine, the number of Parsers must be 1, the number of Workers can be any number greater then 1. There should be a balance between the number of available cores and the number of files to join. The application parses the "MPI_*_DecomposedFiles.dat" produced by Mohid. The consolidated files are placed in the same directory where the decomposed files are. The command to run the application is:

* mpiexec.exe -localonly -n 1 DDCParser.exe : -n 2 DDCWorker.exe

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*any number of workers.

The Parser identifies result files to be consolidated. It keeps a list of jobs to be done.
At the end, when all files are merged, a "poison pill" message will be broadcast notifying workers they must terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2015-03-09T15:52:32Z

Miranda ricardo: /* Run the program */

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Run the program ==
Both Windows and *NIX systems run the same way. This application runs from the command line.
To run the program go to the directory where the file "Tree.dat" is. Most likely you will run on a single machine, the number of Parsers must be 1, the number of Workers can be any number greater then 1. There should be a balance between the number of available cores and the number of files to join. The application parses the "MPI_*_DecomposedFiles.dat" produced by Mohid. The consolidated files are placed in the same directory where the decomposed files are. The command to run the application is:

* mpiexec -localonly -n 1 DDCParser.exe : -n 2 DDCWorker.exe

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*any number of workers.

The Parser identifies result files to be consolidated. It keeps a list of jobs to be done.
At the end, when all files are merged, a "poison pill" message will be broadcast notifying workers they must terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2015-03-09T15:52:08Z

Miranda ricardo: /* Run the program */

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Run the program ==
Both Windows and *NIX systems run the same way. This application runs from the command line.
To run the program go to the directory where the file "Tree.dat" is. Most likely you will run on a single machine, the number of Parsers must be 1, the number of Workers can be any number greater then 1. There should be a balance between the number of available cores and the number of files to join. The application parses the "MPI_*_DecomposedFiles.dat" produced by Mohid. The consolidated files are placed in the same directory where the decomposed files are. The command to run the application is:

mpiexec -localonly -n 1 DDCParser.exe : -n 2 DDCWorker.exe

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*any number of workers.

The Parser identifies result files to be consolidated. It keeps a list of jobs to be done.
At the end, when all files are merged, a "poison pill" message will be broadcast notifying workers they must terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2015-03-09T15:51:48Z

Miranda ricardo:

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Run the program ==
Both Windows and *NIX systems run the same way. This application runs from the command line.
To run the program go to the directory where the file "Tree.dat" is. Most likely you will run on a single machine, the number of Parsers must be 1, the number of Workers can be any number greater then 1. There should be a balance between the number of available cores and the number of files to join. The application parses the "MPI_*_DecomposedFiles.dat" produced by Mohid. The consolidated files are placed in the same directory where the decomposed files are. The command to run the application is:
mpiexec -localonly -n 1 DDCParser.exe : -n 2 DDCWorker.exe

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*any number of workers.

The Parser identifies result files to be consolidated. It keeps a list of jobs to be done.
At the end, when all files are merged, a "poison pill" message will be broadcast notifying workers they must terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2015-02-03T11:37:13Z

Miranda ricardo: /* Topology */

Consolidate Domain Decomposition

2015-02-03T11:34:03Z

Miranda ricardo:

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*any number of workers.

The Parser identifies result files to be consolidated. It keeps 2 lists:
*a list of jobs to be done; and
*a list of workers.
The list of workers will be used in the end, when there are no more pending jobs. A message will be send to every worker notifying them that they should terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2014-11-30T19:41:09Z

Miranda ricardo: /* Topology */

The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from 2 sub-domains:
*hyd_submod_1.hdf and wq_submod_1.hdf; and
*hyd_submod_2.hdf and wq_submod_2.hdf.
The desired consolidated files are hyd.hdf and wq.hdf, resulting form the concatenation of:
*hyd_submod_1.hdf and hyd_submod_2.hdf to produce hyd.hdf; and
*wq_submod_1.hdf and wq_submod_2.hdf for the wq.hdf

== Topology ==
[[File:Ddc.rcm.png|thumb|left|alt=Diagram of the architecture for the consolidation of domain decomposition HDF result files.]]There are 2 kinds of MPI processes running:
*a Parser; and
*2 workers.

The Parser identifies result files to be consolidated. It keeps 2 lists:
*a list of jobs to be done; and
*a list of workers.
The list of workers will be used in the end, when there are no more pending jobs. A message will be send to every worker notifying them that they should terminate.
The list of jobs works like this:
#a Worker is idle it sends a request to the Parser;
#the Parser sends the first unfinished job to the worker and moves it from the first to the last position of the list;
#when a Worker terminates a job sends a processed message to the Parser;
#the Parser removes the completed job from the list.
This strategy for the jobs list ensures fault tolerance. Suppose a job is sent to a Worker that, for some reason, does not complete it. That job will eventually be send to another Worker. It may occur that a job is executed twice but the program is idempotent so no harm occurs...

Consolidate Domain Decomposition

2014-11-30T19:31:32Z

Miranda ricardo: /* Topology */

Consolidate Domain Decomposition

2014-11-30T19:21:17Z

Miranda ricardo: /* Topology */

Consolidate Domain Decomposition

2014-11-30T19:20:12Z

Miranda ricardo: /* Topology */

File:Ddc.rcm.png

2014-11-30T19:18:32Z

Miranda ricardo: Diagram of the architecture for the consolidation of domain decomposition HDF result files.

Diagram of the architecture for the consolidation of domain decomposition HDF result files.

Consolidate Domain Decomposition

2014-11-30T19:14:30Z

Miranda ricardo:

Consolidate Domain Decomposition

2014-11-30T19:10:56Z

Miranda ricardo: Created page with "The program Consolidate Domain Decomposition uses the actor model to parallelize file processing tasks. For instance, suppose there are hydrodynamic and water quality files from ..."

Actor Model

2014-11-30T19:03:33Z

Miranda ricardo:

According to the Wikipedia[http://en.wikipedia.org/wiki/Actor_model] "the actor model in computer science is a mathematical model of concurrent computation that treats "actors" as the universal primitives of concurrent digital computation: in response to a message that it receives, an actor can make local decisions, create more actors, send more messages, and determine how to respond to the next message received" (changing state). The actor model is a special form of [[Reactive Programming]].

There are several resources in the Internet explaining the Actor Model and Reactive Programing. Some videos and interesting interviews:
<ul>
<li>Hewitt, Meijer and Szyperski: The Actor Model (everything you wanted to know, but were afraid to ask)[http://channel9.msdn.com/Shows/Going+Deep/Hewitt-Meijer-and-Szyperski-The-Actor-Model-everything-you-wanted-to-know-but-were-afraid-to-ask];</li>
<li>Francesco Cesarini and Viktor Klang on the Reactive Manifesto[http://www.infoq.com/interviews/cesarini-klang-reactive-manifesto]; and</li>
<li>Up And Out Scaling Software With Akka - Jonas Bonér[http://www.youtube.com/watch?v=t4KxWDqGfcs]</li>
</ul>
To read on-line:
<ul>
<li>The Reactive Manifesto[http://www.reactivemanifesto.org/]; and</li>
<li>Learn You Some Erlang for great good![http://learnyousomeerlang.com/content];</li>
</ul>

The actor model makes it easier to reason about distributed programming. All MPI directives will be packed up in a set of well defined modules. Communication among actors takes place through clear and standard interfaces with well defined behaviors. This software architecture is proven to provide scalability, resilience and responsiveness. There is no central management and no points of synchronism so actors just react to events; this is a simpler way of reasoning about concurrency and parallelism.

According to Carl Hewitts' definition (Carl Hewitt; Peter Bishop; Richard Steiger (1973). A Universal Modular Actor Formalism for Artificial Intelligence. IJCAI) an actor is the fundamental unit of computation that embodies:
<ul>
<li>processing (the behavior, the executable code);</li>
<li>storage (its the state, the stuff on the heap, memory); and</li>
<li>communication.</li>
</ul>

When an actor receives a message it reacts:
<ul>
<li>sending messages to actors it knows (finite number);</li>
<li>creating new actors (finite number); and</li>
<li>designating how it should handle the next message it receives (changing state).</li>
</ul>

Here a [[Fortran implementation of the Actor Model using MPI]] is discussed.

The program to consolidate results from [[Domain Decomposition]] runs, [[Consolidate Domain Decomposition]], is the first using the actor model approach. It is a simple and small program, the perfect test bed before expanding to Mohid.

== Relevance of the Actor Model for the Mohid system ==

Mohid is a large system with complex memory management. With the commoditization of multi-core machines and access to fast local networks MPI is becoming the de facto way of running Mohid. MPI (Message Passing Interface) is a very powerful, standardized and portable message-passing system.

The way MPI is currently used in Mohid is difficult to implement, hard to understand and complex to maintain. It is essential to use MPI in such a way that it becomes easier to reason about:
<ul>
<li>standardizing MPI's implementation in Mohid, embedding it in the programming framework;</li>
<li>making explicit conventions on MPI usage of Mohid, for instance banning the use of semaphores and barriers;</li>
<li>there will be a very limited number of modules where MPI directives are allowed; and</li>
<li>MPI will be used to create explicit APIs (Application Programming Interface) that can be easily expanded and refactored according to Mohid's needs.</li>
</ul>

== Actor Model in Mohid ==

[[File:am.01.png|thumb|left|alt=Domain in decomposed in 3 subdomains creates 3 instances of MohidWater (MW1, MW2 and MW3).|Domain in decomposed in 3 subdomains.]]Suppose a domain is decomposed in 3 sub-domains according to the first image. Each subdomain is an actor that sends messages to other actors and reacts to messages it receives. Each model has a Main Loop that progresses in time-steps. Each model sends messages with information (for example border conditions) to actors that need it.

[[File:am.04.png|thumb|right|alt=All actors are working.|(0) All actors are working.]]Lets take a look at the system in a moment all actors are computing the next time-step. Is is non-determined which actor will terminate first (even if we know each one work load, it is impossible to know when they will terminate their computations). Even while computing they are checking their mailboxes because there are messages they can react to (for instance if they are asked if their run has ended or not). Messages they can not process stay in the queue. Messages are not processed in the order of arrival.

There is no need for a centralized controller, each actor has a state and reacts to the environment as a living organism. Inconsistencies or partial failures should be resolved in another layer, for instance with the help of supervisors (this is Erlang/OTP strategy).

[[File:am.02.png|thumb|left|alt=Actor MW3 is the first actor to terminate its time-step.|(1) Actor MW3 is the first actor to terminate its time-step.]]Suppose Actor MW3 is the first actor to terminate its time-step. It sends messages to other actors with border conditions. MW3 has no messages in its mailbox so it is idle. Actor MW2 has a message in its mailbox but it can not process it yet so the message stays there.
MW3 will react when a message arrives to its mailbox. When it gathers enough information to start a new time-step it will react triggering some computations. There is no central authority ordering it to start, stay idle, etc.

[[File:am.05.png|thumb|right|alt=Actor MW2 terminates time-step.|(2) Actor MW2 terminates time-step.]]Now actor MW2 has terminated time-step computations. It now sends 2 different messages to MW1 and MW3 respectively. MW2 is checking its message box's queue but it has not enough information to start a new time-step so it stays idle.
MW1 received a message form MW2 and will react accordingly.

[[File:am.03.png|thumb|left|alt=Actor MW1 terminates time-step.|(3) Actor MW1 terminates time-step.]]MW1 terminated the time-step. Meanwhile MW3 processed message M3 and is already computing the next time-step.
MW1 sends a message to MW2 and both actors have enough information to proceed (reacting to messages).

[[File:am.04.png|thumb|right|alt=All actors are working.|(4) All actors are working.]]All actors are computing a new time-step.

== Notes on the Actor Model ==

There are some remarks to be done:
<ul>
<li>each message is sent only once;</li>
<li>the sender does not verify if the message reaches its destination;</li>
<li>the order of arrival is independent of the order of sending;</li>
<li>each message is processed separately;</li>
<li>there is no central point of control; and</li>
<li>messages in mailbox are not processed in the order of arrival, there is a loop over the queue checking which messages the actor can react upon.</li>
</ul>

Actor Model

2014-11-30T19:02:51Z

Miranda ricardo:

According to the Wikipedia[http://en.wikipedia.org/wiki/Actor_model] "the actor model in computer science is a mathematical model of concurrent computation that treats "actors" as the universal primitives of concurrent digital computation: in response to a message that it receives, an actor can make local decisions, create more actors, send more messages, and determine how to respond to the next message received" (changing state). The actor model is a special form of [[Reactive Programming]].

There are several resources in the Internet explaining the Actor Model and Reactive Programing. Some videos and interesting interviews:
<ul>
<li>Hewitt, Meijer and Szyperski: The Actor Model (everything you wanted to know, but were afraid to ask)[http://channel9.msdn.com/Shows/Going+Deep/Hewitt-Meijer-and-Szyperski-The-Actor-Model-everything-you-wanted-to-know-but-were-afraid-to-ask];</li>
<li>Francesco Cesarini and Viktor Klang on the Reactive Manifesto[http://www.infoq.com/interviews/cesarini-klang-reactive-manifesto]; and</li>
<li>Up And Out Scaling Software With Akka - Jonas Bonér[http://www.youtube.com/watch?v=t4KxWDqGfcs]</li>
</ul>
To read on-line:
<ul>
<li>The Reactive Manifesto[http://www.reactivemanifesto.org/]; and</li>
<li>Learn You Some Erlang for great good![http://learnyousomeerlang.com/content];</li>
</ul>

The actor model makes it easier to reason about distributed programming. All MPI directives will be packed up in a set of well defined modules. Communication among actors takes place through clear and standard interfaces with well defined behaviors. This software architecture is proven to provide scalability, resilience and responsiveness. There is no central management and no points of synchronism so actors just react to events; this is a simpler way of reasoning about concurrency and parallelism.

According to Carl Hewitts' definition (Carl Hewitt; Peter Bishop; Richard Steiger (1973). A Universal Modular Actor Formalism for Artificial Intelligence. IJCAI) an actor is the fundamental unit of computation that embodies:
<ul>
<li>processing (the behavior, the executable code);</li>
<li>storage (its the state, the stuff on the heap, memory); and</li>
<li>communication.</li>
</ul>

When an actor receives a message it reacts:
<ul>
<li>sending messages to actors it knows (finite number);</li>
<li>creating new actors (finite number); and</li>
<li>designating how it should handle the next message it receives (changing state).</li>
</ul>

Here a [[Fortran implementation of the Actor Model using MPI]] is discussed.

The program to consolidate results from [[Domain Decomposition]]runs, [[Consolidate Domain Decomposition]], is the first using the actor model approach. It is a simple and small program, the perfect test bed before expanding to Mohid.

== Relevance of the Actor Model for the Mohid system ==

Mohid is a large system with complex memory management. With the commoditization of multi-core machines and access to fast local networks MPI is becoming the de facto way of running Mohid. MPI (Message Passing Interface) is a very powerful, standardized and portable message-passing system.

The way MPI is currently used in Mohid is difficult to implement, hard to understand and complex to maintain. It is essential to use MPI in such a way that it becomes easier to reason about:
<ul>
<li>standardizing MPI's implementation in Mohid, embedding it in the programming framework;</li>
<li>making explicit conventions on MPI usage of Mohid, for instance banning the use of semaphores and barriers;</li>
<li>there will be a very limited number of modules where MPI directives are allowed; and</li>
<li>MPI will be used to create explicit APIs (Application Programming Interface) that can be easily expanded and refactored according to Mohid's needs.</li>
</ul>

== Actor Model in Mohid ==

[[File:am.01.png|thumb|left|alt=Domain in decomposed in 3 subdomains creates 3 instances of MohidWater (MW1, MW2 and MW3).|Domain in decomposed in 3 subdomains.]]Suppose a domain is decomposed in 3 sub-domains according to the first image. Each subdomain is an actor that sends messages to other actors and reacts to messages it receives. Each model has a Main Loop that progresses in time-steps. Each model sends messages with information (for example border conditions) to actors that need it.

[[File:am.04.png|thumb|right|alt=All actors are working.|(0) All actors are working.]]Lets take a look at the system in a moment all actors are computing the next time-step. Is is non-determined which actor will terminate first (even if we know each one work load, it is impossible to know when they will terminate their computations). Even while computing they are checking their mailboxes because there are messages they can react to (for instance if they are asked if their run has ended or not). Messages they can not process stay in the queue. Messages are not processed in the order of arrival.

There is no need for a centralized controller, each actor has a state and reacts to the environment as a living organism. Inconsistencies or partial failures should be resolved in another layer, for instance with the help of supervisors (this is Erlang/OTP strategy).

[[File:am.02.png|thumb|left|alt=Actor MW3 is the first actor to terminate its time-step.|(1) Actor MW3 is the first actor to terminate its time-step.]]Suppose Actor MW3 is the first actor to terminate its time-step. It sends messages to other actors with border conditions. MW3 has no messages in its mailbox so it is idle. Actor MW2 has a message in its mailbox but it can not process it yet so the message stays there.
MW3 will react when a message arrives to its mailbox. When it gathers enough information to start a new time-step it will react triggering some computations. There is no central authority ordering it to start, stay idle, etc.

[[File:am.05.png|thumb|right|alt=Actor MW2 terminates time-step.|(2) Actor MW2 terminates time-step.]]Now actor MW2 has terminated time-step computations. It now sends 2 different messages to MW1 and MW3 respectively. MW2 is checking its message box's queue but it has not enough information to start a new time-step so it stays idle.
MW1 received a message form MW2 and will react accordingly.

[[File:am.03.png|thumb|left|alt=Actor MW1 terminates time-step.|(3) Actor MW1 terminates time-step.]]MW1 terminated the time-step. Meanwhile MW3 processed message M3 and is already computing the next time-step.
MW1 sends a message to MW2 and both actors have enough information to proceed (reacting to messages).

[[File:am.04.png|thumb|right|alt=All actors are working.|(4) All actors are working.]]All actors are computing a new time-step.

== Notes on the Actor Model ==

There are some remarks to be done:
<ul>
<li>each message is sent only once;</li>
<li>the sender does not verify if the message reaches its destination;</li>
<li>the order of arrival is independent of the order of sending;</li>
<li>each message is processed separately;</li>
<li>there is no central point of control; and</li>
<li>messages in mailbox are not processed in the order of arrival, there is a loop over the queue checking which messages the actor can react upon.</li>
</ul>

Domain Decomposition

2014-11-30T18:58:47Z

Miranda ricardo:

The Domaim Decomposition project aim is to enable Mohid's paralelization using MPI. Domain Decomposition divides a domain in a arbitrary number of subdomains that communicate among them. In the frontier between two subdomains border condtions are exchanged reciprocally between them.

== Subdomains ==
The domain decomposition project will start with the following subdomain charactistics:
# Subdomains are derived from a domain dividing it through straight lines in the indexes' directions (usually horizontal or vertical lines). Submodels inherit indexes from the initial domain.

Domain Decomposition

2014-11-30T18:57:48Z

Miranda ricardo:

The Domaim Decomposition project aim is to enable Mohid's paralelization using MPI. Domain Decomposition divides a domain in a arbitrary number of subdomains that communicate among them. In the frontier between two subdomains border condtions are exchanged reciprocally between them.

== Subdomains ==
The domail composition project will start with the following subdomain charactistics:
# Subdomains are derived from a domain dividing it through straight lines in the indexes' directions (usually horizontal or vertical lines). Submodels inherit indexes from the initial domain;
# Numerical schemes are explicit to facilitate data exchange.

Fortran implementation of the Actor Model using MPI

2014-11-30T18:54:17Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''[[pong]]'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself. File ''[[moduleMPImanagement]]'' is necessary to compile both programs.

If you examine the code there is no single MPI_BARRIER or any other explicit synchronization point. The main subroutine is:

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
STAT_CALL = UNDEFINED
pingPong => constructPingPong()
STAT_CALL = startGame(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if
call loop(pingPong) !This loop reads MPI messages
call EXIT(SUCCESS)
end subroutine main

There is a call to an infinite loop. This routine reads the MPI message queue identifying messages to itself (MPI_PROBE).

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)
STAT_CALL = UNDEFINED
call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if
if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if
else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then
STAT_CALL = killPingPong(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if
end if
end if
if (pingPong%gameON) call loop(pingPong)
end subroutine loop

In the recursive subroutine loop 2 messages are processed: getMsgPlayBall3Tag and getMsgEndGameTag. As promised by the actor model:
*internal state is encapsulated;
*messages are processed one at a time; and
*communication is asynchronous.

Fortran implementation of the Actor Model using MPI

2014-11-30T18:52:44Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''[[pong]]'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself. File ''[[moduleMPImanagement]]'' is necessary to compile both programs.

If you examine the code there is no single MPI_BARRIER or any other explicit synchronization point. The main subroutine is:

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
STAT_CALL = UNDEFINED
pingPong => constructPingPong()
STAT_CALL = startGame(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if
call loop(pingPong) !This loop reads MPI messages
call EXIT(SUCCESS)
end subroutine main

There is a call to an infinite loop. This routine reads the MPI message queue identifying messages to itself (MPI_PROBE).

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)
STAT_CALL = UNDEFINED
call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if
if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if
else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then
STAT_CALL = killPingPong(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if
end if
end if
if (pingPong%gameON) call loop(pingPong)
end subroutine loop

In the recursive subroutine loop 2 messages are processed: getMsgPlayBall3Tag and getMsgEndGameTag. As promised by the actor model:
*internal state is completely encapsulated;
*messages are processed one at a time; and
*communication is asynchronous.

Fortran implementation of the Actor Model using MPI

2014-11-30T18:51:28Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''[[pong]]'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself. File ''[[moduleMPImanagement]]'' is necessary to compile both programs.

If you examine the code there is no single MPI_BARRIER or any other explicit synchronization point. The main subroutine is:

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
STAT_CALL = UNDEFINED
pingPong => constructPingPong()
STAT_CALL = startGame(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if
call loop(pingPong) !This loop reads MPI messages
call EXIT(SUCCESS)
end subroutine main

There is a call to an infinite loop. This routine reads the MPI message queue identifying messages to itself (MPI_PROBE).

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)
STAT_CALL = UNDEFINED
call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if
if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if
else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then
STAT_CALL = killPingPong(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if
end if
end if
if (pingPong%gameON) call loop(pingPong)
end subroutine loop

In the recursive subroutine loop 2 messages are processed: getMsgPlayBall3Tag and getMsgEndGameTag. As promised by the actor model:
#internal state is completely encapsulated;
#messages are processed one at a time; and
#communication is asynchronous.

Fortran implementation of the Actor Model using MPI

2014-11-30T18:46:15Z

Miranda ricardo:

Fortran implementation of the Actor Model using MPI

2014-11-30T18:40:39Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''[[pong]]'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself. File ''[[moduleMPImanagement]]'' is necessary to compile both programs.

If you examine the code there is no single MPI_BARRIER or any other explicit synchronization point. The main routine is:

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
STAT_CALL = UNDEFINED
pingPong => constructPingPong()
STAT_CALL = startGame(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if
call loop(pingPong) !This loop reads MPI messages
call EXIT(SUCCESS)
end subroutine main

There is a call to an infinite loop. This routine reads the MPI message queue identifying messages to itself.

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)
STAT_CALL = UNDEFINED
call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if
if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if
else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then
STAT_CALL = killPingPong(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if
end if
end if
if (pingPong%gameON) call loop(pingPong)
end subroutine loop

Fortran implementation of the Actor Model using MPI

2014-11-30T18:40:06Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''[[pong]]'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself. File ''[[moduleMPImanagement]]'' is necessary to compile both programs.

If you examine the code there is no single MPI_BARRIER or any other explicit synchronization point. The main routine is:

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
STAT_CALL = UNDEFINED
pingPong => constructPingPong()
STAT_CALL = startGame(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if
call loop(pingPong) !This loop reads MPI messages
call EXIT(SUCCESS)
end subroutine main

There is a call to an infinite loop. This routine reads the MPI message queue identifying messages to itself.

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if

if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then
STAT_CALL = killPingPong(pingPong)
if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if
end if
end if

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

Fortran implementation of the Actor Model using MPI

2014-11-30T18:33:55Z

Miranda ricardo:

Fortran implementation of the Actor Model using MPI

2014-11-30T18:33:32Z

Miranda ricardo:

Fortran implementation of the Actor Model using MPI

2014-11-30T18:30:19Z

Miranda ricardo:

Pong

2014-11-30T18:25:28Z

Miranda ricardo:

!------------------------------------------------------------------------------

! IST/MARETEC, Water Modelling Group, Mohid modelling system

!------------------------------------------------------------------------------

!

! TITLE : pong

! PROJECT : Example of the actor model using Fortran and MPI

! URL : http://www.mohid.com

! AFFILIATION : IST/MARETEC, Marine Modelling Group

! DATE : Nov 2014

! REVISION : Rciardo Miranda - v1.0

!

!------------------------------------------------------------------------------

!

!This program is free software; you can redistribute it and/or

!modify it under the terms of the GNU General Public License

!version 2, as published by the Free Software Foundation.

!

!This program is distributed in the hope that it will be useful,

!but WITHOUT ANY WARRANTY; without even the implied warranty of

!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

!GNU General Public License for more details.

!

!You should have received a copy of the GNU General Public License

!along with this program; if not, write to the Free Software

!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

!

!------------------------------------------------------------------------------

!

! Compile:

! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/pong /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagement.f90 /myDirectory/projects /lang/fortran/MPI/pingPong/pong.f90

!

! Run:

! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/ping : -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong

program pong
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -1, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall1Tag()) then
STAT_CALL = receiveBall1(pingPong)

if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall1, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgPlayBall2Tag()) then if42
STAT_CALL = receiveBall2(pingPong)

if44 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall2, ERR02"
end if if44

else if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then if42
STAT_CALL = receiveBall3(pingPong)

if45 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall3, ERR02"
end if if45

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if35 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall1, error calling MPI_RECV, ERR01"
end if if35

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if62 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall1, error calling setOtherCounting, ERR04"
end if if62

print*, "pong, receiveBall1 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call sleep(2)
call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

call sleep(5)
call doSomething()
call doSomething()

receiveBall1 = SUCCESS
end function receiveBall1

!---------------------------------------------------------------------------

integer function receiveBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall2, error calling MPI_RECV, ERR01a"
end if if25

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if61 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall2, error calling setOtherCounting, ERR04"
end if if61

print*, "pong, receiveBall2 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call sleep(2)
call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall2 = SUCCESS
end function receiveBall2

!---------------------------------------------------------------------------

integer function receiveBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall3, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall3, error calling setOtherCounting, ERR04"
end if if6

print*, "pong, receiveBall3 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall3 = SUCCESS
end function receiveBall3

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

do1 : do i=1,1000000000
do2 : do j=1,1000000000
do3 : do k=1,1000000000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall, error calling MPI_SEND, ERR02"
end if if6

sendBall = SUCCESS
end function sendBall

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, pong"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program pong

Ping

2014-11-30T18:25:05Z

Miranda ricardo:

!------------------------------------------------------------------------------

! IST/MARETEC, Water Modelling Group, Mohid modelling system

!------------------------------------------------------------------------------

!

! TITLE : ping

! PROJECT : Example of the actor model using Fortran and MPI

! URL : http://www.mohid.com

! AFFILIATION : IST/MARETEC, Marine Modelling Group

! DATE : Nov 2014

! REVISION : Rciardo Miranda - v1.0

!

!------------------------------------------------------------------------------

!

!This program is free software; you can redistribute it and/or

!modify it under the terms of the GNU General Public License

!version 2, as published by the Free Software Foundation.

!

!This program is distributed in the hope that it will be useful,

!but WITHOUT ANY WARRANTY; without even the implied warranty of

!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

!GNU General Public License for more details.

!

!You should have received a copy of the GNU General Public License

!along with this program; if not, write to the Free Software

!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

!

!------------------------------------------------------------------------------

!

! Compile:

! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/ping /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagement.f90 /myDirectory/projects/lang/fortran/MPI/pingPong/ping.f90

!

! Run:

! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong : -n /myDirectory/projects/lang/fortran/MPI/pingPong/ping

program ping
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -10, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall1(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall1, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall(pingPong, msgTag)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: msgTag
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling setOtherCounting, ERR04"
end if if6

print*, "ping, receiveBall getMyMPI_id =", getMyMPI_id(pingPong), &
"getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
if70 : if ( mod(getCounting(pingPong), 2) .EQ. 0) then
STAT_CALL = sendBall1(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall1, ERR01"
end if if7

else if ((mod(getCounting(pingPong), 3) .EQ. 0) .AND. &
(mod(getCounting(pingPong), 2) .NE. 0)) then if70
STAT_CALL = sendBall2(pingPong)
if75 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall2, ERR01"
end if if75

else if70
STAT_CALL = sendBall3(pingPong)
if76 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall3, ERR01"
end if if76
end if if70
else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall = SUCCESS
end function receiveBall

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

call sleep(10)

do1 : do i=1,1000
do2 : do j=1,1000
do3 : do k=1,1000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling MPI_SEND, ERR012"
end if if16

sendBall1 = SUCCESS
end function sendBall1

!---------------------------------------------------------------------------

integer function sendBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling MPI_SEND, ERR012"
end if if16

sendBall2 = SUCCESS
end function sendBall2

!---------------------------------------------------------------------------

integer function sendBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling MPI_SEND, ERR012"
end if if16

sendBall3 = SUCCESS
end function sendBall3

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, ping"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program ping

ModuleMPImanagement

2014-11-30T18:24:22Z

Miranda ricardo: Created page with "!------------------------------------------------------------------------------ ! IST/MARETEC, Water Modelling Group, Mohid modelling system !-----------------------------..."

Fortran implementation of the Actor Model using MPI

2014-11-30T18:23:26Z

Miranda ricardo:

Fortran implementation of the Actor Model using MPI

2014-11-30T18:23:13Z

Miranda ricardo:

Fortran implementation of the Actor Model using MPI

2014-11-30T18:22:57Z

Miranda ricardo:

Pong

2014-11-30T18:15:32Z

!------------------------------------------------------------------------------

! IST/MARETEC, Water Modelling Group, Mohid modelling system

!------------------------------------------------------------------------------

!

! TITLE : pong

! PROJECT : Example of the actor model using Fortran and MPI

! URL : http://www.mohid.com

! AFFILIATION : IST/MARETEC, Marine Modelling Group

! DATE : Nov 2014

! REVISION : Rciardo Miranda - v1.0

!

!------------------------------------------------------------------------------

!

!This program is free software; you can redistribute it and/or

!modify it under the terms of the GNU General Public License

!version 2, as published by the Free Software Foundation.

!

!This program is distributed in the hope that it will be useful,

!but WITHOUT ANY WARRANTY; without even the implied warranty of

!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

!GNU General Public License for more details.

!

!You should have received a copy of the GNU General Public License

!along with this program; if not, write to the Free Software

!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

!

!------------------------------------------------------------------------------

!

! Compile:

! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/pong /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagemnt.f90 /myDirectory/projects /lang/fortran/MPI/pingPong/pong.f90

!

! Run:

! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/ping : -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong

program pong
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -1, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall1Tag()) then
STAT_CALL = receiveBall1(pingPong)

if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall1, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgPlayBall2Tag()) then if42
STAT_CALL = receiveBall2(pingPong)

if44 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall2, ERR02"
end if if44

else if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then if42
STAT_CALL = receiveBall3(pingPong)

if45 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall3, ERR02"
end if if45

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if35 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall1, error calling MPI_RECV, ERR01"
end if if35

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if62 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall1, error calling setOtherCounting, ERR04"
end if if62

print*, "pong, receiveBall1 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call sleep(2)
call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

call sleep(5)
call doSomething()
call doSomething()

receiveBall1 = SUCCESS
end function receiveBall1

!---------------------------------------------------------------------------

integer function receiveBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall2, error calling MPI_RECV, ERR01a"
end if if25

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if61 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall2, error calling setOtherCounting, ERR04"
end if if61

print*, "pong, receiveBall2 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call sleep(2)
call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall2 = SUCCESS
end function receiveBall2

!---------------------------------------------------------------------------

integer function receiveBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall3, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall3, error calling setOtherCounting, ERR04"
end if if6

print*, "pong, receiveBall3 getMyMPI_id =", getMyMPI_id(pingPong), "getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

if71 : if (getCounting(pingPong) .GT. 0) then
STAT_CALL = sendBall(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall, ERR01"
end if if7

else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall3 = SUCCESS
end function receiveBall3

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

do1 : do i=1,1000000000
do2 : do j=1,1000000000
do3 : do k=1,1000000000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall, error calling MPI_SEND, ERR02"
end if if6

sendBall = SUCCESS
end function sendBall

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, pong"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program pong

Fortran implementation of the Actor Model using MPI

2014-11-30T18:13:14Z

Miranda ricardo:

Ping

2014-11-30T18:12:13Z

Miranda ricardo:

!------------------------------------------------------------------------------

! IST/MARETEC, Water Modelling Group, Mohid modelling system

!------------------------------------------------------------------------------

!

! TITLE : ping

! PROJECT : Example of the actor model using Fortran and MPI

! URL : http://www.mohid.com

! AFFILIATION : IST/MARETEC, Marine Modelling Group

! DATE : Nov 2014

! REVISION : Rciardo Miranda - v1.0

!

!------------------------------------------------------------------------------

!

!This program is free software; you can redistribute it and/or

!modify it under the terms of the GNU General Public License

!version 2, as published by the Free Software Foundation.

!

!This program is distributed in the hope that it will be useful,

!but WITHOUT ANY WARRANTY; without even the implied warranty of

!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

!GNU General Public License for more details.

!

!You should have received a copy of the GNU General Public License

!along with this program; if not, write to the Free Software

!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

!

!------------------------------------------------------------------------------

!

! Compile:

! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/ping /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagemnt.f90 /myDirectory/projects/lang/fortran/MPI/pingPong/ping.f90

!

! Run:

! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong : -n /myDirectory/projects/lang/fortran/MPI/pingPong/ping

program ping
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -10, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall1(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall1, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall(pingPong, msgTag)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: msgTag
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling setOtherCounting, ERR04"
end if if6

print*, "ping, receiveBall getMyMPI_id =", getMyMPI_id(pingPong), &
"getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
if70 : if ( mod(getCounting(pingPong), 2) .EQ. 0) then
STAT_CALL = sendBall1(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall1, ERR01"
end if if7

else if ((mod(getCounting(pingPong), 3) .EQ. 0) .AND. &
(mod(getCounting(pingPong), 2) .NE. 0)) then if70
STAT_CALL = sendBall2(pingPong)
if75 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall2, ERR01"
end if if75

else if70
STAT_CALL = sendBall3(pingPong)
if76 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall3, ERR01"
end if if76
end if if70
else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall = SUCCESS
end function receiveBall

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

call sleep(10)

do1 : do i=1,1000
do2 : do j=1,1000
do3 : do k=1,1000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling MPI_SEND, ERR012"
end if if16

sendBall1 = SUCCESS
end function sendBall1

!---------------------------------------------------------------------------

integer function sendBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling MPI_SEND, ERR012"
end if if16

sendBall2 = SUCCESS
end function sendBall2

!---------------------------------------------------------------------------

integer function sendBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling MPI_SEND, ERR012"
end if if16

sendBall3 = SUCCESS
end function sendBall3

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, ping"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program ping

Ping

2014-11-30T18:10:50Z

Miranda ricardo:

!------------------------------------------------------------------------------

! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : ping
! PROJECT : Example of the actor model using Fortran and MPI
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : Nov 2014
! REVISION : Rciardo Miranda - v1.0
!
!------------------------------------------------------------------------------
!
!This program is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public License
!version 2, as published by the Free Software Foundation.
!
!This program is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!GNU General Public License for more details.
!
!You should have received a copy of the GNU General Public License
!along with this program; if not, write to the Free Software
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!------------------------------------------------------------------------------
!
! Compile:
! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/ping /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagemnt.f90 /myDirectory/projects/lang/fortran/MPI/pingPong/ping.f90
!
! Run:
! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong : -n /myDirectory/projects/lang/fortran/MPI/pingPong/ping

program ping
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -10, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall1(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall1, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall(pingPong, msgTag)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: msgTag
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling setOtherCounting, ERR04"
end if if6

print*, "ping, receiveBall getMyMPI_id =", getMyMPI_id(pingPong), &
"getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
if70 : if ( mod(getCounting(pingPong), 2) .EQ. 0) then
STAT_CALL = sendBall1(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall1, ERR01"
end if if7

else if ((mod(getCounting(pingPong), 3) .EQ. 0) .AND. &
(mod(getCounting(pingPong), 2) .NE. 0)) then if70
STAT_CALL = sendBall2(pingPong)
if75 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall2, ERR01"
end if if75

else if70
STAT_CALL = sendBall3(pingPong)
if76 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall3, ERR01"
end if if76
end if if70
else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall = SUCCESS
end function receiveBall

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

call sleep(10)

do1 : do i=1,1000
do2 : do j=1,1000
do3 : do k=1,1000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling MPI_SEND, ERR012"
end if if16

sendBall1 = SUCCESS
end function sendBall1

!---------------------------------------------------------------------------

integer function sendBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling MPI_SEND, ERR012"
end if if16

sendBall2 = SUCCESS
end function sendBall2

!---------------------------------------------------------------------------

integer function sendBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling MPI_SEND, ERR012"
end if if16

sendBall3 = SUCCESS
end function sendBall3

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, ping"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program ping

Ping

2014-11-30T18:09:49Z

!------------------------------------------------------------------------------
! IST/MARETEC, Water Modelling Group, Mohid modelling system
!------------------------------------------------------------------------------
!
! TITLE : ping
! PROJECT : Example of the actor model using Fortran and MPI
! URL : http://www.mohid.com
! AFFILIATION : IST/MARETEC, Marine Modelling Group
! DATE : Nov 2014
! REVISION : Rciardo Miranda - v1.0
!
!------------------------------------------------------------------------------
!
!This program is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public License
!version 2, as published by the Free Software Foundation.
!
!This program is distributed in the hope that it will be useful,
!but WITHOUT ANY WARRANTY; without even the implied warranty of
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!GNU General Public License for more details.
!
!You should have received a copy of the GNU General Public License
!along with this program; if not, write to the Free Software
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
!
!------------------------------------------------------------------------------
!
! Compile:
! mpif90 -o /myDirectory/projects/lang/fortran/MPI/pingPong/ping /myDirectory/projects/lang/fortran/MPI/pingPong/moduleMPImanagemnt.f90 /myDirectory/projects/lang/fortran/MPI/pingPong/ping.f90
!
! Run:
! /opt/mpich/bin/mpiexec -n 1 /myDirectory/projects/lang/fortran/MPI/pingPong/pong : -n /myDirectory/projects/lang/fortran/MPI/pingPong/ping

program ping
use mpi
use moduleMPImanagemnt

implicit none

integer, parameter :: UNDEFINED =-99
integer, parameter :: SUCCESS = 0
integer, parameter :: NULL_INT =-999999

type T_pingPong
integer :: myMPI_id = NULL_INT
logical :: hasBall =.FALSE.
logical :: gameON =.TRUE.
integer :: counting = NULL_INT
integer :: otherCounting = NULL_INT

integer :: otherMPI_id = NULL_INT
end type T_pingPong

call main()

contains

!---------------------------------------------------------------------------

subroutine main()
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

pingPong => constructPingPong()

STAT_CALL = startGame(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling startGame, ERR01"
end if if1

call loop(pingPong)

call EXIT(SUCCESS)

end subroutine main

!---------------------------------------------------------------------------

function constructPingPong()
type(T_pingPong), pointer :: constructPingPong
type(T_pingPong), pointer :: newPingPong

allocate(newPingPong)
newPingPong%myMPI_id = startMPI(newPingPong)

constructPingPong => newPingPong
end function constructPingPong

!---------------------------------------------------------------------------

integer function startGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: counting
integer,dimension(8) :: values
integer :: sec, rand, aux, I

STAT_CALL = UNDEFINED

call DATE_AND_TIME(VALUES=values)
sec = values(7)
call SRAND(sec)

aux = rand(0)
do1 : do I = -10, aux
counting = MAX(5, rand(0) / 100000)
end do do1

STAT_CALL = setCounting(pingPong, counting = counting)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling setCounting, ERR01"
end if if2

STAT_CALL = sendBall1(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startGame, error calling sendBall1, ERR02"
end if if3

startGame = SUCCESS
end function startGame

!---------------------------------------------------------------------------

integer function startMPI(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL, myMPI_id, numprocs

STAT_CALL = UNDEFINED
myMPI_id = NULL_INT
numprocs = NULL_INT

call MPI_INIT(IERROR = STAT_CALL)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_INIT, ERR01"
end if if1

call MPI_COMM_RANK(MPI_COMM_WORLD, &
myMPI_id, &
IERROR = STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_RANK, ERR02.1"
end if if2

STAT_CALL = setMyMPI_id(pingPong, myMPI_id)
if21 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setMyMPI_id, ERR02.2"
end if if21

call MPI_COMM_SIZE(MPI_COMM_WORLD, &
numprocs, &
IERROR = STAT_CALL)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling MPI_COMM_SIZE, ERR03"
end if if3

print *, 'Process ', myMPI_id, ' of ', numprocs, ' is alive'

if5 : if (getMyMPI_id(pingPong) .EQ. 0) then
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 1)
if51 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR05"
end if if51
else if (getMyMPI_id(pingPong) .EQ. 1) then if5
STAT_CALL = setOtherMPI_id(pingPong, otherMPI_id = 0)
if52 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function startMPI, error calling setOtherMPI_id, ERR06"
end if if52
else if5
stop "function startMPI, ERR07"
end if if5

startMPI = myMPI_id
end function startMPI

!---------------------------------------------------------------------------

integer function getCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getCounting = pingPong%counting
end function getCounting
!---------------------------------------------------------------------------

integer function getOtherCounting(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherCounting = pingPong%otherCounting
end function getOtherCounting

!---------------------------------------------------------------------------

integer function getMyMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getMyMPI_id = pingPong%myMPI_id
end function getMyMPI_id

!---------------------------------------------------------------------------

integer function getOtherMPI_id(pingPong)
type(T_pingPong), pointer :: pingPong

getOtherMPI_id = pingPong%otherMPI_id
end function getOtherMPI_id

!---------------------------------------------------------------------------

integer function setOtherCounting(pingPong, otherCounting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherCounting

pingPong%otherCounting = otherCounting

setOtherCounting = SUCCESS
end function setOtherCounting
!---------------------------------------------------------------------------

integer function setCounting(pingPong, counting)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: counting

pingPong%counting = counting

setCounting = SUCCESS
end function setCounting

!---------------------------------------------------------------------------

integer function decreaseCounting(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%counting = getCounting(pingPong)-1

decreaseCounting = SUCCESS
end function decreaseCounting

!---------------------------------------------------------------------------

integer function setMyMPI_id(pingPong, myMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: myMPI_id

pingPong%myMPI_id = myMPI_id

setMyMPI_id = SUCCESS
end function setMyMPI_id

!---------------------------------------------------------------------------

integer function setOtherMPI_id(pingPong, otherMPI_id)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: otherMPI_id

pingPong%otherMPI_id = otherMPI_id

setOtherMPI_id = SUCCESS
end function setOtherMPI_id

!---------------------------------------------------------------------------

integer function setHasBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.TRUE.

setHasBall = SUCCESS
end function setHasBall

!---------------------------------------------------------------------------

integer function setHasNoBall(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%hasBall =.FALSE.

setHasNoBall = SUCCESS
end function setHasNoBall

!---------------------------------------------------------------------------

integer function setGameOFF(pingPong)
type(T_pingPong), pointer :: pingPong

pingPong%gameON =.FALSE.

setGameOFF = SUCCESS
end function setGameOFF

!---------------------------------------------------------------------------

recursive subroutine loop(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL
integer :: STATUS(MPI_STATUS_SIZE)

STAT_CALL = UNDEFINED

call MPI_PROBE(MPI_ANY_SOURCE, &
MPI_ANY_TAG, &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if25 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling MPI_PROBE, ERR01"
end if if25

if41 : if (STATUS(MPI_SOURCE) .EQ. getOtherMPI_id(pingPong)) then
if42 : if (STATUS(MPI_TAG) .EQ. getMsgPlayBall3Tag()) then
STAT_CALL = receiveBall(pingPong, STATUS(MPI_TAG))
if4 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine loop, error calling receiveBall, ERR02"
end if if4

else if (STATUS(MPI_TAG) .EQ. getMsgEndGameTag()) then if42
STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if2
end if if42
end if if41

if (pingPong%gameON) call loop(pingPong)
end subroutine loop

!---------------------------------------------------------------------------

integer function receiveBall(pingPong, msgTag)
type(T_pingPong), pointer :: pingPong
integer, intent(IN) :: msgTag
integer :: STATUS(MPI_STATUS_SIZE)
integer :: counting
integer :: STAT_CALL
integer :: i1, i2

STAT_CALL = UNDEFINED
counting = NULL_INT

call MPI_RECV(counting, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STATUS, &
STAT_CALL)
if5 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling MPI_RECV, ERR01b"
end if if5

STAT_CALL = setOtherCounting(pingPong, otherCounting = counting)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling setOtherCounting, ERR04"
end if if6

print*, "ping, receiveBall getMyMPI_id =", getMyMPI_id(pingPong), &
"getCounting =", getCounting(pingPong), &
"getOtherCounting =", getOtherCounting(pingPong)

call doSomething()

if71 : if (getCounting(pingPong) .GT. 0) then
if70 : if ( mod(getCounting(pingPong), 2) .EQ. 0) then
STAT_CALL = sendBall1(pingPong)
if7 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall1, ERR01"
end if if7

else if ((mod(getCounting(pingPong), 3) .EQ. 0) .AND. &
(mod(getCounting(pingPong), 2) .NE. 0)) then if70
STAT_CALL = sendBall2(pingPong)
if75 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall2, ERR01"
end if if75

else if70
STAT_CALL = sendBall3(pingPong)
if76 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function receiveBall, error calling sendBall3, ERR01"
end if if76
end if if70
else if71
! Program terminates because there are no more plays
STAT_CALL = sendKillGame(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR02"
end if if3

STAT_CALL = killPingPong(pingPong)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "subroutine main, error calling killPingPong, ERR03"
end if if2
end if if71

receiveBall = SUCCESS
end function receiveBall

!---------------------------------------------------------------------------

subroutine doSomething
integer :: i,j,k, res1, res2, res3

call sleep(10)

do1 : do i=1,1000
do2 : do j=1,1000
do3 : do k=1,1000
res1=i*j+j/(k**2)*(-1.0)
res2=i*j+j/(k**2)*(-21.0)
res3=MAX(res1, res2)
end do do3
end do do2
end do do1

end subroutine doSomething

!---------------------------------------------------------------------------

integer function sendBall1(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall1Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall1, error calling MPI_SEND, ERR012"
end if if16

sendBall1 = SUCCESS
end function sendBall1

!---------------------------------------------------------------------------

integer function sendBall2(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall2Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall2, error calling MPI_SEND, ERR012"
end if if16

sendBall2 = SUCCESS
end function sendBall2

!---------------------------------------------------------------------------

integer function sendBall3(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = decreaseCounting(pingPong)
if1 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling decreaseCounting, ERR01"
end if if1

call MPI_SEND(getCounting(pingPong), &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgPlayBall3Tag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendBall3, error calling MPI_SEND, ERR012"
end if if16

sendBall3 = SUCCESS
end function sendBall3

!---------------------------------------------------------------------------

integer function sendKillGame(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_SEND(NULL_INT, &
1, &
MPI_INTEGER, &
getOtherMPI_id(pingPong), &
getMsgEndGameTag(), &
MPI_COMM_WORLD, &
STAT_CALL)
if16 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function sendKillGame, error calling MPI_SEND, ERR01"
end if if16

sendKillGame = SUCCESS
end function sendKillGame

!---------------------------------------------------------------------------

integer function killPingPong(pingPong)
type(T_pingPong), pointer :: pingPong
integer :: STAT_CALL

STAT_CALL = UNDEFINED

STAT_CALL = stopMPI()
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling stopMPI, ERR01"
end if if2

print*, "Ping Pong Terminated, ping"

STAT_CALL = setGameOFF(pingPong)
if3 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function killPingPong, error calling setGameOFF, ERR01"
end if if3

killPingPong = SUCCESS
end function killPingPong
!---------------------------------------------------------------------------

integer function stopMPI()
integer :: STAT_CALL

STAT_CALL = UNDEFINED

call MPI_BARRIER(MPI_COMM_WORLD, &
IERROR = STAT_CALL)
if6 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_BARRIER, ERR01"
end if if6

call MPI_FINALIZE(STAT_CALL)
if2 : if (STAT_CALL .NE. SUCCESS) then
print*, "STAT_CALL = ", STAT_CALL
stop "function stopMPI, error calling MPI_FINALIZE, ERR02"
end if if2

stopMPI = SUCCESS
end function stopMPI
end program ping

Fortran implementation of the Actor Model using MPI

2014-11-30T18:02:39Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''[[ping]]'' and ''pong'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself.

Fortran implementation of the Actor Model using MPI

2014-11-30T17:49:27Z

Miranda ricardo:

A very simple ping-pong program is shown here. There are 2 programs, ''ping'' and ''pong'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself.

Fortran implementation of the Actor Model using MPI

2014-11-30T17:48:55Z

Miranda ricardo:

A very simple pingpong program is shown here. There are 2 programs, ''ping'' and ''pong'', that shoot messages among them, starting each with a random number of plays. The first program reaching 0 will send a message for the other program to stop and stops itself.

Reactive Programming

2014-10-14T21:54:39Z

Miranda ricardo: /* Asynchronous dataflow */

According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of change. This means that it should be possible to express static or dynamic data flows with ease in the programming languages used, and that the underlying execution model will automatically propagate changes through the data flow."

"For example, in an '''imperative programming setting''', <math>a := b + c</math> would mean that <math>a</math> is being assigned the result of <math>b + c</math> in the instant the expression is evaluated. Later, the values of <math>b</math> and <math>c</math> can be changed with no effect on the value of <math>a</math>."

"In '''reactive programming''', the value of <math>a</math> would be automatically updated based on the new values."

== MS Excel is a reactive programming environment ==
Continuing from Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "A modern spreadsheet program is an example of reactive programming. Spreadsheet cells can contain literal values, or formulas such as "=<math>B1+C1</math>" that are evaluated based on other cells. Whenever the value of the other cells change, the value of the formula is automatically updated."

== Decoupling data from operations on data ==
To have a data flow between nodes it is necessary to decouple data from operations on data. Messages, tokens in data flow parlance, are send from node to node through arcs.
Dut to the non-deterministic nature of a large system like Mohid, a asynchronous approach was chosen, using the Hollywood principle (stated as "don't call us, we'll call you."[http://en.wikipedia.org/wiki/Hollywood_principle]). Here we will focus on asynchronous reactive dataflow systems, focusing on the actor model. Reactive dataflow systems can be:
*asynchronous; or
*synchronous.

=== Asynchronous dataflow ===
According to Matt Carcki[https://leanpub.com/dataflowbook] "Asynchronous execution is when a node fires any time that its activation preconditions are met, possibly at the same time as other nodes".

=== Synchronous dataflow ===
Still according to Matt Carcki[https://leanpub.com/dataflowbook] "Synchronous execution is when the nodes fires on a pre-calculated, fixed schedule. This implies that the program has to be compiled first to build the schedule. The schedule determines which nodes have to fire before others, how often they have to fire and which nodes can fire simultaneously". Synchronous dataflow requires the token rate to be known at design time.

Reactive Programming

2014-10-14T21:54:17Z

Miranda ricardo: /* Synchronous dataflow */

According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of change. This means that it should be possible to express static or dynamic data flows with ease in the programming languages used, and that the underlying execution model will automatically propagate changes through the data flow."

"For example, in an '''imperative programming setting''', <math>a := b + c</math> would mean that <math>a</math> is being assigned the result of <math>b + c</math> in the instant the expression is evaluated. Later, the values of <math>b</math> and <math>c</math> can be changed with no effect on the value of <math>a</math>."

"In '''reactive programming''', the value of <math>a</math> would be automatically updated based on the new values."

== MS Excel is a reactive programming environment ==
Continuing from Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "A modern spreadsheet program is an example of reactive programming. Spreadsheet cells can contain literal values, or formulas such as "=<math>B1+C1</math>" that are evaluated based on other cells. Whenever the value of the other cells change, the value of the formula is automatically updated."

== Decoupling data from operations on data ==
To have a data flow between nodes it is necessary to decouple data from operations on data. Messages, tokens in data flow parlance, are send from node to node through arcs.
Dut to the non-deterministic nature of a large system like Mohid, a asynchronous approach was chosen, using the Hollywood principle (stated as "don't call us, we'll call you."[http://en.wikipedia.org/wiki/Hollywood_principle]). Here we will focus on asynchronous reactive dataflow systems, focusing on the actor model. Reactive dataflow systems can be:
*asynchronous; or
*synchronous.

=== Asynchronous dataflow ===
According to Matt Carcki[https://leanpub.com/dataflowbook] "Asynchronous execution is when a node fires any time that its activation preconditions are met, possibly at the same time as other nodes."

=== Synchronous dataflow ===
Still according to Matt Carcki[https://leanpub.com/dataflowbook] "Synchronous execution is when the nodes fires on a pre-calculated, fixed schedule. This implies that the program has to be compiled first to build the schedule. The schedule determines which nodes have to fire before others, how often they have to fire and which nodes can fire simultaneously". Synchronous dataflow requires the token rate to be known at design time.

Reactive Programming

2014-10-14T16:45:21Z

Miranda ricardo: /* Decoupling data from operations on data */

According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of change. This means that it should be possible to express static or dynamic data flows with ease in the programming languages used, and that the underlying execution model will automatically propagate changes through the data flow."

"For example, in an '''imperative programming setting''', <math>a := b + c</math> would mean that <math>a</math> is being assigned the result of <math>b + c</math> in the instant the expression is evaluated. Later, the values of <math>b</math> and <math>c</math> can be changed with no effect on the value of <math>a</math>."

"In '''reactive programming''', the value of <math>a</math> would be automatically updated based on the new values."

== MS Excel is a reactive programming environment ==
Continuing from Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "A modern spreadsheet program is an example of reactive programming. Spreadsheet cells can contain literal values, or formulas such as "=<math>B1+C1</math>" that are evaluated based on other cells. Whenever the value of the other cells change, the value of the formula is automatically updated."

== Decoupling data from operations on data ==
To have a data flow between nodes it is necessary to decouple data from operations on data. Messages, tokens in data flow parlance, are send from node to node through arcs.
Dut to the non-deterministic nature of a large system like Mohid, a asynchronous approach was chosen, using the Hollywood principle (stated as "don't call us, we'll call you."[http://en.wikipedia.org/wiki/Hollywood_principle]). Here we will focus on asynchronous reactive dataflow systems, focusing on the actor model. Reactive dataflow systems can be:
*asynchronous; or
*synchronous.

=== Asynchronous dataflow ===
According to Matt Carcki[https://leanpub.com/dataflowbook] "Asynchronous execution is when a node fires any time that its activation preconditions are met, possibly at the same time as other nodes."

=== Synchronous dataflow ===
Still according to Matt Carcki[https://leanpub.com/dataflowbook] "Synchronous execution is when the nodes fires on a pre-calculated, fixed schedule. This implies that the program has to be compiled first to build the schedule. The schedule determines which nodes have to fire before others, how often they have to fire and which nodes can fire simultaneously."

Synchronous dataflow requires the token rate to be known at design time.

Reactive Programming

2014-10-14T16:31:02Z

Miranda ricardo: /* Decoupling data from operations on data */

According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of change. This means that it should be possible to express static or dynamic data flows with ease in the programming languages used, and that the underlying execution model will automatically propagate changes through the data flow."

"For example, in an '''imperative programming setting''', <math>a := b + c</math> would mean that <math>a</math> is being assigned the result of <math>b + c</math> in the instant the expression is evaluated. Later, the values of <math>b</math> and <math>c</math> can be changed with no effect on the value of <math>a</math>."

"In '''reactive programming''', the value of <math>a</math> would be automatically updated based on the new values."

== MS Excel is a reactive programming environment ==
Continuing from Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "A modern spreadsheet program is an example of reactive programming. Spreadsheet cells can contain literal values, or formulas such as "=<math>B1+C1</math>" that are evaluated based on other cells. Whenever the value of the other cells change, the value of the formula is automatically updated."

== Decoupling data from operations on data ==
To have a data flow between nodes it is necessary to decouple data from operations on data. Messages, tokens in data flow parlance, are send from node to node through arcs.
Dut to the non-deterministic nature of a large system like Mohid, a asynchronous approach was chosen, using the Hollywood principle (stated as "don't call us, we'll call you."[http://en.wikipedia.org/wiki/Hollywood_principle]). Here we will focus on asynchronous reactive dataflow systems, focusing on the actor model. Reactive dataflow systems can be:
*asynchronous; or
*synchronous.

=== Asynchronous dataflow ===
According to Matt Carcki[https://leanpub.com/dataflowbook] "Asynchronous execution is when a node fires any time that its activation preconditions are met, possibly at the same time as other nodes."

=== Synchronous dataflow ===
Still according to Matt Carcki[https://leanpub.com/dataflowbook] "Synchronous execution is when the nodes fires on a pre-calculated, fixed schedule. This implies that the program has to be compiled first to build the schedule. The schedule determines which nodes have to fire before others, how often they have to fire and which nodes can fire simultaneously."
Synchronous dataflow requires the token rate to be known at design time.

Reactive Programming

2014-10-14T16:23:42Z

Miranda ricardo: /* Decoupling data from operations on data */

According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of change. This means that it should be possible to express static or dynamic data flows with ease in the programming languages used, and that the underlying execution model will automatically propagate changes through the data flow."

"For example, in an '''imperative programming setting''', <math>a := b + c</math> would mean that <math>a</math> is being assigned the result of <math>b + c</math> in the instant the expression is evaluated. Later, the values of <math>b</math> and <math>c</math> can be changed with no effect on the value of <math>a</math>."

"In '''reactive programming''', the value of <math>a</math> would be automatically updated based on the new values."

== MS Excel is a reactive programming environment ==
Continuing from Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "A modern spreadsheet program is an example of reactive programming. Spreadsheet cells can contain literal values, or formulas such as "=<math>B1+C1</math>" that are evaluated based on other cells. Whenever the value of the other cells change, the value of the formula is automatically updated."

== Decoupling data from operations on data ==
To have a data flow between nodes it is necessary to decouple data from operations on data. Messages, tokens in data flow parlance, are send from node to node through arcs.
Dut to the non-deterministic nature of a large system like Mohid, a asynchronous approach was choosen, using the Hollywood principle (stated as "don't call us, we'll call you."[http://en.wikipedia.org/wiki/Hollywood_principle]). Here we will focus on asynchronous reactive dataflow systems, focusing on the actor model. Reactive daflow systems can be:
*asynchronous; or
*synchronous.

=== Asynchronous dataflow ===

=== Synchronous dataflow ===

Reactive Programming

2014-10-14T11:46:22Z

Miranda ricardo: /* Decoupling data from operations on data */

Reactive Programming

2014-10-14T11:44:20Z

Miranda ricardo: /* Decoupling data from operations on data */

Reactive Programming

2014-10-14T11:36:42Z

Miranda ricardo:

Reactive Programming

2014-10-14T11:29:21Z

Miranda ricardo:

Reactive Programming

2014-10-14T11:28:12Z

Miranda ricardo: Created page with "According to Wikipedia[http://en.wikipedia.org/wiki/Reactive_programming] "(...) reactive programming is a programming paradigm oriented around data flows and the propagation of ..."