SUBROUTINE PIPE_RAMS2 USE VARIABLES USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants ! USE CSimulationVariables implicit none !write(*,*) 'checkpoint 1' !===================================================================== ! PIPE RAMS 2- BOP CAMERON Type U 5000 ! START CONDITIONS FOR PIPE RAMS 2 !===================================================================== RAM(3)%SuccessionCounter = RAM(3)%SuccessionCounter + 1 if (LowerRamsValve == 1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then !write(*,*) 'close 1' if (LowerRamsCloseLEDMine == LedOn) then RETURN end if if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then RAM(3)%SuccessionCounter = 0 ! also in starup RAM(3)%SuccessionCounterOld = 0 ! also in starup !return else RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter endif if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(3)%First_CloseTimecheck= 1 LowerRamsOpenLED = LedOff LowerRamsOpenLEDMine = LedOff LowerRamsCloseLED = LedOn !LedBlinking RAM(3)%FourwayValve = 1 endif endif if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close !write(*,*) 'close 2' RAM(3)%FourwayValve = 0 PipeRam2_closed=0 !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) RAM(3)%vdis_tot=0 RAM(3)%vdis_bottles=0. RAM(3)%fvr_air=0. RAM(3)%vdis_elecp=0. Qiter=7 RAM(3)%Qzero=70 RAM(3)%Q=RAM(3)%Qzero RAM(3)%flow=70 RAM(3)%tol=0.0037 if (finished_pipe2==1) then PipeRams2LeverOld=-1.0 else PipeRams2LeverOld=LowerRamsValve endif finished_pipe2=0 PipeRam2IsClosing = .true. PipeRam2IsOpening = .false. RAM(3)%bop_type = 3 !AbopPipeRam=196.67 AbopPipeRam=(LowerRamClose*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) !galon for each BOP !write(*,*) 'close 1' endif if (LowerRamsValve == -1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then !write(*,*) 'open 1' if (LowerRamsOpenLEDMine == LedOn) then RETURN end if if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then RAM(3)%SuccessionCounter = 0 ! also in starup RAM(3)%SuccessionCounterOld = 0 ! also in starup !return else RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter endif if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(3)%First_OpenTimecheck= 1 LowerRamsCloseLed = LedOff !new LowerRamsCloseLedMine = LedOff !new LowerRamsOpenLED = LedOn !LedBlinking RAM(3)%FourwayValve = 1 endif endif if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close !write(*,*) 'open 2' RAM(3)%FourwayValve = 0 PipeRam2_closed=0 !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) RAM(3)%vdis_tot=0 RAM(3)%vdis_bottles=0. RAM(3)%fvr_air=0. RAM(3)%vdis_elecp=0. Qiter=7 RAM(3)%Qzero=70 RAM(3)%Q=RAM(3)%Qzero RAM(3)%flow=70 RAM(3)%tol=0.0037 if (finished_pipe2==1) then PipeRams2LeverOld=1.0 else PipeRams2LeverOld=LowerRamsValve endif finished_pipe2=0 PipeRam2IsOpening = .true. PipeRam2IsClosing = .false. !if (LowerRamsOpenLED == LedOn) then ! RETURN !end if RAM(3)%bop_type = 3 !AbopPipeRam=186.5 AbopPipeRam=(LowerRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) !galon for each BOP !write(*,*) 'open 1' endif !===================================================================== if (PipeRam2IsOpening .or. PipeRam2IsClosing .or. RAM(3)%Bottles_Charged_MalfActive) then CALL PIPE_RAMS2_SUB end if END SUBROUTINE PIPE_RAMS2 SUBROUTINE PIPE_RAMS2_SUB USE VARIABLES USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants USE CSimulationVariables implicit none FirstSet= 0 RamsFirstSet= 0 loop4: do while (finished_pipe2==0) !write(*,*) 'checkpoint 2' RAM(3)%SuccessionCounter = RAM(3)%SuccessionCounter + 1 if (LowerRamsValve == 1.0 .and. PipeRams2LeverOld == -1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then !write(*,*) 'close 3' if ( RAM(3)%First_CloseTimecheck == 0 ) then if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then RAM(3)%SuccessionCounter = 0 ! also in starup RAM(3)%SuccessionCounterOld = 0 ! also in starup !return else RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter endif if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return LowerRamsOpenLED = LedOff LowerRamsOpenLEDMine = LedOff LowerRamsCloseLED = LedOn !LedBlinking RAM(3)%FourwayValve = 1 endif endif endif if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then !write(*,*) 'close 4' RAM(3)%FourwayValve = 0 PipeRam2_closed=0 !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) RAM(3)%p_bop=pa PipeRams2LeverOld = LowerRamsValve CALL OpenLowerRams PipeRam2_Situation_forTD= 0 ! open - for TD code RAM(3)%bop_type = 3 !AbopPipeRam=196.67 AbopPipeRam=(LowerRamClose*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) NeededVolumePipeRams2=AbopPipeRam*(IDPipeRam2-max(ODDrillpipe_inPipeRam2,ODDrillpipe_inPipeRam1Base))/(2.*231) RAM(3)%vdis_bottles=0. RAM(3)%fvr_air=0. RAM(3)%vdis_elecp=0. PipeRam2IsClosing = .true. PipeRam2IsOpening = .false. !write(*,*) 'close 2' endif if (LowerRamsValve == -1.0 .and. PipeRams2LeverOld == 1.0 .and. LowerRamsFailureMalf==0 .and. RigAirMalf==0 .and. AirMasterValve==1) then !write(*,*) 'open 3' if ( RAM(3)%First_OpenTimecheck == 0 ) then if ( RAM(3)%SuccessionCounter /= RAM(3)%SuccessionCounterOld+1 ) then RAM(3)%SuccessionCounter = 0 ! also in starup RAM(3)%SuccessionCounterOld = 0 ! also in starup !return else RAM(3)%SuccessionCounterOld= RAM(3)%SuccessionCounter endif if ( RAM(3)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return LowerRamsCloseLED = LedOff LowerRamsCloseLEDMine = LedOff LowerRamsOpenLED = LedOn !LedBlinking RAM(3)%FourwayValve = 1 endif endif endif if (RAM(3)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then !write(*,*) 'open 4' RAM(3)%FourwayValve = 0 PipeRam2_closed=0 !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) RAM(3)%p_bop=pa PipeRams2LeverOld = LowerRamsValve CALL OpenLowerRams PipeRam2_Situation_forTD= 0 ! open - for TD code RAM(3)%bop_type = 3 !AbopPipeRam=186.5 AbopPipeRam=(LowerRamOpen*231)/((IDPipeRamBase-ODDrillpipe_inPipeRam1Base)/2.) NeededVolumePipeRams2=AbopPipeRam*(IDPipeRamBase-IDPipeRam2)/(2.*231) RAM(3)%vdis_bottles=0. RAM(3)%fvr_air=0. RAM(3)%vdis_elecp=0. PipeRam2IsOpening = .true. PipeRam2IsClosing = .false. !write(*,*) 'open 2' endif RAM(3)%First_CloseTimecheck = 0 RAM(3)%First_OpenTimecheck = 0 RAM(3)%time=RAM(3)%time+DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (PipeRam2_closed==0) then !bop closing !write(*,*) 'BOP code is called' call bop_code(3,H_PipeRam2Bop,3) !ramtype=3 3=RNUMBER endif !bop is closing !================================================================ if (PipeRam2_closed==1) then RAM(3)%Q=0 !p_bop=pram_reg RAM(3)%p_bop=pa RAMS%minloss(3,17)=0. !RNUMBER=3 endif RAM(3)%timecounter_ram=RAM(3)%timecounter_ram+1 ! MiddleRamsStatus = IDshearBop ! UpperRamsStatus = IDPipeRam1 ! LowerRamsStatus = IDPipeRam2 ! AnnularStatus = IDAnnular ! AccumulatorPressureGauge = p_acc ! ManifoldPressureGauge= pram_reg ! AnnularPressureGauge=Pannular_reg ! ! ! ! WRITE(60,60) RAM(3)%time,RAM(3)%Q,RAM(3)%vdis_tot,p_acc, & ! pram_reg,Pannular_reg,RAM(3)%p_bop,IDshearBop, & ! IDPipeRam1,IDPipeRam2,IDAnnular !60 FORMAT(11(f18.5)) call sleepqq(100) if (PipeRam2_closed==1) then ! if ((MiddleRamsValve==1. .and. MiddleRamsFailureMalf==0) .or. (MiddleRamsValve==-1.0 .and. MiddleRamsFailureMalf==0) .or. (UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==0) .or. (AnnularValve==1. .and. AnnularFailureMalf==0) .or. (AnnularValve==-1.0 .and. AnnularFailureMalf==0) .or. ChokeLineValve==1. .or. ChokeLineValve==-1.0 .or. KillLineValve==1. .or. KillLineValve==-1.0) then finished_pipe2=1 ! endif endif if (IsStopped == .true.) return end do loop4 !while finished_pipe2==0 if ( finished_pipe2==1 .and. RAM(3)%Bottles_Charged_MalfActive==.true.) then call bop_code(3,H_PipeRam2Bop,3) !ramtype=3 3=RNUMBER call sleepqq(100) endif END SUBROUTINE PIPE_RAMS2_SUB