Scrambler  1
pth_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 !    pth_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 !#########################################################################
00023 ! This module controls the spawning and joining of advance threads as well as the initialization of the threads and the advancing of grids
00024 MODULE PthControl
00025   USE PthDeclarations
00026   USE HyperbolicControl
00027   IMPLICIT NONE
00028 CONTAINS
00029 
00030    SUBROUTINE PthInit()
00031       INTEGER :: n, ierr
00032       CALL fpth_self(control_thread)
00033       CALL fpth_attr_of(control_attribute, control_thread)
00034       CALL fpth_attr_set_prio(control_attribute, FPTH_PRIO_MAX, ierr)
00035       CALL pth_checkerr(ierr, 'fpth_set_priority')
00036       DO n=0, MaxLevel
00037          CALL fpth_attr_new(advance_attributes(n))
00038          CALL fpth_attr_set_prio(advance_attributes(n), FPTH_PRIO_MIN, ierr)
00039          CALL pth_checkerr(ierr, 'fpth_set_priority')
00040       END DO
00041       lAdvanceActive=.false.
00042       lAdvanceCompleted=.true.
00043       threadarg(-2:MaxLevel)=(/(n,n=-2,MaxLevel)/)
00044 !      write(*,*) threadarg
00045 !      CALL fpth_attr_new(comm_attribute)
00046 !      CALL fpth_attr_set_stacksize(comm_attribute, ADVANCE_STACKSIZE, ierr)
00047 !      CALL pth_checkerr(ierr, 'fpth_set_stacksize')
00048 !      CALL fpth_attr_set_prio(comm_attribute, FPTH_PRIO_MIN, ierr)
00049 !      CALL pth_checkerr(ierr, 'fpth_set_priority')
00050       lControlActive=.true.
00051       Curr_TestType=TESTNONE
00052 !      IF (MPI_ID == 0) pVerbose = 1
00053    END SUBROUTINE PthInit
00054 
00055 
00056    SUBROUTINE LaunchAdvanceThread(n)
00057       USE DataLevelOps
00058       INTEGER :: n, ierr,i
00059       DO i=n-1,0,-1
00060          IF (lAdvanceActive(i)) THEN
00061             IF (pVerbose >= 1) write(*,*) 'suspending', i
00062             lAdvanceActive(i)=.false.
00063             CALL fpth_suspend(advance_threads(i), ierr)
00064             CALL pth_checkerr(ierr, 'fpth_suspend')
00065 !            EXIT
00066          END IF
00067       END DO
00068       IF (pverbose >= 1) write(*,*) 'spawning', n, threadarg(n)
00069       lAdvanceActive(n)=.true.
00070       lAdvanceCompleted(n)=.false.
00071       CALL fpth_attr_set_stacksize(advance_attributes(n), AdvanceStackSize(n), ierr)
00072       CALL pth_checkerr(ierr, 'fpth_set_stacksize')
00073       CALL fpth_spawn(advance_threads(n), advance_attributes(n), PthAdvanceGrids, threadarg(n))
00074     END SUBROUTINE LaunchAdvanceThread
00075 
00076    SUBROUTINE JoinAdvanceThread(n)
00077       INTEGER :: n, ierr
00078       TYPE(IntStatus) :: status
00079       IF (pVerbose >= 1) write(*,*) 'joining', n
00080       ! If we give up control at the join - then we will want it back immediately
00081       
00082       lControlActive=.false.   
00083       CALL fpth_join(advance_threads(n), status, ierr)
00084       CALL pth_checkerr(ierr, 'fpth_join')
00085       levels(n)%tnow=levels(n)%tnow+levels(n)%dt
00086       lControlActive=.true.
00087       !Resume next lower advance thread that has not compoleted
00088       IF (pverbose >= 1) write(*,*) 'im back'
00089       IF (status%val /= n) THEN
00090          PRINT*, 'exit code unexpected', status%val
00091          STOP
00092       END IF
00093 
00094    END SUBROUTINE JoinAdvanceThread
00095 
00098    SUBROUTINE PthAdvanceGrids(n)
00099       USE TreeDeclarations
00100       USE DataDeclarations
00101       USE HyperbolicControl
00102       USE HyperbolicDeclarations
00103       USE Scheduling
00104       INTEGER :: n,i,ierr
00105       TYPE(NodeDef), POINTER :: node
00106       TYPE(NodeDefList), POINTER :: nodelist
00107       ! Yield back to control thread if not on max level
00108  !     IF (n < MaxLevel) THEN
00109  !        IF (pVerBose >= 1) write(*,*) 'yielding back to control thread'
00110  !        CALL fpth_yield(control_thread, ierr)
00111  !        CALL Pth_checkerr(ierr, 'fpth_yield')
00112  !     END IF
00113 
00114       CALL StartTimer(iAdvanceGrids, n)
00115 
00116       IF (pVerbose >= 1) write(*,*) 'beginning advance', n
00117       if (levels(n)%dt > 0d0) THEN
00118          nodelist=>Nodes(n)%p 
00119          DO WHILE (associated(nodelist))
00120             node=>nodelist%self
00121             CALL Advance(node%info, .true.) 
00122             IF (.NOT. nodecompleted(n)) THEN
00123                write(*,*) 'error - node not updated'
00124                STOP
00125             END IF
00126             nodelist=>nodelist%next 
00127          END DO
00128            
00129       END if
00130       CALL StopTimer(iAdvanceGrids, n)
00131          
00132       DO i=n-1,0,-1
00133          IF (.NOT. lAdvanceCompleted(i)) THEN
00134             CALL fpth_resume(advance_threads(i), ierr)
00135             CALL Pth_checkerr(ierr, 'fpth_resume')
00136             lAdvanceActive(i)=.true.
00137             IF (pverbose >= 1) write(*,*) 'resuming advance thread', i
00138             EXIT
00139          END IF
00140       END DO
00141       lAdvanceActive(n)=.false.
00142       lAdvanceCompleted(n)=.true.
00143       returnstatus(n)=n
00144       IF (pverbose >= 1) write(*,*) 'thread', n, 'exiting'
00145       CALL fpth_exit(returnstatus(n))
00146    END SUBROUTINE PthAdvanceGrids
00147 
00148 
00149    
00150 END module PthControl
 All Classes Files Functions Variables