SUBROUTINE CHOKE_LINE USE VARIABLES USE CAccumulatorVariables USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants implicit none !===================================================================== ! CHOKE LINE 1- BOP CAMERON Type U 5000 ! START CONDITIONS FOR CHOKE LINE 1 !===================================================================== RAM(5)%SuccessionCounter = RAM(5)%SuccessionCounter + 1 if (ChokeLineValve == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then RAM(5)%SuccessionCounter = 0 ! also in starup RAM(5)%SuccessionCounterOld = 0 ! also in starup return else RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter endif if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then return endif RAM(5)%First_CloseTimecheck= 1 if (ChokeLineOpenLEDMine == LedOn) then RETURN end if ChokeLine_closed=0 RAM(5)%vdis_tot=0 RAM(5)%vdis_bottles=0. RAM(5)%fvr_air=0. RAM(5)%vdis_elecp=0. Qiter=7 RAM(5)%Qzero=70 RAM(5)%Q=RAM(5)%Qzero RAM(5)%flow=70 RAM(5)%tol=0.0037 if (finished_ChokeLine==1) then ChokeLineLeverOld= 1.0 else ChokeLineLeverOld=ChokeLineValve endif finished_ChokeLine=0 ChokeLineIsOpening = .true. ChokeLineCloseLED = LedOff ChokeLineCloseLEDMine = LedOff ChokeLineOpenLED = LedOn !LedBlinking RAM(5)%bop_type = 3 !AbopChokeLine=196.67 AbopChokeLine=(ChokeClose*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) !1.5 galon for each BOP endif if (ChokeLineValve == 1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then RAM(5)%SuccessionCounter = 0 ! also in starup RAM(5)%SuccessionCounterOld = 0 ! also in starup return else RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter endif if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then return endif RAM(5)%First_OpenTimecheck= 1 if (ChokeLineCloseLEDMine == LedOn) then RETURN end if ChokeLine_closed=0 RAM(5)%vdis_tot=0 RAM(5)%vdis_bottles=0. RAM(5)%fvr_air=0. RAM(5)%vdis_elecp=0. Qiter=7 RAM(5)%Qzero=70 RAM(5)%Q=RAM(5)%Qzero RAM(5)%flow=70 RAM(5)%tol=0.0037 if (finished_ChokeLine==1) then ChokeLineLeverOld= -1.0 else ChokeLineLeverOld=ChokeLineValve endif finished_ChokeLine=0 ChokeLineIsClosing = .true. !if (ChokeLineCloseLED == LedOn) then ! RETURN !end if ChokeLineCloseLed = LedOff !new ChokeLineCloseLedMine = LedOff !new ChokeLineCloseLED = LedOn !LedBlinking RAM(5)%bop_type = 3 !AbopChokeLine=196.67 AbopChokeLine=(ChokeOpen*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) !1.5 galon for each BOP endif !===================================================================== if (ChokeLineIsOpening .or. ChokeLineIsClosing) then CALL CHOKE_LINE_SUB end if END SUBROUTINE CHOKE_LINE SUBROUTINE CHOKE_LINE_SUB USE VARIABLES USE CAccumulatorVariables USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants USE CSimulationVariables implicit none FirstSet= 0 RamsFirstSet= 0 loop5: do while (finished_ChokeLine==0) RAM(5)%SuccessionCounter = RAM(5)%SuccessionCounter + 1 if (ChokeLineValve == 1.0 .and. ChokeLineLeverOld == -1.0 .and. RigAirMalf==0 .and. AirMasterValve==1 .and. p_acc>acc_MinPressure) then if ( RAM(5)%First_CloseTimecheck == 0 ) then if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then RAM(5)%SuccessionCounter = 0 ! also in starup RAM(5)%SuccessionCounterOld = 0 ! also in starup return else RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter endif if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then return endif endif ChokeLine_closed=0 RAM(5)%p_bop=pa ChokeLineLeverOld = ChokeLineValve ChokeLineOpenLED = LedOff ChokeLineOpenLEDMine = LedOff ChokeLineCloseLED = LedOn !LedBlinking CALL OpenChokeLine RAM(5)%bop_type = 3 !AbopChokeLine=196.67 AbopChokeLine=(ChokeClose*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) NeededVolumeChokeLine=AbopChokeLine*(IDChokeLine-max(ODDrillpipe_inChokeLine,ODDrillpipe_inChokeLineBase))/(2.*231) RAM(5)%vdis_bottles=0. RAM(5)%fvr_air=0. RAM(5)%vdis_elecp=0. ChokeLineIsClosing = .true. ChokeLineIsOpening = .false. endif if (ChokeLineValve == -1.0 .and. ChokeLineLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. RigAirMalf==0 .and. AirMasterValve==1) then if ( RAM(5)%First_OpenTimecheck == 0 ) then if ( RAM(5)%SuccessionCounter /= RAM(5)%SuccessionCounterOld+1 ) then RAM(5)%SuccessionCounter = 0 ! also in starup RAM(5)%SuccessionCounterOld = 0 ! also in starup return else RAM(5)%SuccessionCounterOld= RAM(5)%SuccessionCounter endif if ( RAM(5)%SuccessionCounter < int(2.5/DeltaT_BOP) ) then return endif endif ChokeLine_closed=0 RAM(5)%p_bop=pa ChokeLineLeverOld = ChokeLineValve ChokeLineCloseLED = LedOff ChokeLineCloseLEDMine = LedOff ChokeLineOpenLED = LedOn !LedBlinking CALL OpenChokeLine RAM(5)%bop_type = 3 !AbopChokeLine=196.67 AbopChokeLine=(ChokeOpen*231)/((IDChokeLineBase-ODDrillpipe_inChokeLineBase)/2.) NeededVolumeChokeLine=AbopChokeLine*(IDChokeLineBase-IDChokeLine)/(2.*231) RAM(5)%vdis_bottles=0. RAM(5)%fvr_air=0. RAM(5)%vdis_elecp=0. ChokeLineIsOpening = .true. ChokeLineIsClosing = .false. endif RAM(5)%First_CloseTimecheck = 0 RAM(5)%First_OpenTimecheck = 0 RAM(5)%time=RAM(5)%time+DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (ChokeLine_closed==0) then !bop closing call bop_code(4,H_ChokeLineBop,5) !ramtype=4 5=RNUMBER endif !bop is closing !================================================================ if (ChokeLine_closed==1) then RAM(5)%Q=0 !p_bop=pram_reg RAM(5)%p_bop=pa RAMS%minloss(5,17)=0. !RNUMBER=5 endif RAM(5)%timecounter_ram=RAM(5)%timecounter_ram+1 ! MiddleRamsStatus = IDshearBop ! UpperRamsStatus = IDPipeRam1 ! LowerRamsStatus = IDPipeRam2 ! AnnularStatus = IDAnnular ! AccumulatorPressureGauge = p_acc ! ManifoldPressureGauge= pram_reg ! AnnularPressureGauge=Pannular_reg ! ! ! ! WRITE(60,60) RAM(5)%time,RAM(5)%Q,RAM(5)%vdis_tot,p_acc, & ! pram_reg,Pannular_reg,RAM(5)%p_bop,IDshearBop, & ! IDPipeRam1,IDPipeRam2,IDAnnular !60 FORMAT(11(f18.5)) call sleepqq(100) if (ChokeLine_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. KillLineValve==1. .or. KillLineValve==-1.0) then finished_ChokeLine=1 ! endif endif if (IsStopped == .true.) return end do loop5 !while finished_ChokeLine==0 END SUBROUTINE CHOKE_LINE_SUB