SUBROUTINE KILL_LINE USE VARIABLES USE CAccumulatorVariables USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants ! use CSimulationVariables implicit none !===================================================================== ! KILL LINE 1- BOP CAMERON Type U 5000 ! START CONDITIONS FOR KILL LINE 1 !===================================================================== RAM(6)%SuccessionCounter = RAM(6)%SuccessionCounter + 1 if (BopControlPanel%KillLineValve == -1.0 .and. BopStackAcc%RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1 .and. RamLine%P_ACC>BopStackAcc%acc_MinPressure) then if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then RAM(6)%SuccessionCounter = 0 ! also in starup RAM(6)%SuccessionCounterOld = 0 ! also in starup return else RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter endif if ( RAM(6)%SuccessionCounter < int(2.5/RamLine%DeltaT_BOP) ) then return endif RAM(6)%First_CloseTimecheck= 1 if (BopStackInput%KillLineOpenLedMine == LedOn) then RETURN end if KillLine%closed=0 RAM(6)%vdis_tot=0 RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. Pumps%Qiter=7 RAM(6)%Qzero=70 RAM(6)%Q=RAM(6)%Qzero RAM(6)%flow=70 RAM(6)%tol=0.0037 if (KillLine%finished==1) then KillLine%LeverOld= 1.0 else KillLine%LeverOld=BopControlPanel%KillLineValve endif KillLine%finished=0 KillLine%IsOpening = .true. BopControlPanel%KillLineCloseLED = LedOff BopStackInput%KillLineCloseLedMine = LedOff BopControlPanel%KillLineOpenLED = LedOn !LedBlinking RAM(6)%bop_type = 3 !AbopKillLine=196.67 KillLine%Abop=(BopStackSpecification%KillClose*231)/((KillLine%IDBase-KillLine%ODDrillpipe_inBase)/2.) KillLine%NeededVolume=KillLine%Abop*(KillLine%IDBase-max(KillLine%ODDrillpipe_in,KillLine%ODDrillpipe_inBase))/(2.*231) !1.5 galon for each BOP endif if (BopControlPanel%KillLineValve == 1.0 .and. BopStackAcc%RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1 .and. RamLine%P_ACC>BopStackAcc%acc_MinPressure) then if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then RAM(6)%SuccessionCounter = 0 ! also in starup RAM(6)%SuccessionCounterOld = 0 ! also in starup return else RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter endif if ( RAM(6)%SuccessionCounter < int(2.5/RamLine%DeltaT_BOP) ) then return endif RAM(6)%First_OpenTimecheck= 1 if (BopStackInput%KillLineCloseLedMine == LedOn) then RETURN end if KillLine%closed=0 RAM(6)%vdis_tot=0 RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. Pumps%Qiter=7 RAM(6)%Qzero=70 RAM(6)%Q=RAM(6)%Qzero RAM(6)%flow=70 RAM(6)%tol=0.0037 if (KillLine%finished==1) then KillLine%LeverOld= -1.0 else KillLine%LeverOld=BopControlPanel%KillLineValve endif KillLine%finished=0 KillLine%IsClosing = .true. !if (KillLineCloseLed == LedOn) then ! RETURN !end if BopControlPanel%KillLineCloseLED = LedOff !new BopStackInput%KillLineCloseLedMine = LedOff !new BopControlPanel%KillLineCloseLED = LedOn !LedBlinking RAM(6)%bop_type = 3 !AbopKillLine=196.67 KillLine%Abop=(BopStackSpecification%KillOpen*231)/((KillLine%IDBase-KillLine%ODDrillpipe_inBase)/2.) KillLine%NeededVolume=KillLine%Abop*(KillLine%IDBase-max(KillLine%ODDrillpipe_in,KillLine%ODDrillpipe_inBase))/(2.*231) !1.5 galon for each BOP endif !========================================================================== if (KillLine%IsOpening .or. KillLine%IsClosing) then CALL KILL_LINE_SUB end if END SUBROUTINE KILL_LINE SUBROUTINE KILL_LINE_SUB USE VARIABLES USE CAccumulatorVariables USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants ! use CSimulationVariables implicit none Annular%FirstSet= 0 AnnularComputational%RamsFirstSet= 0 ! loop6: do while (finished_KillLine==0) RAM(6)%SuccessionCounter = RAM(6)%SuccessionCounter + 1 if (BopControlPanel%KillLineValve == 1.0 .and. KillLine%LeverOld == -1.0 .and. BopStackAcc%RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1 .and. RamLine%P_ACC>BopStackAcc%acc_MinPressure) then if ( RAM(6)%First_CloseTimecheck == 0 ) then if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then RAM(6)%SuccessionCounter = 0 ! also in starup RAM(6)%SuccessionCounterOld = 0 ! also in starup return else RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter endif if ( RAM(6)%SuccessionCounter < int(2.5/RamLine%DeltaT_BOP) ) then return endif endif KillLine%closed=0 RAM(6)%p_bop=ShearRam%PA KillLine%LeverOld = BopControlPanel%KillLineValve BopControlPanel%KillLineOpenLED = LedOff BopStackInput%KillLineOpenLedMine = LedOff BopControlPanel%KillLineCloseLED = LedOn !LedBlinking CALL OpenKillLine RAM(6)%bop_type = 3 !AbopKillLine=196.67 KillLine%Abop=(BopStackSpecification%KillClose*231)/((KillLine%IDBase-KillLine%ODDrillpipe_inBase)/2.) KillLine%NeededVolume=KillLine%Abop*(KillLine%ID-max(KillLine%ODDrillpipe_in,KillLine%ODDrillpipe_inBase))/(2.*231) RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. KillLine%IsClosing = .true. KillLine%IsOpening = .false. endif if (BopControlPanel%KillLineValve == -1.0 .and. KillLine%LeverOld == 1.0 .and. RamLine%P_ACC>BopStackAcc%acc_MinPressure .and. BopStackAcc%RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if ( RAM(6)%First_OpenTimecheck == 0 ) then if ( RAM(6)%SuccessionCounter /= RAM(6)%SuccessionCounterOld+1 ) then RAM(6)%SuccessionCounter = 0 ! also in starup RAM(6)%SuccessionCounterOld = 0 ! also in starup return else RAM(6)%SuccessionCounterOld= RAM(6)%SuccessionCounter endif if ( RAM(6)%SuccessionCounter < int(2.5/RamLine%DeltaT_BOP) ) then return endif endif KillLine%closed=0 RAM(6)%p_bop=ShearRam%PA KillLine%LeverOld = BopControlPanel%KillLineValve BopControlPanel%KillLineCloseLED = LedOff BopStackInput%KillLineCloseLedMine = LedOff BopControlPanel%KillLineOpenLED = LedOn !LedBlinking CALL OpenKillLine RAM(6)%bop_type = 3 !AbopKillLine=196.67 KillLine%Abop=(BopStackSpecification%KillOpen*231)/((KillLine%IDBase-KillLine%ODDrillpipe_inBase)/2.) KillLine%NeededVolume=KillLine%Abop*(KillLine%IDBase-KillLine%ID)/(2.*231) RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. KillLine%IsOpening = .true. KillLine%IsClosing = .false. endif RAM(6)%First_CloseTimecheck = 0 RAM(6)%First_OpenTimecheck = 0 RAM(6)%time=RAM(6)%time+RamLine%DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (KillLine%closed==0) then !bop closing call bop_code(5,KillLine%H_Bop,6) !ramtype=5 6=RNUMBER endif !bop is closing !================================================================ if (KillLine%closed==1) then RAM(6)%Q=0 !p_bop=pram_reg RAM(6)%p_bop=ShearRam%PA RAMS%minloss(6,17)=0. !RNUMBER=6 endif RAM(6)%timecounter_ram=RAM(6)%timecounter_ram+1 ! MiddleRamsStatus = IDshearBop ! UpperRamsStatus = IDPipeRam1 ! LowerRamsStatus = IDPipeRam2 ! AnnularStatus = IDAnnular ! AccumulatorPressureGauge = p_acc ! ManifoldPressureGauge= pram_reg ! AnnularPressureGauge=Pannular_reg ! ! ! ! WRITE(60,60) RAM(6)%time,RAM(6)%Q,RAM(6)%vdis_tot,p_acc, & ! pram_reg,Pannular_reg,RAM(6)%p_bop,IDshearBop, & ! IDPipeRam1,IDPipeRam2,IDAnnular !60 FORMAT(11(f18.5)) ! call sleepqq(100) if (KillLine%closed==1) then ! if ((UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (LowerRamsValve==1. .and. LowerRamsFailureMalf==0) .or. (LowerRamsValve==-1.0 .and. LowerRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0) then KillLine%finished=1 ! endif endif ! if (IsStopped == .true.) return ! end do loop6 !while finished_KillLine==0 END SUBROUTINE KILL_LINE_SUB