Scrambler  1
thread_control.f90
Go to the documentation of this file.
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
 All Classes Files Functions Variables