SUBROUTINE SHEAR_RAMS USE VARIABLES USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants USE CSimulationVariables implicit none !===================================================================== ! SHEAR RAMS- BOP CAMERON Type U 5000 ! START CONDITIONS FOR SHEAR RAMS !===================================================================== RAM(4)%SuccessionCounter = RAM(4)%SuccessionCounter + 1 if (BopControlPanel%MiddleRamsValve == 1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if (MiddleRamsCloseLEDMine == LedOn) then RETURN end if if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then RAM(4)%SuccessionCounter = 0 ! also in starup RAM(4)%SuccessionCounterOld = 0 ! also in starup !return else RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter endif if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(4)%First_CloseTimecheck= 1 BopControlPanel%MiddleRamsOpenLED = LedOff MiddleRamsOpenLEDMine = LedOff BopControlPanel%MiddleRamsCloseLED = LedOn !LedBlinking RAM(4)%FourwayValve = 1 endif endif if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close !write(*,*) 'close 2' RAM(4)%FourwayValve = 0 ShearBop_closed=0 !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) RAM(4)%vdis_tot=0 RAM(4)%vdis_bottles=0. RAM(4)%fvr_air=0. RAM(4)%vdis_elecp=0. Qiter=7 RAM(4)%Qzero=70 RAM(4)%Q=RAM(4)%Qzero RAM(4)%flow=70 RAM(4)%tol=0.0037 if (finished_shear==1) then ShearRamsLeverOld=-1.0 else ShearRamsLeverOld=BopControlPanel%MiddleRamsValve endif finished_shear=0 ShearRamIsClosing = .true. ShearRamIsOpening = .false. RAM(4)%bop_type = 2 !NeededVolumeShearRams=5.8 !galon for each BOP !AbopShearRam=196.67 !(in^2) AbopShearRam=(BopStackSpecification%BlindRamClose*231)/(IDshearBopBase/2.) !NeededVolumeShearRams=BlindRamClose !galon for each BOP **changed NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) !3.67 galon for each BOP ! **changed va=AbopShearRam*(IDshearBopBase-ODDrillpipe_inShearRam)/(2.*231) vb=NeededVolumeShearRams endif if (BopControlPanel%MiddleRamsValve == -1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if (MiddleRamsOpenLEDMine == LedOn) then RETURN end if if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then RAM(4)%SuccessionCounter = 0 ! also in starup RAM(4)%SuccessionCounterOld = 0 ! also in starup !return else RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter endif if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return RAM(4)%First_OpenTimecheck= 1 BopControlPanel%MiddleRamsCloseLED = LedOff !new MiddleRamsCloseLedMine = LedOff !new BopControlPanel%MiddleRamsOpenLED = LedOn !LedBlinking endif endif if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then ! 1: Open , 0: Close !write(*,*) 'open 2' RAM(4)%FourwayValve = 0 ShearBop_closed=0 !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) RAM(4)%vdis_tot=0 RAM(4)%vdis_bottles=0. RAM(4)%fvr_air=0. RAM(4)%vdis_elecp=0. Qiter=7 RAM(4)%Qzero=70 RAM(4)%Q=RAM(4)%Qzero RAM(4)%flow=70 RAM(4)%tol=0.0037 if (finished_shear==1) then ShearRamsLeverOld=1.0 else ShearRamsLeverOld=BopControlPanel%MiddleRamsValve endif finished_shear=0 ShearRamIsOpening = .true. ShearRamIsClosing = .false. !if (MiddleRamsOpenLED == LedOn) then ! RETURN !end if RAM(4)%bop_type = 3 !AbopShearRam=186.5 !(in^2) AbopShearRam=(BopStackSpecification%BlindRamOpen*231)/(IDshearBopBase/2.) !NeededVolumeShearRams=5.5 !galon for each BOP !NeededVolumeShearRams=BlindRamOpen ! **changed NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) !3.67 galon for each BOP ! **changed !va=AbopShearRam*(IDshearBopBase-ODDrillpipe_inShearRam)/(2.*231) !vb=NeededVolumeShearRams endif !===================================================================== if (ShearRamIsOpening .or. ShearRamIsClosing .or. RAM(4)%Bottles_Charged_MalfActive) then CALL SHEAR_RAMS_SUB end if END SUBROUTINE SHEAR_RAMS SUBROUTINE SHEAR_RAMS_SUB USE VARIABLES USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants USE CSimulationVariables implicit none FirstSet= 0 RamsFirstSet= 0 loop2: do while (finished_shear==0) RAM(4)%SuccessionCounter = RAM(4)%SuccessionCounter + 1 if (BopControlPanel%MiddleRamsValve == 1.0 .and. ShearRamsLeverOld == -1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if ( RAM(4)%First_CloseTimecheck == 0 ) then if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then RAM(4)%SuccessionCounter = 0 ! also in starup RAM(4)%SuccessionCounterOld = 0 ! also in starup !return else RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter endif if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return BopControlPanel%MiddleRamsOpenLED = LedOff MiddleRamsOpenLEDMine = LedOff BopControlPanel%MiddleRamsCloseLED = LedOn !LedBlinking RAM(4)%FourwayValve = 1 endif endif endif if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then !write(*,*) 'close 4' RAM(4)%FourwayValve = 0 ShearBop_closed=0 !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) RAM(4)%p_bop=pa ShearRamsLeverOld = BopControlPanel%MiddleRamsValve CALL OpenMiddleRams ! for C code ShearBop_Situation_forTD= 0 ! open - for TD code RAM(4)%bop_type = 2 !AbopShearRam=196.67 AbopShearRam=(BopStackSpecification%BlindRamClose*231)/(IDshearBopBase/2.) !NeededVolumeShearRams=AbopShearRam*IDshearBop/(2.*231) ! **changed NeededVolumeShearRams=AbopShearRam*(IDshearBop-ShearIsNotAllowed*ODDrillpipe_inShearRam)/(2.*231) ! **changed RAM(4)%vdis_bottles=0. RAM(4)%fvr_air=0. RAM(4)%vdis_elecp=0. ShearRamIsClosing = .true. ShearRamIsOpening = .false. endif if (BopControlPanel%MiddleRamsValve == -1.0 .and. ShearRamsLeverOld == 1.0 .and. MiddleRamsFailureMalf==0 .and. RigAirMalf==0 .and. BopControlPanel%AirMasterValve==1) then if ( RAM(4)%First_OpenTimecheck == 0 ) then if ( RAM(4)%SuccessionCounter /= RAM(4)%SuccessionCounterOld+1 ) then RAM(4)%SuccessionCounter = 0 ! also in starup RAM(4)%SuccessionCounterOld = 0 ! also in starup !return else RAM(4)%SuccessionCounterOld= RAM(4)%SuccessionCounter endif if ( RAM(4)%SuccessionCounter >= int(2.5/DeltaT_BOP) ) then !return BopControlPanel%MiddleRamsCloseLED = LedOff MiddleRamsCloseLEDMine = LedOff BopControlPanel%MiddleRamsOpenLED = LedOn !LedBlinking RAM(4)%FourwayValve = 1 endif endif endif if (RAM(4)%FourwayValve == 1 .and. p_acc>acc_MinPressure) then !write(*,*) 'open 4' RAM(4)%FourwayValve = 0 ShearBop_closed=0 !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) RAM(4)%p_bop=pa ShearRamsLeverOld = BopControlPanel%MiddleRamsValve CALL OpenMiddleRams ShearBop_Situation_forTD= 0 ! open - for TD code RAM(4)%bop_type = 3 !AbopShearRam=186.5 NeededVolumeShearRams=AbopShearRam*(IDshearBopBase-IDshearBop)/(2.*231) RAM(4)%vdis_bottles=0. RAM(4)%fvr_air=0. RAM(4)%vdis_elecp=0. ShearRamIsOpening = .true. ShearRamIsClosing = .false. endif RAM(4)%First_CloseTimecheck = 0 RAM(4)%First_OpenTimecheck = 0 RAM(4)%time=RAM(4)%time+DeltaT_BOP !overal time (s) !=================================================== ! BOP !=================================================== if (ShearBop_closed==0) then !bop closing call bop_code(1,H_ShearRamBop,4) !ramtype=1 4=RNUMBER endif !bop is closing !================================================================ if (ShearBop_closed==1) then RAM(4)%Q=0 ! p_bop=pram_reg RAM(4)%p_bop=pa RAMS%minloss(4,17)=0. !RNUMBER=4 endif RAM(4)%timecounter_ram=RAM(4)%timecounter_ram+1 ! MiddleRamsStatus = IDshearBop ! UpperRamsStatus = IDPipeRam1 ! LowerRamsStatus = IDPipeRam2 ! AnnularStatus = IDAnnular ! AccumulatorPressureGauge = p_acc ! ManifoldPressureGauge= pram_reg ! AnnularPressureGauge=Pannular_reg ! ! ! ! WRITE(60,60) RAM(4)%time,RAM(4)%Q,RAM(4)%vdis_tot,p_acc & ! ,pram_reg,Pannular_reg,RAM(4)%p_bop,IDshearBop, & ! IDPipeRam1,IDPipeRam2,IDAnnular !60 FORMAT(11(f18.5)) ! call sleepqq(100) if (ShearBop_closed==1) then ! if ((UpperRamsValve==1. .and. UpperRamsFailureMalf==0) .or. (UpperRamsValve==-1.0 .and. UpperRamsFailureMalf==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 .or. KillLineValve==1. .or. KillLineValve==-1.0) then finished_shear=1 ! endif endif if (IsStopped == .true.) return end do loop2 !while finished_shear==0 if ( finished_shear==1 .and. RAM(4)%Bottles_Charged_MalfActive==.true.) then call bop_code(1,H_ShearRamBop,4) !ramtype=1 4=RNUMBER call sleepqq(100) endif END SUBROUTINE SHEAR_RAMS_SUB