Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! thread_control.f90 is part of AstroBEAR. 00008 ! 00009 ! AstroBEAR is free software: you can redistribute it and/or modify 00010 ! it under the terms of the GNU General Public License as published by 00011 ! the Free Software Foundation, either version 3 of the License, or 00012 ! (at your option) any later version. 00013 ! 00014 ! AstroBEAR is distributed in the hope that it will be useful, 00015 ! but WITHOUT ANY WARRANTY; without even the implied warranty of 00016 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 ! GNU General Public License for more details. 00018 ! 00019 ! You should have received a copy of the GNU General Public License 00020 ! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. 00021 ! 00022 !######################################################################### 00025 00028 00031 00035 00038 MODULE ThreadControl 00039 USE DataLevelOps 00040 USE GlobalDeclarations 00041 USE ThreadDeclarations 00042 IMPLICIT NONE 00043 PUBLIC ThreadsInit, LaunchAdvanceThread, JoinAdvanceThread 00044 SAVE 00045 CONTAINS 00047 SUBROUTINE ThreadsInit 00048 INTEGER :: i, ierr 00049 INTEGER :: stacksize=16777216 !16 MB 00050 INTEGER :: control_priority 00051 IF (iThreaded == PSUEDO_THREADED) RETURN 00052 ALLOCATE(thread_id(-2:MaxLevel)) 00053 ALLOCATE(thread_attr(-2:MaxLevel)) 00054 ALLOCATE(thread_status(-2:MaxLevel)) 00055 ALLOCATE(thread_args(-2:MaxLevel)) 00056 ALLOCATE(thread_priority(-2:MaxLevel)) 00057 thread_priority(-2:MaxLevel)=1 00058 control_priority=1 00059 CALL fpthread_self(control_thread, ierr) 00060 00061 CALL fpthread_setschedparam(control_thread, SCHED_FIFO, control_priority, ierr) 00062 write(*,*) "ierr=", ierr 00063 write(*,*) "control_thread", control_thread 00064 write(*,*) "control_priority", control_priority 00065 IF (ierr /= 0) THEN 00066 write(*,*) "error setting schedparam for control thread" 00067 STOP 00068 END IF 00069 IF (iThreaded == THREADED) THEN 00070 DO i=-2, MaxLevel 00071 CALL fpthread_attr_init(thread_attr(i), ierr) 00072 CALL fpthread_attr_setdetachstate(thread_attr(i), FPTHREAD_CREATE_JOINABLE, ierr) 00073 CALL fpthread_attr_setscope(thread_attr(i), FPTHREAD_SCOPE_SYSTEM, ierr) 00074 CALL fpthread_attr_setschedpolicy(thread_attr(i), SCHED_OTHER, ierr) 00075 CALL fpthread_attr_setschedparam(thread_attr(i), 0, ierr) 00076 CALL fpthread_attr_setstacksize(thread_attr(i),stacksize, ierr) 00077 thread_args(i)=i 00078 END DO 00079 END IF 00080 END SUBROUTINE ThreadsInit 00081 00082 00083 00086 00089 SUBROUTINE LaunchAdvanceThread(n) 00090 INTEGER :: n, ierr 00091 levels(n)%id=n 00092 ! CALL fpthread_create_sri(thread_id(n), AdvanceGridsLevel, thread_args(n), ierr) 00093 00094 ! CALL fpthread_create_noattr(thread_id(n), AdvanceGridsLevel, thread_args(n), ierr) 00095 CALL fpthread_create(thread_id(n), thread_attr(n), AdvanceGridsLevel, thread_args(n), ierr) 00096 IF (iThreaded == THREADED) CALL fpthread_setschedparam(thread_id(n),SCHED_FIFO, thread_priority(n), ierr) 00097 ! write(*,'(A4,I4,A,I4,A,I)'), "Proc ", MPI_ID, " Created thread for level ", n, ", thread id=", thread_id(n) 00098 ! write(*,*) ierr 00099 END SUBROUTINE LaunchAdvanceThread 00100 00101 00104 SUBROUTINE JoinAdvanceThread(n) 00105 TYPE(IntStatusPointer) :: returnstatus 00106 INTEGER :: n, ierr 00107 ! write(*,'(A4,I4,A,I4,A,I)'), "Proc ", MPI_ID, " Waiting on thread for level ", n, ", thread id=", thread_id(n) 00108 CALL fpthread_join(thread_id(n), returnstatus, ierr) 00109 ! write(*,'(A4,I4,A,I4,A,I)'), "Proc ", MPI_ID, " Finished thread on level ", n, ", with status=", returnstatus%status 00110 END SUBROUTINE JoinAdvanceThread 00111 00114 SUBROUTINE AdvanceGridsLevel(n) 00115 INTEGER :: n 00116 CALL AdvanceGrids(n) 00117 IF (iThreaded == THREADED) THEN 00118 thread_status(n)=0 00119 CALL fpthread_exit(thread_status(n)) 00120 END IF 00121 END SUBROUTINE AdvanceGridsLevel 00122 00123 end MODULE ThreadControl