SUBROUTINE ANNULAR USE VARIABLES USE CBopControlPanelVariables USE PressureDisplayVARIABLES USE CEquipmentsConstants USE CBopStackVariables implicit none !write(*,*) 'checkpoint 1' !===================================================================== ! ANNULAR PREVENTER- BOP CAMERON Type U 5000 ! START CONDITIONS FOR ANNULAR PREVENTER !===================================================================== RAM(1)%SuccessionCounter = RAM(1)%SuccessionCounter + 1 if (BopControlPanel%AnnularValve == 1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if (AnnularCloseLedMine == LedOn) then RETURN end if if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then RAM(1)%SuccessionCounter = 0 ! also in starup RAM(1)%SuccessionCounterOld = 0 ! also in starup !return else RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter endif if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(1)%First_CloseTimecheck= 1 BopControlPanel%AnnularOpenLED = LedOff AnnularOpenLedMine = LedOff BopControlPanel%AnnularCloseLED = LedOn !LedBlinking RAM(1)%FourwayValve = 1 endif endif if (RAM(1)%FourwayValve == 1 .and. p_acc>acc_MinPressure .and. Pannular_reg>AnnularMovingPressure) then ! 1: Open , 0: Close RAM(1)%FourwayValve = 0 Annular_closed=0 !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) RAM(1)%vdis_tot=0 RAM(1)%vdis_bottles=0. RAM(1)%fvr_air=0. RAM(1)%vdis_elecp=0. Qiter=7 RAM(1)%Qzero=70 RAM(1)%Q=RAM(1)%Qzero RAM(1)%flow=70 tolAnnular=0.0018 if (finished_Annular==1) then AnnularLeverOld=-1.0 else AnnularLeverOld=BopControlPanel%AnnularValve endif finished_Annular=0 AnnularIsClosing = .true. AnnularIsOpening = .false. RAM(2)%bop_type = 3 !AbopAnnular=963.1 !(in^2) AbopAnnular=(BopStackSpecification%AnnularPreventerClose*231.)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) ! 231 in^3 = 1 gal NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/(2.*231) !=17.98 galon for IDAnnularBase=13 5/8 , ODDrillpipe_inAnnularBase=5 !WRITE(*,*) 'a)NeededVolumeAnnular=' , NeededVolumeAnnular !write(*,*) 'close 1' endif if (BopControlPanel%AnnularValve == -1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1 ) then if (AnnularOpenLedMine == LedOn) then RETURN end if !CasingPressure : PressureGauges(2) *****temp conditionssssss !note: (AnnularSealingPressure) is only for opening while well is pressurised if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then RAM(1)%SuccessionCounter = 0 ! also in starup RAM(1)%SuccessionCounterOld = 0 ! also in starup !return else RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter endif if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(1)%First_OpenTimecheck= 1 BopControlPanel%AnnularCloseLED = LedOff !new AnnularCloseLedMine = LedOff !new BopControlPanel%AnnularOpenLED = LedOn !LedBlinking RAM(1)%FourwayValve = 1 endif endif if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure .and. p_acc>acc_MinPressure & .and. (Annular_closed==0 .or. (Annular_closed==1 .and.PressureGauges(2) <=100.0) .or. (Annular_closed==1 .and.PressureGauges(2)>100.0 .and. Pannular_reg>=AnnularSealingPressure))) then ! 1: Open , 0: Close !write(*,*) 'open 2' RAM(1)%FourwayValve = 0 Annular_closed=0 !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) RAM(1)%vdis_tot=0 RAM(1)%vdis_bottles=0. RAM(1)%fvr_air=0. RAM(1)%vdis_elecp=0. Qiter=7 RAM(1)%Qzero=70 RAM(1)%Q=RAM(1)%Qzero RAM(1)%flow=70 tolAnnular=0.0018 if (finished_Annular==1) then AnnularLeverOld=1.0 else AnnularLeverOld=BopControlPanel%AnnularValve endif finished_Annular=0 AnnularIsOpening = .true. AnnularIsClosing = .false. !if (AnnularOpenLed == LedOn) then ! RETURN !end if RAM(1)%bop_type = 3 !AbopAnnular=758.48 !(in^2) AbopAnnular=(BopStackSpecification%AnnularPreventerOpen*231)/((IDAnnularBase-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/2.) NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-ODDrillpipe_inAnnular)/(2.*231) !=14.16 galon for IDAnnularBase=13 5/8 , ODDrillpipe_inAnnular=5 !write(*,*) 'open 1' endif !===================================================================== if (AnnularIsOpening .or. AnnularIsClosing .or. RAM(1)%Bottles_Charged_MalfActive) then CALL ANNULAR_SUB end if END SUBROUTINE ANNULAR SUBROUTINE ANNULAR_SUB USE VARIABLES USE PressureDisplayVARIABLES USE CBopControlPanelVariables USE CEquipmentsConstants USE CBopStackVariables USE CSimulationVariables implicit none FirstSet= 0 RamsFirstSet= 0 loop5: do while (finished_Annular==0) !write(*,*) 'checkpoint 2' RAM(1)%SuccessionCounter = RAM(1)%SuccessionCounter + 1 ! CALL CPU_TIME(Annular_StartTime) if (BopControlPanel%AnnularValve == 1.0 .and. AnnularLeverOld == -1.0 .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if ( RAM(1)%First_CloseTimecheck == 0 ) then if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then RAM(1)%SuccessionCounter = 0 ! also in starup RAM(1)%SuccessionCounterOld = 0 ! also in starup !return else RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter endif if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return BopControlPanel%AnnularOpenLED = LedOff AnnularOpenLedMine = LedOff BopControlPanel%AnnularCloseLED = LedOn !LedBlinking RAM(1)%FourwayValve = 1 endif endif !write(*,*) 'chekkk 1' endif if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure .and. p_acc>acc_MinPressure) then !write(*,*) 'close 4' RAM(1)%FourwayValve = 0 Annular_closed=0 !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) p_annular=pa_annular AnnularLeverOld = BopControlPanel%AnnularValve CALL OpenAnnular Annular_Situation_forTD= 0 ! open - for TD code RAM(1)%bop_type = 3 !AbopAnnular=963.1 !(in^2) AbopAnnular=(BopStackSpecification%AnnularPreventerClose*231)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) !write(*,*) 'NeededVolumeShearRams1=',NeededVolumeShearRams NeededVolumeAnnular=AbopAnnular*(IDAnnular-max(ODDrillpipe_inAnnular,ODDrillpipe_inAnnularBase))/(2*231.) ! write(*,*) 'NeededVolumeAnnular=',NeededVolumeAnnular RAM(1)%vdis_bottles=0. RAM(1)%fvr_air=0. RAM(1)%vdis_elecp=0. AnnularIsClosing = .true. AnnularIsOpening = .false. !write(*,*) 'close 2' endif if (BopControlPanel%AnnularValve == -1.0 .and. AnnularLeverOld == 1.0 .and. p_acc>acc_MinPressure .and. AnnularFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1 ) then !CasingPressure : PressureGauges(2) *****temp conditionssssss !note: (AnnularSealingPressure) is only for opening while well is pressurised if ( RAM(1)%First_OpenTimecheck == 0 ) then if ( RAM(1)%SuccessionCounter /= RAM(1)%SuccessionCounterOld+1 ) then RAM(1)%SuccessionCounter = 0 ! also in starup RAM(1)%SuccessionCounterOld = 0 ! also in starup !return else RAM(1)%SuccessionCounterOld= RAM(1)%SuccessionCounter endif if ( RAM(1)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return BopControlPanel%AnnularCloseLED = LedOff AnnularCloseLedMine= LedOff BopControlPanel%AnnularOpenLED = LedOn !LedBlinking RAM(1)%FourwayValve = 1 endif endif !write(*,*) 'chekkk 2' endif if (RAM(1)%FourwayValve == 1 .and. Pannular_reg>AnnularMovingPressure & .and. (Annular_closed==0 .or. (Annular_closed==1 .and.PressureGauges(2) <=100.0) .or. (Annular_closed==1 .and.PressureGauges(2)>100.0 .and. Pannular_reg>=AnnularSealingPressure))) then !write(*,*) 'open 4' RAM(1)%FourwayValve = 0 Annular_closed=0 !Annular_closed_withPossibility= Annular_closed * TD_BOPConnectionPossibility(1) p_annular=pa_annular AnnularLeverOld = BopControlPanel%AnnularValve CALL OpenAnnular Annular_Situation_forTD= 0 ! open - for TD code RAM(1)%bop_type = 3 !AbopAnnular=758.48 !(in^2) AbopAnnular=(BopStackSpecification%AnnularPreventerOpen*231)/((IDAnnularBase-ODDrillpipe_inAnnularBase)/2.) NeededVolumeAnnular=AbopAnnular*(IDAnnularBase-IDAnnular)/(2*231.) RAM(1)%vdis_bottles=0. RAM(1)%fvr_air=0. RAM(1)%vdis_elecp=0. AnnularIsOpening = .true. AnnularIsClosing = .false. !write(*,*) 'open 2' endif RAM(1)%First_CloseTimecheck = 0 RAM(1)%First_OpenTimecheck = 0 RAM(1)%time=RAM(1)%time+DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (Annular_closed==0) then !bop closing !write(*,*) 'AnnularIsClosing,AnnularIsOpening' , AnnularIsClosing,AnnularIsOpening call bop_codeAnnular(1) !ramtype=4 1=RNUMBER endif !bop is closing !================================================================ if (Annular_closed==1) then RAM(1)%Q=0 !p_bop=pram_reg p_annular=pa_annular endif RAM(1)%timecounter_ram=RAM(1)%timecounter_ram+1 ! MiddleRamsStatus = IDshearBop ! UpperRamsStatus = IDPipeRam1 ! LowerRamsStatus = IDPipeRam2 ! AnnularStatus = IDAnnular ! AccumulatorPressureGauge = p_acc ! ManifoldPressureGauge= pram_reg ! AnnularPressureGauge=Pannular_reg ! ! ! ! WRITE(60,60) RAM(1)%time,RAM(1)%Q,RAM(1)%vdis_tot,p_acc, & ! pram_reg,Pannular_reg,RAM(1)%p_bop,IDshearBop, & ! IDPipeRam1,IDPipeRam2,IDAnnular !60 FORMAT(11(f18.5)) call sleepqq(100) !CALL CPU_TIME(Annular_EndTime) ! ! !PUMP(1)%INT_CPU_TIME=IDINT((Annular_EndTime-Annular_StartTime)*1000.) !PUMP(1)%Dt_ref=IDINT(DeltaT_BOP*1000.) ! !call sleepqq(PUMP(1)%Dt_ref-PUMP(1)%INT_CPU_TIME) if (Annular_closed==1) then ! if ((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. (UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then finished_Annular=1 ! endif endif if (IsStopped == .true.) return end do loop5 !while finished_Annular==0 if ( finished_Annular==1 .and. RAM(1)%Bottles_Charged_MalfActive==.true.) then call bop_codeAnnular(1) !ramtype=4 1=RNUMBER call sleepqq(100) endif END SUBROUTINE ANNULAR_SUB