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 (KillLineValve == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>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/DeltaT_BOP) ) then return endif RAM(6)%First_CloseTimecheck= 1 if (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. Qiter=7 RAM(6)%Qzero=70 RAM(6)%Q=RAM(6)%Qzero RAM(6)%flow=70 RAM(6)%tol=0.0037 if (finished_KillLine==1) then KillLineLeverOld= 1.0 else KillLineLeverOld=KillLineValve endif finished_KillLine=0 KillLineIsOpening = .true. KillLineCloseLed = LedOff KillLineCloseLedMine = LedOff KillLineOpenLed = LedOn !LedBlinking RAM(6)%bop_type = 3 !AbopKillLine=196.67 AbopKillLine=(KillClose*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) !1.5 galon for each BOP endif if (KillLineValve == 1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>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/DeltaT_BOP) ) then return endif RAM(6)%First_OpenTimecheck= 1 if (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. Qiter=7 RAM(6)%Qzero=70 RAM(6)%Q=RAM(6)%Qzero RAM(6)%flow=70 RAM(6)%tol=0.0037 if (finished_KillLine==1) then KillLineLeverOld= -1.0 else KillLineLeverOld=KillLineValve endif finished_KillLine=0 KillLineIsClosing = .true. !if (KillLineCloseLed == LedOn) then ! RETURN !end if KillLineCloseLed = LedOff !new KillLineCloseLedMine = LedOff !new KillLineCloseLed = LedOn !LedBlinking RAM(6)%bop_type = 3 !AbopKillLine=196.67 AbopKillLine=(KillOpen*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) !1.5 galon for each BOP endif !========================================================================== if (KillLineIsOpening .or. KillLineIsClosing) 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 FirstSet= 0 RamsFirstSet= 0 loop6: do while (finished_KillLine==0) RAM(6)%SuccessionCounter = RAM(6)%SuccessionCounter + 1 if (KillLineValve == 1.0 .and. KillLineLeverOld == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>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/DeltaT_BOP) ) then return endif endif KillLine_closed=0 RAM(6)%p_bop=pa KillLineLeverOld = KillLineValve KillLineOpenLed = LedOff KillLineOpenLedMine = LedOff KillLineCloseLed = LedOn !LedBlinking CALL OpenKillLine RAM(6)%bop_type = 3 !AbopKillLine=196.67 AbopKillLine=(KillClose*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) NeededVolumeKillLine=AbopKillLine*(IDKillLine-max(ODDrillpipe_inKillLine,ODDrillpipe_inKillLineBase))/(2.*231) RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. KillLineIsClosing = .true. KillLineIsOpening = .false. endif if (KillLineValve == -1.0 .and. KillLineLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. RigAirMalf==0 .and. 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/DeltaT_BOP) ) then return endif endif KillLine_closed=0 RAM(6)%p_bop=pa KillLineLeverOld = KillLineValve KillLineCloseLed = LedOff KillLineCloseLedMine = LedOff KillLineOpenLed = LedOn !LedBlinking CALL OpenKillLine RAM(6)%bop_type = 3 !AbopKillLine=196.67 AbopKillLine=(KillOpen*231)/((IDKillLineBase-ODDrillpipe_inKillLineBase)/2.) NeededVolumeKillLine=AbopKillLine*(IDKillLineBase-IDKillLine)/(2.*231) RAM(6)%vdis_bottles=0. RAM(6)%fvr_air=0. RAM(6)%vdis_elecp=0. KillLineIsOpening = .true. KillLineIsClosing = .false. endif RAM(6)%First_CloseTimecheck = 0 RAM(6)%First_OpenTimecheck = 0 RAM(6)%time=RAM(6)%time+DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (KillLine_closed==0) then !bop closing call bop_code(5,H_KillLineBop,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=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 finished_KillLine=1 ! endif endif if (IsStopped == .true.) return end do loop6 !while finished_KillLine==0 END SUBROUTINE KILL_LINE_SUB