SUBROUTINE DEALLOCATE_ARRAYS() USE VARIABLES implicit none !=========================================================================== ! RAMLINE MINOR LOSSES INPUT !=========================================================================== DEALLOCATE (BopStackInput%MINORS1,RamLine%MINORDIAMETER_RAMLINE,RamLine%AREAMINOR_RAMLINE & ,RamLine%LF_RAMLINE,RamLine%CV_RAMLINE,RamLine%NOTE_RAMLINE,RAMS%minlosspa,RAMS%minloss) !=========================================================================== ! RAMLINE PIPNING LOSSES INPUT !=========================================================================== DEALLOCATE (BopStackInput%PIPINGS_RAMLINE,RamLine%DIAM_RAMLINE_INCH, & RamLine%AREA_RAMLINE,RamLine%LENGT_RAMLINE,RamLine%ROUGHNESS_RAMLINE,RamLine%RELROUGH_RAMLINE & ,RAMS%Re_ramline,RAMS%fric,RAMS%fricloss) !=========================================================================== ! ANNULAR MINOR LOSSES INPUT !=========================================================================== DEALLOCATE (BopStackInput%MINORS_ANNULAR,AnnularComputational%MINORDIAMETER_ANNULARLINE,AnnularComputational%AREAMINOR_ANNULARLINE & ,AnnularComputational%LF_ANNULARLINE,AnnularComputational%CV_ANNULARLINE,AnnularComputational%NOTE_ANNULARLINE,AnnularComputational%minlosspa_ANNULAR,AnnularComputational%minloss_ANNULAR) !=========================================================================== ! ANNULAR PIPNING LOSSES INPUT !=========================================================================== DEALLOCATE (BopStackInput%PIPINGS_ANNULAR,AnnularComputational%DIAM_ANNULARLINE_INCH,AnnularComputational%AREA_ANNULARLINE, & AnnularComputational%LENGT_ANNULARLINE,AnnularComputational%ROUGHNESS_ANNULARLINE,AnnularComputational%RELROUGH_ANNULARLINE & ,AnnularComputational%Re_ANNULARline,AnnularComputational%fricANNULAR,AnnularComputational%friclossANNULAR) !=========================================================================== ! AIR PUMP LOSSES INPUT !=========================================================================== DEALLOCATE (BopStackInput%PIPINGS_AIRPUMP,RamLine%DIAM_AIR_INCH, & RamLine%Re_air,RamLine%AREA_AIR,RamLine%LENGT_AIR,RamLine%ROUGHNESS_AIRPLINE,RamLine%REL_ROUGHAIR, & RamLine%fric_air,RamLine%fricloss_air) !================================================================ DEALLOCATE (BopStackInput%MINORS_AIRPUMP,RamLine%MINORDIAM_AIR_INCH, & RamLine%MINORAREA_AIR,RamLine%LF_AIR,RamLine%CV_AIR,RamLine%NOTE_AIR & ,RamLine%minlosspa_air,RamLine%minloss_air) !=========================================================================== ! DELAY ARRAYS !=========================================================================== call AnnularComputational%Pannular_regDelay%Empty() END SUBROUTINE LOSS_INPUTS() USE VARIABLES implicit none INTEGER I !=========================================================================== ! RAMLINE MINOR LOSSES INPUT !=========================================================================== RamLine%NO_MINORSRAMLINE=34 ALLOCATE (BopStackInput%MINORS1(RamLine%NO_MINORSRAMLINE,4)) ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION BopStackInput%MINORS1(1,1:4)= (/2., 2., 0., 0./) !Acc.tee BopStackInput%MINORS1(2,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS1(3,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS1(4,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS1(5,1:4)= (/2., 0.9, 0., 0./) !tee BopStackInput%MINORS1(6,1:4)= (/2., 2., 0., 0./) !tee BopStackInput%MINORS1(7,1:4)= (/2., 0., 105., 0./) !valve BopStackInput%MINORS1(8,1:4)= (/2., 0.9, 0., 0./) !tee BopStackInput%MINORS1(9,1:4)= (/2., 0., 105., 0./) !valve BopStackInput%MINORS1(10,1:4)= (/2., 0.42, 0., 0./) !elbow BopStackInput%MINORS1(11,1:4)= (/2., 0.42, 0., 0./) !elbow BopStackInput%MINORS1(12,1:4)= (/2., 0.8, 0., 0./) !unionA BopStackInput%MINORS1(13,1:4)= (/2., 0.8, 0., 0./) !unionA BopStackInput%MINORS1(14,1:4)= (/2., 1.5, 0., 0./) !elbow BopStackInput%MINORS1(15,1:4)= (/2., 0., 425., 0./) !valve BopStackInput%MINORS1(16,1:4)= (/2., 2., 0., 0./) !tee BopStackInput%MINORS1(17,1:4)= (/0.75, 0., 1.5, 0./) !REGULATOR BopStackInput%MINORS1(18,1:4)= (/1., 2., 0., 0./) !tee BopStackInput%MINORS1(19,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS1(20,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS1(21,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS1(22,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS1(23,1:4)= (/1., 0., 105., 0./) !valve BopStackInput%MINORS1(24,1:4)= (/1., 0.9, 0., 0./) !tee BopStackInput%MINORS1(25,1:4)= (/1., 0., 0., 0.5/) !FT BopStackInput%MINORS1(26,1:4)= (/1., 0., 0., 3.4/) !filter BopStackInput%MINORS1(27,1:4)= (/1., 0., 105., 0./) !valve BopStackInput%MINORS1(28,1:4)= (/1., 0.9, 0., 0./) !tee BopStackInput%MINORS1(29,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS1(30,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS1(31,1:4)= (/1., 0., 9.2, 0./) !valve BopStackInput%MINORS1(32,1:4)= (/1., 0.8, 0., 0./) !unionA BopStackInput%MINORS1(33,1:4)= (/1., 0.8, 0., 0./) !unionA BopStackInput%MINORS1(34,1:4)= (/0.75, 0.35, 0., 0./) !contraction ALLOCATE (RamLine%MINORDIAMETER_RAMLINE(RamLine%NO_MINORSRAMLINE),RamLine%AREAMINOR_RAMLINE(RamLine%NO_MINORSRAMLINE),RamLine%LF_RAMLINE(RamLine%NO_MINORSRAMLINE),RamLine%CV_RAMLINE(RamLine%NO_MINORSRAMLINE) & ,RamLine%NOTE_RAMLINE(RamLine%NO_MINORSRAMLINE),RAMS%minlosspa(6,RamLine%NO_MINORSRAMLINE),RAMS%minloss(6,RamLine%NO_MINORSRAMLINE)) DO I=1,RamLine%NO_MINORSRAMLINE RamLine%MINORDIAMETER_RAMLINE(I)=BopStackInput%MINORS1(I,1) RamLine%LF_RAMLINE(I)=BopStackInput%MINORS1(I,2) RamLine%CV_RAMLINE(I)=BopStackInput%MINORS1(I,3) RamLine%NOTE_RAMLINE(I)=BopStackInput%MINORS1(I,4) RamLine%AREAMINOR_RAMLINE(I)=PI*(RamLine%MINORDIAMETER_RAMLINE(I)*0.0254)**2/4. !D(in), AREA(m) ENDDO !=========================================================================== ! RAMLINE PIPNING LOSSES INPUT !=========================================================================== RamLine%NO_PIPINGSRAMLINE=15 ALLOCATE (BopStackInput%PIPINGS_RAMLINE(RamLine%NO_PIPINGSRAMLINE,3)) ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION BopStackInput%PIPINGS_RAMLINE(1,1:3)= (/2., 1035., 0.03/) !Avg.acc.distance BopStackInput%PIPINGS_RAMLINE(2,1:3)= (/2., 730., 0.03/) !Acc.end.horizontal BopStackInput%PIPINGS_RAMLINE(3,1:3)= (/2., 2000., 0.03/) !Acc.end.vertical BopStackInput%PIPINGS_RAMLINE(4,1:3)= (/2., 6000., 0.05/) !Hyd.hose BopStackInput%PIPINGS_RAMLINE(5,1:3)= (/2., 2370., 0.03/) !Corner.vertical1 BopStackInput%PIPINGS_RAMLINE(6,1:3)= (/2., 210., 0.03/) !Add.from.bend BopStackInput%PIPINGS_RAMLINE(7,1:3)= (/1., 780., 0.03/) !Corner.horizontal1 BopStackInput%PIPINGS_RAMLINE(8,1:3)= (/1., 780., 0.03/) !Corner.horizontal2 BopStackInput%PIPINGS_RAMLINE(9,1:3)= (/1., 750., 0.03/) !Extra.length.back BopStackInput%PIPINGS_RAMLINE(10,1:3)= (/1., 800., 0.03/) !Corner.horizontal3 BopStackInput%PIPINGS_RAMLINE(11,1:3)= (/1., 1650., 0.03/) !Corner.vertical2 BopStackInput%PIPINGS_RAMLINE(12,1:3)= (/1., 340., 0.03/) !12.Valves.horizontal BopStackInput%PIPINGS_RAMLINE(13,1:3)= (/1., 1650., 0.03/) !Valves.vertical BopStackInput%PIPINGS_RAMLINE(14,1:3)= (/1., 31000., 10./) !Hyd.hose BopStackInput%PIPINGS_RAMLINE(15,1:3)= (/1., 526., 0.03/) !Add.from.bend ALLOCATE (RamLine%DIAM_RAMLINE_INCH(RamLine%NO_PIPINGSRAMLINE), & RamLine%AREA_RAMLINE(RamLine%NO_PIPINGSRAMLINE),RamLine%LENGT_RAMLINE(RamLine%NO_PIPINGSRAMLINE),RamLine%ROUGHNESS_RAMLINE(RamLine%NO_PIPINGSRAMLINE),RamLine%RELROUGH_RAMLINE(RamLine%NO_PIPINGSRAMLINE) & ,RAMS%Re_ramline(6,RamLine%NO_PIPINGSRAMLINE),RAMS%fric(6,RamLine%NO_PIPINGSRAMLINE),RAMS%fricloss(6,RamLine%NO_PIPINGSRAMLINE)) DO I=1,RamLine%NO_PIPINGSRAMLINE RamLine%DIAM_RAMLINE_INCH(I)=BopStackInput%PIPINGS_RAMLINE(I,1) RamLine%LENGT_RAMLINE(I)=BopStackInput%PIPINGS_RAMLINE(I,2) RamLine%ROUGHNESS_RAMLINE(I)=BopStackInput%PIPINGS_RAMLINE(I,3) RamLine%AREA_RAMLINE(I)=PI*(RamLine%DIAM_RAMLINE_INCH(I)*0.0254)**2/4 !D(in), AREA(m) RamLine%RELROUGH_RAMLINE(I)=RamLine%ROUGHNESS_RAMLINE(I)/(RamLine%DIAM_RAMLINE_INCH(I)*25.4) !e/D !DIAM_RAMLINE_MM(I)=DIAM_RAMLINE_MM(I)*.001 ! (m) RamLine%LENGT_RAMLINE(I)=RamLine%LENGT_RAMLINE(I)*.001 ! (m) ENDDO !=========================================================================== ! ANNULAR PREVENTER MINOR LOSSES INPUT !=========================================================================== AnnularComputational%NO_MinorsAnnularLine=29 ALLOCATE (BopStackInput%MINORS_ANNULAR(AnnularComputational%NO_MinorsAnnularLine,4)) ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION BopStackInput%MINORS_ANNULAR(1,1:4)= (/2., 2., 0., 0./) !Acc.tee BopStackInput%MINORS_ANNULAR(2,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS_ANNULAR(3,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS_ANNULAR(4,1:4)= (/2., 0.9, 0., 0./) !Avg.acc.tee BopStackInput%MINORS_ANNULAR(5,1:4)= (/2., 0.9, 0., 0./) !tee BopStackInput%MINORS_ANNULAR(6,1:4)= (/2., 2., 0., 0./) !tee BopStackInput%MINORS_ANNULAR(7,1:4)= (/2., 0., 105., 0./) !valve BopStackInput%MINORS_ANNULAR(8,1:4)= (/2., 0.9, 0., 0./) !tee BopStackInput%MINORS_ANNULAR(9,1:4)= (/2., 0., 105., 0./) !valve BopStackInput%MINORS_ANNULAR(10,1:4)= (/2., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(11,1:4)= (/2., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(12,1:4)= (/2., 0.8, 0., 0./) !unionA BopStackInput%MINORS_ANNULAR(13,1:4)= (/2., 0.8, 0., 0./) !unionA BopStackInput%MINORS_ANNULAR(14,1:4)= (/2., 1.5, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(15,1:4)= (/2., 0., 425., 0./) !valve BopStackInput%MINORS_ANNULAR(16,1:4)= (/2., 2., 0., 0./) !tee BopStackInput%MINORS_ANNULAR(17,1:4)= (/0.75, 0., 1.5, 0./) !REGULATOR BopStackInput%MINORS_ANNULAR(18,1:4)= (/1., 2., 0., 0./) !tee BopStackInput%MINORS_ANNULAR(19,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(20,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(21,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(22,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(23,1:4)= (/1., 0., 3.2, 0./) !valve BopStackInput%MINORS_ANNULAR(24,1:4)= (/1., 2., 0., 0./) !tee BopStackInput%MINORS_ANNULAR(25,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(26,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(27,1:4)= (/1., 0.42, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(28,1:4)= (/1., 1.5, 0., 0./) !elbow BopStackInput%MINORS_ANNULAR(29,1:4)= (/1., 0., 3.2, 0./) !valve ALLOCATE (AnnularComputational%MINORDIAMETER_ANNULARLINE(AnnularComputational%NO_MinorsAnnularLine),AnnularComputational%AREAMINOR_ANNULARLINE(AnnularComputational%NO_MinorsAnnularLine),AnnularComputational%LF_ANNULARLINE(AnnularComputational%NO_MinorsAnnularLine) & ,AnnularComputational%CV_ANNULARLINE(AnnularComputational%NO_MinorsAnnularLine),AnnularComputational%NOTE_ANNULARLINE(AnnularComputational%NO_MinorsAnnularLine),AnnularComputational%minlosspa_ANNULAR(AnnularComputational%NO_MinorsAnnularLine),AnnularComputational%minloss_ANNULAR(AnnularComputational%NO_MinorsAnnularLine)) DO I=1,AnnularComputational%NO_MinorsAnnularLine AnnularComputational%MINORDIAMETER_ANNULARLINE(I)=BopStackInput%MINORS_ANNULAR(I,1) AnnularComputational%LF_ANNULARLINE(I)=BopStackInput%MINORS_ANNULAR(I,2) AnnularComputational%CV_ANNULARLINE(I)=BopStackInput%MINORS_ANNULAR(I,3) AnnularComputational%NOTE_ANNULARLINE(I)=BopStackInput%MINORS_ANNULAR(I,4) AnnularComputational%AREAMINOR_ANNULARLINE(I)=PI*(AnnularComputational%MINORDIAMETER_ANNULARLINE(I)*0.0254)**2/4. !D(in), AREA(m) ENDDO !=========================================================================== ! ANNULAR PREVENTER PIPNING LOSSES INPUT !=========================================================================== AnnularComputational%NO_PipingsAnnularLine=10 ALLOCATE (BopStackInput%PIPINGS_ANNULAR(AnnularComputational%NO_PipingsAnnularLine,3)) ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION BopStackInput%PIPINGS_ANNULAR(1,1:3)= (/2., 1035., 0.03/) !Avg.acc.distance BopStackInput%PIPINGS_ANNULAR(2,1:3)= (/2., 730., 0.03/) !Acc.endhorizontal BopStackInput%PIPINGS_ANNULAR(3,1:3)= (/2., 2000., 0.03/) !Acc.endvertical BopStackInput%PIPINGS_ANNULAR(4,1:3)= (/2., 6000., 0.03/) !Hyd.hose BopStackInput%PIPINGS_ANNULAR(5,1:3)= (/2., 2370., 0.03/) !Corner.vertical1 BopStackInput%PIPINGS_ANNULAR(6,1:3)= (/2., 210., 0.03/) !Add.frombend BopStackInput%PIPINGS_ANNULAR(7,1:3)= (/2., 1000., 0.03/) !manifold BopStackInput%PIPINGS_ANNULAR(8,1:3)= (/1., 46000., 0.03/) !pipe BopStackInput%PIPINGS_ANNULAR(9,1:3)= (/2., 1000., 0.03/) !manifold BopStackInput%PIPINGS_ANNULAR(10,1:3)= (/1., 46000., 0.03/) !pipe ALLOCATE (AnnularComputational%DIAM_ANNULARLINE_INCH(AnnularComputational%NO_PipingsAnnularLine),AnnularComputational%AREA_ANNULARLINE(AnnularComputational%NO_PipingsAnnularLine),AnnularComputational%LENGT_ANNULARLINE(AnnularComputational%NO_PipingsAnnularLine) & ,AnnularComputational%ROUGHNESS_ANNULARLINE(AnnularComputational%NO_PipingsAnnularLine),AnnularComputational%RELROUGH_ANNULARLINE(AnnularComputational%NO_PipingsAnnularLine) & ,AnnularComputational%Re_ANNULARline(AnnularComputational%NO_PipingsAnnularLine),AnnularComputational%fricANNULAR(AnnularComputational%NO_PipingsAnnularLine),AnnularComputational%friclossANNULAR(AnnularComputational%NO_PipingsAnnularLine)) DO I=1,AnnularComputational%NO_PipingsAnnularLine AnnularComputational%DIAM_ANNULARLINE_INCH(I)=BopStackInput%PIPINGS_ANNULAR(I,1) AnnularComputational%LENGT_ANNULARLINE(I)=BopStackInput%PIPINGS_ANNULAR(I,2) AnnularComputational%ROUGHNESS_ANNULARLINE(I)=BopStackInput%PIPINGS_ANNULAR(I,3) AnnularComputational%AREA_ANNULARLINE(I)=PI*(AnnularComputational%DIAM_ANNULARLINE_INCH(I)*0.0254)**2/4. !D(in), AREA(m) AnnularComputational%RELROUGH_ANNULARLINE(I)=AnnularComputational%ROUGHNESS_ANNULARLINE(I)/(AnnularComputational%DIAM_ANNULARLINE_INCH(I)*25.4) !DIAM_ANNULARLINE_MM(I)=DIAM_ANNULARLINE_MM(I)*.001 ! (m) AnnularComputational%LENGT_ANNULARLINE(I)=AnnularComputational%LENGT_ANNULARLINE(I)*.001 ! (m) ENDDO !=========================================================================== ! AIR PUMP LOSSES INPUT !=========================================================================== RamLine%NO_PIPINGS_AIRPLINE=1 ALLOCATE (BopStackInput%PIPINGS_AIRPUMP(RamLine%NO_PIPINGS_AIRPLINE,3)) ! ID(INCH) L(MM) ROUGHNESS(MM)=e DESCRIPTION BopStackInput%PIPINGS_AIRPUMP(1,1:3)= (/2., 10000., 0.03/) !Avg.acc.distance ALLOCATE (RamLine%DIAM_AIR_INCH(RamLine%NO_PIPINGS_AIRPLINE),RamLine%Re_air(RamLine%NO_PIPINGS_AIRPLINE),RamLine%AREA_AIR(RamLine%NO_PIPINGS_AIRPLINE), & RamLine%LENGT_AIR(RamLine%NO_PIPINGS_AIRPLINE),RamLine%ROUGHNESS_AIRPLINE(RamLine%NO_PIPINGS_AIRPLINE),RamLine%REL_ROUGHAIR(RamLine%NO_PIPINGS_AIRPLINE), & RamLine%fric_air(RamLine%NO_PIPINGS_AIRPLINE),RamLine%fricloss_air(RamLine%NO_PIPINGS_AIRPLINE)) DO I=1,RamLine%NO_PIPINGS_AIRPLINE RamLine%DIAM_AIR_INCH(I)=BopStackInput%PIPINGS_AIRPUMP(I,1) RamLine%LENGT_AIR(I)=BopStackInput%PIPINGS_AIRPUMP(I,2) RamLine%ROUGHNESS_AIRPLINE(I)=BopStackInput%PIPINGS_AIRPUMP(I,3) RamLine%AREA_AIR(I)=PI*(RamLine%DIAM_AIR_INCH(I)*0.0254)**2/4 !D(in), AREA(m) RamLine%REL_ROUGHAIR(I)=RamLine%ROUGHNESS_AIRPLINE(I)/(RamLine%DIAM_AIR_INCH(I)*25.4) !DIAM_RAMLINE_MM(I)=DIAM_RAMLINE_MM(I)*.001 ! (m) RamLine%LENGT_AIR(I)=RamLine%LENGT_AIR(I)*.001 ! (m) ENDDO !================================================================ RamLine%NO_MINORS_AIRPLINE=6 ALLOCATE (BopStackInput%MINORS_AIRPUMP(RamLine%NO_MINORS_AIRPLINE,4)) ! ID(INCH) LF CV NOTE(BAR) DESCRIPTION BopStackInput%MINORS_AIRPUMP(1,1:4)= (/2., 10., 0., 0./) !Acc.tee BopStackInput%MINORS_AIRPUMP(2,1:4)= (/2., 11., 0., 0./) !elbow BopStackInput%MINORS_AIRPUMP(3,1:4)= (/1., 0., 0., 3.4/) !filter BopStackInput%MINORS_AIRPUMP(4,1:4)= (/2., 0., 105., 0./) !valve BopStackInput%MINORS_AIRPUMP(5,1:4)= (/1., 0., 9.2, 0./) !valve BopStackInput%MINORS_AIRPUMP(6,1:4)= (/2., 6.4, 0., 0./) !unionA ALLOCATE (RamLine%MINORDIAM_AIR_INCH(RamLine%NO_MINORS_AIRPLINE),RamLine%MINORAREA_AIR(RamLine%NO_MINORS_AIRPLINE), & RamLine%LF_AIR(RamLine%NO_MINORS_AIRPLINE),RamLine%CV_AIR(RamLine%NO_MINORS_AIRPLINE),RamLine%NOTE_AIR(RamLine%NO_MINORS_AIRPLINE) & ,RamLine%minlosspa_air(RamLine%NO_MINORS_AIRPLINE),RamLine%minloss_air(RamLine%NO_MINORS_AIRPLINE)) DO I=1,RamLine%NO_MINORS_AIRPLINE RamLine%MINORDIAM_AIR_INCH(I)=BopStackInput%MINORS_AIRPUMP(I,1) RamLine%LF_AIR(I)=BopStackInput%MINORS_AIRPUMP(I,2) RamLine%CV_AIR(I)=BopStackInput%MINORS_AIRPUMP(I,3) RamLine%NOTE_AIR(I)=BopStackInput%MINORS_AIRPUMP(I,4) RamLine%MINORAREA_AIR(I)=PI*(RamLine%MINORDIAM_AIR_INCH(I)*0.0254)**2/4. !D(in), AREA(m) ENDDO END SUBROUTINE pumps_charge_bottle() USE VARIABLES USE CAccumulatorVariables USE CBopStackVariables USE CBopControlPanelVariables USE CEquipmentsConstants ! use CSimulationVariables implicit none !Pannular_regset=min(AnnularRegulatorSetControl,1700.) ! for changing its set conditions instantaneously !write(*,*) 'pumps_charge_bottle' if(BopControlPanel%ByePassValve == -1.0) then BopStackAcc%ByPassOld= -1.0 elseif(BopControlPanel%ByePassValve == 1.0) then BopStackAcc%ByPassOld= 1.0 endif !===================================================================== ! ACCUMULATOR !=====for a 10 gal bottle,precharge=1000psig curve BOSCH-isotherm===== !for charging bottles by the pump !((((((((IN OUTER LOOP)))))) ! ba1=1003; ba2=.03375; ba3=4.014; ba4=.2458; if (RamLine%AIRP_SWITCH==0) Pumps%DELTAV_AIR=0 RamLine%FVR=RamLine%FVR+Pumps%DELTAV_AIR+Pumps%DELTAV_ELECP RamLine%pacc_before=RamLine%P_ACC RamLine%P_ACC=RamLine%B1*exp(RamLine%B2*RamLine%FVR/BopStackAcc%NOBOTTLES)+RamLine%B3*exp(RamLine%B4*RamLine%FVR/BopStackAcc%NOBOTTLES) ! adiabatic(psig)<<<< 8=no. of bottles !===================================================================== if(BopStackAcc%ByPassOld == 1.0) then if (BopStackAcc%pram_reg BaseDifferenceP) then BopStackAcc%pram_reg= BopStackAcc%pram_reg + (BopStackAcc%PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. else if (BopStackAcc%pram_reg BaseDifferenceP) then BopStackAcc%pram_reg= BopStackAcc%pram_reg + (BopStackAcc%PressureDifference/PressureDifferenceSteps) ! PressureDifferenceSteps = 20. else BopStackAcc%pram_reg= RamLine%P_ACC- MAXVAL(RAM%loss_before) endif endif !Pannular_reg= min(p_acc,Pannular_regset) end SUBROUTINE airpump_code() USE VARIABLES use CSounds implicit none INTEGER I Pumps%QAIR=Pumps%Qiter+.1 !(gpm) maximum flow for the start RamLine%diffp_air=-10 RamLine%losses_air=10 !=================================================================== ! AIR OPERATED PUMP !=================for air consumption at 8 bar====================== do while (RamLine%diffp_air<0) Pumps%QAIR=Pumps%QAIR-.1 ! Qup=QAIR_PUMP; ! bba1 =31.8; bba2 =-725.7 ; bba3 =4154; Pumps%P_AIRP=RamLine%BBA1*Pumps%QAIR**2+RamLine%BBA2*Pumps%QAIR+RamLine%BBA3 !(psig) RamLine%kinetic_air=sg*wdens*(Pumps%QAIR*6.30902e-5/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) RamLine%diffp_air=Pumps%P_AIRP+RamLine%kinetic_air-RamLine%P_ACC end do !returns Qup do while (abs((RamLine%diffp_air-RamLine%losses_air)/RamLine%diffp_air)>Pumps%TOL_AIR) !finding correct QAIR_pump for 1 timecounter_ram if (RamLine%diffp_air-RamLine%losses_air>0) then Pumps%QAIR=Pumps%QAIR+.01 else Pumps%QAIR=Pumps%QAIR-.01 endif !=================================================================== ! AIR OPERATED PUMP ! Maximator - Model: GX (35) !=================for air consumption at 8 bar====================== Pumps%P_AIRP=RamLine%BBA1*Pumps%QAIR**2+RamLine%BBA2*Pumps%QAIR+RamLine%BBA3 !(psig) RamLine%kinetic_air=sg*wdens*(Pumps%QAIR*6.30902e-005/((1/4.)*pi*(2*0.254e-1)**2))**2/(2*6895) !(psi) RamLine%diffp_air=Pumps%P_AIRP+RamLine%kinetic_air-RamLine%P_ACC !===========================LOSSES==================================== do i=1,RamLine%NO_PIPINGS_AIRPLINE RamLine%Re_air(i)=Pumps%QAIR*6.30902e-005*RamLine%DIAM_AIR_INCH(I)*0.0254/(RamLine%AREA_AIR(i)*nu) enddo do i=1,RamLine%NO_PIPINGS_AIRPLINE if (RamLine%Re_air(i)ShearRam%NeededVolumeShearRams) then RamLine%ShearBop_closed=1 !ShearBop_closed_withPossibility= ShearBop_closed * TD_BOPConnectionPossibility(3) BopStackAcc%pram_reg=BopStackAcc%pram_reg+RAMS%minloss(RNUMBER,17) RamLine%P_ACC= RAM(RNUMBER)%p_acccheck if (RamLine%ShearRamIsClosing) then ShearRam%IDshearBop=0. + ShearRam%ShearIsNotAllowed*ShearRam%ODDrillpipe_inShearRam BopControlPanel%MiddleRamsCloseLED = LedOn BopStackInput%MiddleRamsCloseLEDMine = LedOn BopControlPanel%MiddleRamsOpenLED = LedOff BopStackInput%MiddleRamsOpenLEDMine = LedOff if (TD_BOP%BOPConnectionPossibility(3) == 1 .and. ShearRam%ShearIsNotAllowed==0) then CALL CloseMiddleRams RamLine%ShearBop_Situation_forTD= 1 ! closed - for TD code endif endif if (RamLine%ShearRamIsOpening) then ShearRam%IDshearBop=ShearRam%IDshearBopBase BopControlPanel%MiddleRamsOpenLED = LedOn BopStackInput%MiddleRamsOpenLEDMine = LedOn BopControlPanel%MiddleRamsCloseLED = LedOff BopStackInput%MiddleRamsCloseLEDMine = LedOff CALL OpenMiddleRams RamLine%ShearBop_Situation_forTD= 0 ! open - for TD code endif endif ShearRam%IDshearBopFinal= ShearRam%IDshearBop ! for output data endif if (ramtype==2) then !for pipe ram1 if (PipeRam1%IsClosing) then PipeRam1%ID=(2.*(PipeRam1%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./PipeRam1%A)+max(PipeRam1%ODDrillpipe_in,PipeRam1%ODDrillpipe_inBase) endif if (PipeRam1%IsOpening) then PipeRam1%ID=PipeRam1%IDBase-2.*(PipeRam1%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./PipeRam1%A endif if ( RAM(RNUMBER)%vdis_tot>PipeRam1%NeededVolume) then PipeRam1%closed=1 !PipeRam1_Situation_forTD= PipeRam1_closed * TD_BOPConnectionPossibility(2) BopStackAcc%pram_reg=BopStackAcc%pram_reg+RAMS%minloss(RNUMBER,17) RamLine%P_ACC= RAM(RNUMBER)%p_acccheck if (PipeRam1%IsClosing) then PipeRam1%ID=max(PipeRam1%ODDrillpipe_in,PipeRam1%ODDrillpipe_inBase) BopControlPanel%UpperRamsCloseLED = LedOn BopStackInput%UpperRamsCloseLEDMine = LedOn BopControlPanel%UpperRamsOpenLED = LedOff BopStackInput%UpperRamsOpenLEDMine = LedOff if (TD_BOP%BOPConnectionPossibility(2) == 1) then CALL CloseUpperRams ! for C code call Set_BlowoutFromAnnular(.true.) PipeRam1%Situation_forTD= 1 ! closed - for TD code endif endif if (PipeRam1%IsOpening) then PipeRam1%ID=PipeRam1%IDBase BopControlPanel%UpperRamsOpenLED = LedOn BopStackInput%UpperRamsOpenLEDMine = LedOn BopControlPanel%UpperRamsCloseLED = LedOff BopStackInput%UpperRamsCloseLEDMine = LedOff Call OpenUpperRams ! for C code PipeRam1%Situation_forTD= 0 ! open - for TD code endif endif ShearRam%IDPipeRam1Final= PipeRam1%ID ! for output data endif if (ramtype==3) then !for pipe ram2 if (PipeRam2%IsClosing) then PipeRam2%ID=(2.*(PipeRam2%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./PipeRam1%A)+max(PipeRam2%ODDrillpipe_in,PipeRam1%ODDrillpipe_inBase) endif if (PipeRam2%IsOpening) then PipeRam2%ID=PipeRam1%IDBase-2.*(PipeRam2%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./PipeRam1%A endif if ( RAM(RNUMBER)%vdis_tot>PipeRam2%NeededVolume) then PipeRam2%closed=1 !PipeRam2_closed_withPossibility= PipeRam2_closed * TD_BOPConnectionPossibility(4) BopStackAcc%pram_reg=BopStackAcc%pram_reg+RAMS%minloss(RNUMBER,17) RamLine%P_ACC= RAM(RNUMBER)%p_acccheck if (PipeRam2%IsClosing) then PipeRam2%ID=max(PipeRam2%ODDrillpipe_in,PipeRam1%ODDrillpipe_inBase) BopControlPanel%LowerRamsCloseLED = LedOn BopStackInput%LowerRamsCloseLEDMine = LedOn BopControlPanel%LowerRamsOpenLED = LedOff BopStackInput%LowerRamsOpenLEDMine = LedOff if (TD_BOP%BOPConnectionPossibility(4) == 1) then CALL CloseLowerRams PipeRam2%Situation_forTD= 1 ! closed - for TD code endif endif if (PipeRam2%IsOpening) then PipeRam2%ID=PipeRam1%IDBase BopControlPanel%LowerRamsOpenLED = LedOn BopStackInput%LowerRamsOpenLEDMine = LedOn BopControlPanel%LowerRamsCloseLED = LedOff BopStackInput%LowerRamsCloseLEDMine = LedOff CALL OpenLowerRams PipeRam2%Situation_forTD= 0 ! open - for TD code endif endif ShearRam%IDPipeRam2Final= PipeRam2%ID ! for output data endif if (ramtype==4) then !for Choke Line if (ChokeLine%IsClosing) then ChokeLine%ID=(2.*(ChokeLine%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./ChokeLine%Abop)+max(ChokeLine%ODDrillpipe_in,ChokeLine%ODDrillpipe_inBase) endif if (ChokeLine%IsOpening) then ChokeLine%ID=ChokeLine%IDBase-2.*(ChokeLine%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./ChokeLine%Abop endif if ( RAM(RNUMBER)%vdis_tot>ChokeLine%NeededVolume) then ChokeLine%closed=1 BopStackAcc%pram_reg=BopStackAcc%pram_reg+RAMS%minloss(RNUMBER,17) RamLine%P_ACC= RAM(RNUMBER)%p_acccheck if (ChokeLine%IsClosing) then ChokeLine%ID=max(ChokeLine%ODDrillpipe_in,ChokeLine%ODDrillpipe_inBase) BopControlPanel%ChokeLineCloseLED = LedOn BopStackInput%ChokeLineCloseLEDMine = LedOn BopControlPanel%ChokeLineOpenLED = LedOff BopStackInput%ChokeLineOpenLEDMine = LedOff CALL CloseChokeLine endif if (ChokeLine%IsOpening) then ChokeLine%ID=ChokeLine%IDBase BopControlPanel%ChokeLineOpenLED = LedOn BopStackInput%ChokeLineOpenLEDMine = LedOn BopControlPanel%ChokeLineCloseLED = LedOff BopStackInput%ChokeLineCloseLEDMine = LedOff CALL OpenChokeLine endif endif endif if (ramtype==5) then !for Kill Line if (KillLine%IsClosing) then KillLine%ID=(2.*(KillLine%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./KillLine%Abop)+max(KillLine%ODDrillpipe_in,KillLine%ODDrillpipe_inBase) endif if (KillLine%IsOpening) then KillLine%ID=KillLine%IDBase-2.*(KillLine%NeededVolume- RAM(RNUMBER)%vdis_tot)*231./KillLine%Abop endif if ( RAM(RNUMBER)%vdis_tot>KillLine%NeededVolume) then KillLine%closed=1 BopStackAcc%pram_reg=BopStackAcc%pram_reg+RAMS%minloss(RNUMBER,17) RamLine%P_ACC= RAM(RNUMBER)%p_acccheck if (KillLine%IsClosing) then KillLine%ID=max(KillLine%ODDrillpipe_in,KillLine%ODDrillpipe_inBase) BopControlPanel%KillLineCloseLED = LedOn BopStackInput%KillLineCloseLedMine = LedOn BopControlPanel%KillLineOpenLED = LedOff BopStackInput%KillLineOpenLedMine = LedOff CALL CloseKillLine endif if (KillLine%IsOpening) then KillLine%ID=KillLine%IDBase BopControlPanel%KillLineOpenLED = LedOn BopStackInput%KillLineOpenLedMine = LedOn BopControlPanel%KillLineCloseLED = LedOff BopStackInput%KillLineCloseLedMine = LedOff CALL OpenKillLine endif endif endif !if (ramtype==4) then !for annular ! if (AnnularIsClosing) then ! IDAnnular=((NeededVolumeAnnular-vdis_tot)*231./AbopAnnular)+ODDrillpipe_inAnnular ! endif ! ! if (AnnularIsOpening) then ! IDAnnular=IDAnnularBase-(NeededVolumeAnnular-vdis_tot)*231./AbopAnnular ! endif ! ! if (vdis_tot>NeededVolumeAnnular) then ! ! Annular_closed=1 ! p_acc= RAM(RNUMBER)%p_acccheck ! ! if (AnnularIsClosing) then ! IDAnnular=ODDrillpipe_inAnnular ! AnnularCloseLed = LedOn ! AnnularOpenLed = LedOff ! endif ! ! if (AnnularIsOpening) then ! IDAnnular=IDAnnularBase ! AnnularOpenLed = LedOn ! AnnularCloseLed = LedOff ! endif ! ! endif ! !endif end SUBROUTINE bop_codeAnnular(RNUMBER) USE VARIABLES USE CBopControlPanelVariables USE CEquipmentsConstants USE TD_GeneralData implicit none INTEGER RNUMBER, I !Pannular_regset=min(AnnularRegulatorSetControl,1700.) ! for changing its set conditions instantaneously !==================================================== ! BOP back pressure without DP !==================================================== !if (bop_type==3) then !p_annular=510.725-(30.145*IDAnnular) AnnularComputational%p_annular=448-(19.7*Annular%IDAnnular) ! Q=flow ! endif RAM(RNUMBER)%clock=0 !======================Losses============================ RAM(RNUMBER)%loss_after=0 !initial value RAM(RNUMBER)%diffp_ram=1000 !initial value RAM(RNUMBER)%loss_before=0 !Q=0.0055; %initial flow rate (m^3/s) RAM(RNUMBER)%Q=RAM(RNUMBER)%flow !write(*,*) 'Q1=' , Q !write(*,*) 'tol=' , tol do while (abs( RAM(RNUMBER)%diffp_ram- RAM(RNUMBER)%loss_after)/ RAM(RNUMBER)%diffp_ram>Annular%tolAnnular) if (RAM(RNUMBER)%Bottles_Charged_MalfActive==.true.) exit ! while abs( RAM(RNUMBER)%diffp_ram- RAM(RNUMBER)%loss_after)>10 RAM(RNUMBER)%clock= RAM(RNUMBER)%clock+1 if ( RAM(RNUMBER)%clock>20) then ! tclock=clock Annular%tolAnnular=Annular%tolzeroAnnular+(floor( RAM(RNUMBER)%clock/10)-1)*.001 endif ! if (clock==1) continue if ( RAM(RNUMBER)%clock/=1 .and. RAM(RNUMBER)%loss_after> RAM(RNUMBER)%diffp_ram) then RAM(RNUMBER)%Q=RAM(RNUMBER)%Q-.1 elseif ( RAM(RNUMBER)%clock/=1 .and. RAM(RNUMBER)%loss_after<= RAM(RNUMBER)%diffp_ram) then RAM(RNUMBER)%Q=RAM(RNUMBER)%Q+.01 endif !====================Before Regulator========================= do i=1,AnnularComputational%NO_PipingsAnnularLine AnnularComputational%Re_ANNULARline(i)=RAM(RNUMBER)%Q*6.30902e-5*AnnularComputational%DIAM_ANNULARLINE_INCH(i)*0.0254/(AnnularComputational%AREA_ANNULARLINE(i)*nu) enddo do i=1,AnnularComputational%NO_PipingsAnnularLine if (AnnularComputational%Re_ANNULARline(i)