V3FIT
multiprocess.f90
1  SUBROUTINE multiprocess(numprocess, maxprocess, wrapperfcn, fcn)
2  USE system_mod
3  IMPLICIT NONE
4 !-----------------------------------------------
5 ! D u m m y A r g u m e n t s
6 !-----------------------------------------------
7  INTEGER numprocess, maxprocess
8  REAL, EXTERNAL :: fcn
9  EXTERNAL wrapperfcn
10 #if !defined(MPI_OPT)
11 !C-----------------------------------------------
12 ! L o c a l V a r i a b l e s
13 !-----------------------------------------------
14  INTEGER :: i, status, iretpid, ierror
15 !-----------------------------------------------
16 ! E x t e r n a l F u n c t i o n s
17 !-----------------------------------------------
18  EXTERNAL myfork
19 !-----------------------------------------------
20 
21 
22 ! This Program was written by S. P. Hirshman (7/1/99), under contract
23 ! the U.S. DOE, and should not be used without explicit permission.
24 !
25 ! Input Variable Names
26 ! maxprocess: user defined constant, maximum number of processes that this routine will
27 ! request. It should be about MAX[NCPU/(1+NSPAWN), 1], WHERE NCPU is the number of
28 ! machine cpus, and NSPAWN is the maximum number of processes spawned by the
29 ! CALL to loc_function (for stellopt code, NSPAWN = 1)
30 ! NumProcess: the TOTAL number of processes to be launched in parallel (IF possible). If
31 ! this exceeds the number of available processors (max_process, THEN the next
32 ! available processor scheduled by the operating system
33 ! returns only after all processes are completed.
34 ! WrapperFcn: Fortran SUBROUTINE that performs the desired task.
35 ! It takes for arguments
36 ! (1) the INDEX of the process to execute, WHERE 1 <= index <= NumProcess
37 ! (2) the SUBROUTINE (Fcn) which is called ito evaluate specific information
38 ! (such as FUNCTIONal minima, etc.).
39 !
40 ! Calling convention from a Fortran PROGRAM:
41 !
42 ! CALL MultiProcess(nprocess, maxprocess, Wrapper_Subroutine, Worker_Subroutine)
43 
44  iretpid = 0; ierror = 0
45 
46  IF (maxprocess .GT. 1) THEN
47 
48  WRITE(6,*)
49  WRITE(6,*) ' Begin multi-processing: request ', numprocess, &
50  ' processes distributed among ', maxprocess, ' processors'
51  CALL flush(6)
52 
53  DO i = 1, numprocess
54  CALL myfork (i, maxprocess, wrapperfcn, fcn)
55  END DO
56 
57 ! Wait for ALL processes to finish...
58  DO i = 1, numprocess
59  CALL pxfwait (status, iretpid, ierror)
60  END DO
61 
62  ELSE
63 
64  DO i = 1, numprocess
65  CALL wrapperfcn (i, fcn)
66  END DO
67  END IF
68 #endif
69  END SUBROUTINE multiprocess
system_mod::pxfwait
Definition: system_mod.f:41