! 'link_fnl_shared_imsl.h' !------------------------------------------------------------------------------------------------------------------------------------------- ! WID 3.1 was developed By Erik Wennberg, April 1997 ! Using WID 3.0 originally developed by Shato Pang and Mukul Sharma 1995 ! WID 4.1 developed by Phani Gadde and Mukul Sharma ! Version 4.2 ! Prasad Saripalli, Mukul Sharma and Steven Bryant ! University of Texas at Austin ! WID 5.1 developed by phani and sharma Module WidCalc USE DFLIB !Used to change the current directory equal to the directory the input file is in USE DFPORT ! ----- Jongsoo 201309: Start ----- ! ----- Commented out ----- ! USE numerical_libraries ! ----- Jongsoo 201309: End ----- Implicit None ! $DEBUG ! Constants ! ---------- ! WELL TYPE ! vwell: 0; vertical well ! hwell: 1; horizontal well ! cwell: 2; core ! COMPLETION TYPE ! ohcompl: 0; open hole completion with no fracture growth ! phcmpl: 1; cased and perforated well with no fracture growth ! ufcmpl: 6; open-hole well with growing fracture ! pfcmpl: 7; cased and perforated well with growing fracture Integer, Parameter :: & vwell=0, hwell=1, cwell=2,& ! Well ids ohcmpl=0, phcmpl=1, ufcmpl=6, pfcmpl=7 ! Cmpl ids real(8), Parameter :: & pi = 3.14159265,& ! Pi g = 9.80665,& ! Accerleration due to gravity at the Earth's surface at sea level day2s=86400,& ! Days to seconds conversion s2day=1/day2s,& ! Seconds to days conversion !dt_max=86400,& ! Maximum time step is equal to 1 day dt_max=864000,& ! Maximum time step is equal to 10 day U=50 ! Specific surface energy !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! Input variables !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Character(100) :: dummy_time ! used in historical_q.txt first column (time period column), Ajsy Suri, 2nd August 2011 Character(50), Dimension(:), Allocatable :: lname ! Layer name Integer & out_id,& ! Injectivity decline 1/0 out_pp,& ! Constant rate calc 1/0 out_ihl,& ! Injector half life 1/0 wt,& ! Well type, see parameters above (value range: 0-2) ct,& ! Completion type, see parameters above (value range: 0-7) realct, & PhsFct, & ! Phase factor (60 deg =6, 90 = 4, 180=2) ! Automatic evaluations kcae,& ! Cake permeability Ns,& ! Number of discretized segments in the matrix adjacent to the fracture !Nfp,& ! Number of discretized segments in the frac-pack pcae, & ! Cake porosity Ltnum,& ! Total number of layers ubound,& hist_inj_rates,& hist_avg_res_prs,& fracture_closure, & pres_multiple_flag real(8), Dimension(:), Allocatable :: & lw, & ! Horizontal well length (m) ecc, & ! Horizontal well eccentricity kmh, & ! Formation permeability (m2) kmv, & ! Formation vertical permeability (m2) pm, & ! Formation porosity (volume fraction) h, & ! Formation height (m) tst, & ! Formation height (m) res_pr, & ! Formation height (m) topp, & ! layer top perforation depth (m) bottomp, & ! layer bottom perforation depth (m) topl, & ! layer top depth (m) bottoml, & ! layer bottom depth (m) ttu, & ! User transition time Nr, & ! dp/dg Nr2, & ! (dp/dg)**2 dg, & ! Grain size (m) ql,& ! Well surface flux, each layer (m3/s) ila,& ! Layer relative injectivity Rl,& ! Relative injectivity Rl0,& ! Initial Layer resistance Rl01,& Rl_vert,& ! Additional resistance for unperforated layers with vertical flow from perforated layers in the same pay block df,& ! Damage factor (dim. less) fc,& ! Damage factor, Filtration Coefficient (1/m) fco, & ! Damage factor oil, Filtration Coefficient (1/m) fcg,& ! Damage factor, Filtration Coefficient (1/m) fcgo, & ! Damage factor oil, Filtration Coefficient (1/m) Aface,& ! Fracture face area pcr,& ! Critical porosity e,& ! Chiang parameters b0,& b1,& b2,& hc,& ! external filter cake thickess, added by Ajay on Sept 06 2006 q1,& ! Injection rate profile with injection time for History Matching Studies: Shell-Bonga, Petrobras-Guando Res1,& ! Resistance between waterflood elliptical boundary and the constant pressure reservoir boundary Res2,& ! Resistance between injection front and connate water front Res3,& ! Resistance between cool front and the injection front Res4,& ! Resistance between the fracture and the cool front Rint,& ! Internal filter cake resistance, added by Ajay on Sept 07 2006 Rcc,& ! External filter cake resistance, added by Ajay on Sept 07 2006 Rud,& ! Undamaged zone resistance perpendicular to the fracture face, added by Ajay on Jan 11 2007 Rskin,& ! Any skin resistance, added by Ajay on Nov 29 2006 Resf,& ! Resistance of the fracture Resp,& ! Resistance of the perforations delp1,& ! Pressure drop between the water flood front and the boundary (r=re), added by Ajay on Sept 15 2006 delp2,& ! Pressure drop between the injection front and the connate water front, added by Ajay on Sept 15 2006 delp3,& ! Pressure drop between the cool front and the injection front, added by Ajay on Sept 15 2006 delp4,& ! Pressure drop between the fracture and the cool front, added by Ajay on Sept 15 2006 delptrans,& ! Transient Pressure drop between the fracture and the boundary, added by Ajay on July 04 2008 delpint,& ! Pressure drop across the internal filter cake, Nov 29 2006 delpcc,& ! Pressure drop across the external filter cake, Nov 29 2006 delpud,& ! Pressure drop across the undamaged zone, Jan 11 2007 delps_ini, & ! Delp due to skin (other than internal & external filter cake damage) ! updated by Ajay on Nov 29 2006 delpf,& ! Pressure drop in the fracture, added by Ajay on Sept 15 2006 wf,& ! Maximum width of the fracture at the wellbore, added by Ajay on Feb 15 2008 delpp,& ! Pressure drop in the perforations, added by Ajay on Sept 15 2006 P1, & ! Pressure at the fracture tip ! added by Ajay on Sept 15 2006, needs to be removed Ptip, & ! Pressure at the fracture tip ! added by Ajay on Nov 29 2006 RHS, & ! Fracturing pressure ! added by Ajay on Sept 15 2006, needs to be removed Pfrac, & ! Fracturing pressure ! added by Ajay on Nov 29 2006 Sminh, & ! Min horizontal stress ! added by Ajay on Sept 15 2006 dip, & ! Fracture growth angle with horizontal ! added by Ajay on Dec 19 2007 frac_grad,& ! Vertical gradient of minimum horizontal stress ! added by Ajay on Dec 19 2007 stress_change_pore_pressure,& ! Vertical gradient of minimum horizontal stress ! added by Ajay on Dec 19 2007 dst, & ! thermal stress, added by Ajay on Sept 15 2006 dsp ! pore pressure stress, added by Ajay on Sept 15 2006 real(8) :: & np, & ! power law exponent for injection fluid viscosity (in case of polymer injection) at injection temperature in the cool zone kp, & ! power law coefficient npt, & ! power law exponent for injection fluid viscosity (in case of polymer injection) at reservoir temperature outside the cool zone kpt, & ! power law coefficient at reservoir temperature in the thermal zone be, & ! permeability anisotropy sqrt(kh/kv) hp , & ! calculated from np, kp (or npt,kpt), porosity and permeability dfg , & ! Damage Factor for Gravel dp, & ! Inj water Particle size (m) c0, & ! Part Concentration (volume fraction) cg0, & q0,q,qold, & ! Injection rate at a given stage m3/s p0,p, & ! Pressure in SI skin_ini, & ! Skin dtday,& ! Time step in days dt,& ! Time step in second dnpv,& ! Porevolume step d, L, & ! Core diameter and length (m) rw,re, & ! Well radius and length, drainage radius (m) gpp, & ! Gravel pack porosity rf, & ! Radius for damage consideration ds, & ! Perforation shot density (shots/m) pc, kc, & ! Cake porosity and permeability rhop, rhol,& ! Density Particle and Liquid (kg/m3) mu, & ! Viscosity of injected water(kg/ms) alpha_min,& ! The max injectivity decline av_q_tot,& ! Average injection rate for the entire time (m3/s) t_max,& ! The maximum time before stopping (days) npv_max,& ! The maximum time before stopping (days) rp,& ! Perforation Radius Lp,& ! vector !P1, & ! Pressure at the fracture tip ! commented out by Ajay on Sept 15 2006 !RHS, & ! Fracturing pressure ! commented out by Ajay on Sept 15 2006 !Sminh, & ! Min horizontal stress ! commented out by Ajay on Sept 15 2006 pres_ini, & ! Initial Reservoir Pressure pres, & ! Current Reservoir Pressure Skin, & ! Skin factor - calcualted Skinr, & Delpres, & ! Pressure drop across the skin dx,& ! Core slice thickness !hc,& ! Filter cake thickness ! commented out by Ajay on Sept 06 2006 !Rcc,& ! Cake resistance ! commented out by Ajay on Sept 06 2006 !Rint ,& ! internal resistance ! commented out by Ajay on Sept 06 2006 tst_sum, & ! Formation Total height in case of one frac pack through all the layers (m) rff ! Radius of the fracture used in specific energy calculation Integer, Dimension(:), Allocatable :: & trans(:),& ! Flag to check if the flow in a layer is in transient state (1) or steady state (0) perf_ck(:),& ! Flag to check if a layer is perforated dfae,& ! Damage Factor Automatic Evaluation fcae,& ! Filtration coefficient fcae2, & dgae,& ! Diameter grain bar,& ! Barrier checkbox cal_id,& ! 1 for internal damage cal_ed,& ! 1 for external damage pcr_type,& ! Type of critical prosity fctd ! Filtraion coeff. time development Logical :: ConstRate ! Common intermediate variables ! ------------------------------ real(8) :: & Rtot,& ! Total resistance PartVol ! Particle Volume Logical :: Ok ! Set false if problems ! Result variables ! ------------------ Integer :: Ntime ! Total number of points calculated, time and dist real(8) :: & npv,& ! Result vector pore volumes t,& ! time (days), rt(1) = 0 alpha,& ! Result vectors, injectivity alpha(1)=1, R0tot ! The total initial resistance in the well/core real(8), Dimension(:), Allocatable :: & tt, & ! Transition time ttwm, & ! Transition time - Equivalent wellbore fracture hcwm, & ! external filter cake thickness in the equivalent wellbore fracture, meters ttg, & ! Transition time - Gravel Pack lambda00, & ! Filtration coefficient at surface lambda00_oil, & ! Filtration coefficient for oil r, & ! Radius vector rgg , & ! Radius vector for gravel pack c ,& ! Concetration profile cg ,& ! Concetration profile in gravel pack c_oil ,& ! Concentration of oil cg_oil,& ! Conc of oil in gravel pack Pres_1 ! Average reservoir pressures for all the layers with time read from the historical_q.txt file real(8):: & doil, & ! dia of oil rhooil, & ! den of oil coal_fr, & ! Coal fr c0_oil, & ! conc of oil cg0_oil ! conc of oil in gravel real(8), Dimension(:,:,:), Allocatable :: cfp,cfp_oil,kgf real(8), Dimension(:,:), Allocatable ::ttf,cfg,cfg_oil,qlhist,lfhist real(8), Dimension(:,:), Allocatable :: & pres_multiple, & ! Average reservoir pressures for all the layers with time read from the historical_q.txt file k, & ! Permeability profile kwm , & ! Permeability profile in matrix perpendicular to equivalent wellbore fracture kgg , & ! Permeability profile in gravel lambda0,& ! Initial filtration coeff for solids (no trapping) lambda0_oil, & ! Initial filtration coeff for oil (no trapping) lambda0wm,& ! Initial filtration coeff for solids in equivalent fracture for matrix adjacent to well lambda0wm_oil,& ! Initial filtration coeff for solids in equivalent fracture for matrix adjacent to well lambda0g , & ! Initial filtration coeff for solids in gravel lambda0g_oil, & ! Initial filtration coeff for oil in gravel lambda,& ! Filtration coeff. for solids lambda_oil, & ! Filtration coeff for oil lambdahist,& ! History of Filtration coeff. for solids lambda_oilhist, & ! History of Filtration coeff for oil avg_lambda,& ! Average Filtration coeff. for solids over the injection time avg_lambda_oil, & ! Average Filtration coeff for oil over the injection time sum_lambda,& ! Sum of Filtration coeff. for solids over the injection time sum_lambda_oil, & ! Sum of Filtration coeff for oil over the injection time lambdawm,& ! Filtration coeff for solids in equivalent fracture for matrix adjacent to well lambdawm_oil,& ! Filtration coeff for solids in equivalent fracture for matrix adjacent to well lambdag , & ! Filtration coeff. for solids in gravel lambdag_oil, & ! Filtration coeff for oil in gravel vda,& ! Darcy Velocity vdwm, & ! Darcy Velocity - equivalent fracture for matrix adjoining well and fracpack vdga, & ! Darcy Velocity - Gravel pack vdfpi, & ! Darcy velocity in the frac-pack qfp, & ! Darcy flow rate in the frac-pack qfpo, & ! Darcy flow rate in the frac-pack vdfpo, & ! Darcy velocity perpendicular to frac-pack going into the adjacent matrix sigma ,& ! Clogged concentration sigma_oil,& ! Clogged concentration for oil sigmawm , & ! Clogged concentration of solids in matrix perpendicular to the equivalent fracture for the well sigmawm_oil, & ! Clogged concentration of oil in matrix perpendicular to the equivalent fracture for the well sigmag , & ! Gravel clogged concentration sigmag_oil , & ! Clogged concentration for oil in gravel sigmafp_in_solid , & ! Clogged concentration in fracpack sigmafp_in_oil ! Clogged concentration in fracpack for oil real(8), Dimension(:,:,:), Allocatable ::sigmafp_perp_solid, sigmafp_perp_oil !Rock and Fluid Property Constants real(8) :: & vp, & ! Velocity through perforations qo, & ! flow rate oil_conc, & ! oil droplet concentration oil_size, & ! oil droplet size coal_frac, & ! coalascence fraction RL0tot ! Initial resistance of layer real(8) :: vol_int ,& ! Volume of particles deposited per unit length upto transition time initial_injectivity ! initial injectivity real(8), Dimension(:), Allocatable :: & Lfrw, & ! Equivalent fracture length for wellbore Lf ,& ! Fracture half length (m) Lfold , & ! length of fracture in previous time step Afacett, & ! Area of the fracture at the transition time Rint_tt , & ! Internal resistance at the transition time Swi , & ! Initial water saturation Sor , & ! Residual oil saturation krw , & ! Rel. Perm to water kro , & ! Rel. Perm rhog , & ! density of mineral grains n , & ! Poisson's Ratio Cgr , & ! Compressibility of mineral grains co, & ! Compressibility of oil cw, & ! Compressibility of water Cf , & ! Compressibility of formation ctot ,& ! total compressibility needed in the transient delp calculation Y, & ! Young's modulus Sigmamin, & ! min. insitu total horiz stress sigmamin1, & Chg , & ! Specific heat of mineral grains B , & ! Linear coe of thermal expansion Tr , & ! Reservoir Temperature Tw , & ! Injected water Temperature Chw, & ! Specific heat of water Cho , & ! Specific heat of oil rhoo, & ! Density of oil rhow, & ! Density of water mor, & ! Viscosity of reservoir oil at reservoir temperature mwi , & ! Visccosity of reservoir water at reservoir temperature Piwf, & ! Bottom hole pressure Piwfcheck, & ! Check variable for BHP for debugging Wi , & ! Cumulative injected volume Res_Res, & ! Resistance in the undamaged reservoir Sig_min_cur, & ! Current min hor. stress maj_axis_w, & ! Maj axis of waterflood ellipse min_axis_w, & ! Min axis of waterflood ellipse maj_axis_p, & ! Maj axis of polymerflood ellipse min_axis_p, & ! Min axis of polymerflood ellipse maj_axis_t ,& ! MAj axis of thermal ellipse min_axis_t ,& ! Min axis of thermal ellipse maj_axis_D ,& ! MAj axis of Darcy ellipse min_axis_D ,& ! Min axis of Darcy ellipse lf_ck ! Flag that frac has been iniitated in a particular layer real(8):: initial_res(15), & ! Initial resistance initial_factor(15), & avg_res, & ! Average resistance avg_skin ! Average skin real(8),Dimension(:),Allocatable::& pttg,pttf, & ! Particles per unit area till the transition time Rfp_ellipse,& ! Fracture and frac-pack resistance Riwm,Riwmd,Rcwm ! Equivalent well fracture resistances real(8),Dimension(:,:),Allocatable:: Rcore, & ! Resistace of cores perpendicular to the frac-pack pttfp ! Particles per unit area till the transition time Integer::nstage !Number of stages real(8), Dimension(:), Allocatable::& p_conc, & ! Particle concentration for multiple stages conc_oil, & ! Oil concentration for multiple stages p_dia, & ! Particle dia for multiple stages oil_dia, & ! Oil dia for multiple stages den_p, & ! Particle den for multiple stages den_f, & ! Fld den for multiple stages den_oil, & ! Oil den for multiple stages coal, & ! Coal. fr. for multiple stages c0hist, & ! Particle concentration history upto time t c0_oilhist, & ! Oil concentration history upto time t coal_frhist, & ! Coal. fr. history for each time startt, & ! Start time for multiple stages endd, & ! End time for multiple stages cake_perm, & ! Cake perm for multiple stages cake_por, & ! Cake por for multiple stages flow_rate, & ! Flow rate for multiple stages kp_in,& np_in,& kpt_in,& npt_in real(8):: r_liner, gpk,gpd !Gravel Pack Parameters real(8), Dimension(:), Allocatable:: fpp,fpd,fpk,lfp,avgwfp,dy !Frac-Pack Completion Parameters real(8),Allocatable,Dimension(:,:):: Afrac !Area of the fracture real(8),Allocatable,Dimension(:,:):: RL0core,Rrfg,dyg,Acore,Lcore,wfp real(8)::lfpd real(8),Dimension(:,:),Allocatable::Rrf,Rrfd real(8),Dimension(:),Allocatable:: Rwell,Rfracpack,Rfracpack0,fracr1 real(8),Dimension(:),Allocatable::& cum_parr, & ! Cumulative vol of particles entering a layer cum_parr_lambda, & ! Cumulative vol of particles entering a layer cum_parr_lf, & ! Cumulative vol of particles around the fracture at time t (is less the cum_parr when frac closes a bit) cum_oill, & ! Cumulative vol of oil entering a layer cum_oill_lambda, & ! Cumulative vol of oil entering a layer cum_oill_lf, & ! Cumulative vol of oil around the fracture at time t (is less the cum_parr when frac closes a bit) cum_parrtt,& ! Cumulative vol of particles entering a layer until transition time cum_oilltt ! Cumulative vol of oil entering a layer until transition time Integer::rp_flag, adjacent_ck real(8),Allocatable:: & hadj(:), & ! Height of beds used in calcualting kadj kadj(:), & ! Average k in the vertical direction based on the location of the perfs hcalc(:), & ! Height of beds used in calcualting kadj kcalc(:) ! Average k in the vertical direction based on the location of the perfs real(8):: Avert, & ! Area for flow into adjacent beds ck_dipping, & ! Flag for dipping beds ck_eqfp ! Flag for Approximate/Equivalent frac-pack growth using 2D fracture growth model Contains !################################################### ! MAINC !################################################### subroutine MAINC character(200) :: IFileName Character(200) :: fname, drive, dir, name, ext, newdirname Integer :: j, length Logical :: dirChangeStatus, dirCreateStatus Write(99,*) 'WIDCALC MAINC' OPEN(Unit=1, NAME="FILENAME.TMP", Action='Read') READ(1,*) IFilename Close(1) Write(99,*) 'Inputfile: ', IFileName Call FileOpen(IFILENAME) IF (.NOT. Ok) Then Write(99,*) 'File Reading or Variables NOT OK' Write(99,*) 'Terminating execution (Mainc=0)!' Else length = SPLITPATHQQ(IFilename, drive, dir, name, ext) !Breaks a file path or directory path into its components dirChangeStatus = CHANGEDIRQQ(dir) !Makes the specified directory the current, default directory !newdirname=Trim(name)//'_UTWID_FortranOutput' !dirCreateStatus = MAKEDIRQQ (newdirname) !Creates a new directory with a specified name !dirChangeStatus = CHANGEDIRQQ(Trim(dir)//Trim(newdirname)) !Makes the specified directory the current, default directory FName='Wid.Log' FName = Trim(dir)//trim(name) // '.inj' OPEN(Unit=10, NAME=fname,FORM='FORMATTED',ACTION = 'Write') Write(10,*) "This file outputs core injectivity, injection rate and inlet pressure" Write(10,*) "Pore_vols_injected Injectivity_ratio Injection_rate(cm3/min) Inlet_pr(psi)" If (out_pp==1) Then FName = Trim(dir)//trim(name) // '.prm' OPEN(Unit=20,NAME=FName, ACTION = 'Write') Write(20,*) "This file outputs core permeability (md) with pore volumes injected" Write(20,*) "Pore_vols_injected Core permeability of all the segments from 1st to Nth" End If Ntime = 0 ! Set Number of calculated points t = Dble(0) ! Time vector first point NPV = 0 ! Time vector first point alpha = Dble(1) ! Relative Injectivity first point ! Initialize permeability Do j=1,ltnum k(j,:)=kmh(j) ! Initialize permeability End Do If (wt == 2) Then ! Core Call Calc_Core ElseIf (wt == 0) Then ! Vertical well if (realct == 0 .OR. realct == 1) then call calc_V_unfrac elseif (realct == 2 .OR. realct == 3) then call calc_V_frac elseif (realct == 4) then call calc_V_fracpack endif elseif (wt == 1) then ! Horizontal well if (realct == 2 .OR. realct == 3) then call calc_H_longitudinal_frac elseif (realct == 4 .OR. realct == 5) then call calc_H_transverse_frac endif End If Call WriteResult Close(10) If (out_pp==1) then if (wt==hwell) then Write(20,90) (r-rw)*100 else Write(20,90) r*100 end if Close(20) End If Call DeAlloc End If Write(99,*) 'MAINC: Last Line' CLOSE(919) close (929) Close (939) 90 FORMAT(200F15.4) Contains !---------------------------------- ! WriteResult !---------------------------------- Subroutine WriteResult Integer :: j !FName = Trim(dir)//trim(name) // '.res' FName = Trim(dir)//'Filtration' // '.tmp' OPEN(Unit=30, NAME=FName, ACTION = 'Write') 200 FORMAT(I4,100F16.4) 110 FORMAT(A30, 100F16.4) 100 FORMAT(A103) If (wt == 2) Then ! Core Write(30,*) "No. of time intervals" ! Number of time intervals Write(30,*) Ntime ! Number of time intervals else Write(30,100) 'Layer Dam.Len.(cm) Filt.coeff.(1/m) Oil.Filt.coeff.(1/m) Trans.time(days) Cr.Por Cr.Perm(md)' end if if (L == 0.0) then L = rf end if Do j=1,ltnum !sh If (wt /= 2) Then ! not Core-flood tt(j)=tt(j)*s2day ! convert transition time in seconds to days end if If (wt == 2) Then ! Core Write(30,100) 'Core Trans.time(pore_volumes) Filtration_coeff.(1/m) Deposited_vol_at_inlet(fraction) Dam.Len.(cm)' Write(30,200) j,tt(j),lambda00(j),sigma(j,1),L*100.0 else Write(30,110) trim(lname(j))//",",L*100,lambda00(j),lambda00_oil(j),tt(j),pcr(j),k(j,1)*1e15 !,lambda(j,1),sigma(j,1), end if End Do Close(30) End Subroutine WriteResult !---------------------------------- ! Deallocate !---------------------------------- Subroutine DeAlloc Deallocate(lw,ecc,kmh,kmv,pm,h,tst,res_pr,topp,bottomp,topl,bottoml,dg,Nr,Nr2,df,fc,dfae,fcae,dgae,bar) Deallocate(cal_ed,cal_id,pcr_type,pcr,fctd,e,b0,b1,b2) Deallocate(lname,tt,ttu,lambda,avg_lambda,lambda_oil,avg_lambda_oil,lambdawm,lambdag,lambda0,lambda0wm, lambda0wm_oil,lambda00,lambda00_oil,sigma,sigmawm,sigmawm_oil,sigmag) Deallocate(k,r,rgg,ql,ila,Rl,Rl0,c, Aface,vda) Deallocate(hc, Res1,Res2,Res3,Res4,Rint,Rcc,Rud,Rskin,Resf,Resp) ! Added by Ajay on Sept 06 2006 Deallocate(delp1,delp2,delp3,delp4,delptrans,delpint,delpcc,delpud,delps_ini,delpf,wf,delpp,P1,Ptip,RHS,Pfrac,sminh,dst,dsp) ! Added by Ajay on Sept 15 2006 End Subroutine DeAlloc End subroutine Mainc !########################################################## !Mainc Ends here !########################################################## !---------------------------------- ! Fileopen !---------------------------------- Subroutine FileOpen(IFileName) Character(*), Intent(In) :: IFileName Character(15) :: tempstr real(8) :: psu,pdh,RC,dtu,htu,ltu ! Pressure parameters Integer :: i,p_type ! Counter real(8):: dumpar1, dumpar2 Integer:: lp_ct 100 FORMAT(A50) Ok = .False. ! Open file and check that it is a WID file Open(UNIT=10, FILE=IFileName, ACTION='READ', ERR=900) call skip_hashlines READ(10,*, ERR=1000) tempstr Write(99,*) 'Input File header: ', tempstr call skip_hashlines Read(10,*, ERR=1000) wt Write(99,*) 'wt ', wt,'; 0 means VERTICAL WELL, 1 means HORIZONTAL, 2 means CORE' !Need to read ck_dipping, dip, frac_grad !ck_dipping=1 !Need to remove this line for dipping beds and replace it with the read value !dip=90.0/180.0*pi !Need to remove this line for dipping beds and replace it with the read value !frac_grad=.59*3.28*6894.76 !Need to remove this line for dipping beds and replace it with the read value !frac_grad=.00001*3.28*6894.76 !Need to remove this line for dipping beds and replace it with the read value If (wt == cwell) then ! core flood call skip_hashlines Read(10,*, ERR=1000) d, L, rf, Ns ! Core parameters Else ! horizntal or vertical well call skip_hashlines !Read(10,*, ERR=1000) rw, re, lw, gpp, rf, Ns ! Well parameters Read(10,*, ERR=1000) rw, re, gpp, rf, Ns ! Well parameters Write(99,*) 'rw ', rw*39.37 , ' inches' ! Well parameters call skip_hashlines Read(10,*, ERR=1000) ct, realct ! Completion type Write(99,*) 'ct =',ct,'; 0 means Openhole, 1 means Perforated' Write(99,*) 'realct',realct, ' 0=No frac growth;2,3=2D frac;4=Fracpack,5;6=3D frac growth' if ((wt == vwell .AND. (realct == 1 .OR. realct == 3 .OR. realct == 4 .OR. realct == 6)) .OR. & (wt == hwell .AND. (realct == 1 .OR. realct == 3 .OR. realct == 5)) ) then call skip_hashlines Read(10,*,ERR=1000) rp, Lp, ds, PhsFct ! perforated vertical or horizontal well endif End If call skip_hashlines Read(10,*, ERR=1000) ConstRate ! Completion type call skip_hashlines Read(10,*, ERR=1000) nstage Write(99,*) 'No. of water injection stages = ',nstage call skip_hashlines Read(10,*, ERR=1000) ltnum Write(99,*) 'No. of layers = ',ltnum call skip_hashlines Read(10,*, ERR=1000) ck_dipping lp_ct=ltnum if (ck_dipping ==1) then ltnum=2*ltnum endif call skip_hashlines Read(10,*,ERR=1000) ck_eqfp !call skip_hashlines !Read(10,*,ERR=1000) eccentricity !commented out on June 30 2010 Call Alloc ! Allocate variables Write(99,*) 'Allocated' do i = 1, nstage call skip_hashlines Read(10,*, ERR=1000) startt(i), endd(i), flow_rate(i), den_p(i),kp_in(i),np_in(i),kpt_in(i),npt_in(i),den_f(i),p_conc(i),p_dia(i), den_oil(i), oil_dia(i), conc_oil(i), coal(i) ! Water parameters call skip_hashlines Read(10,*,ERR=1000) cake_por(i), cake_perm(i),dumpar1, dumpar2 ! Cake parameters end do call skip_hashlines Read(10,*, ERR=1000) p_type,psu,pdh,pres,p0,skin_ini,RC,dtu,htu,ltu ! Pressure parameters Write(99,*) 'p_type: ', p_type Do i = 1,lp_ct call skip_hashlines Read(10,100,ERR=1000) lname(i) ! Layer Name call skip_hashlines ! commented out on June 30 2010 !if (wt==hwell) then Read(10,*,ERR=1000) perf_ck(i), h(i) , tst(i), res_pr(i), kmh(i), kmv(i), pm(i), lw(i), ecc(i) ! Formation parameters !else ! Read(10,*,ERR=1000) perf_ck(i),h(i) , kmh(i), kmv(i), pm(i) ! Formation parameters !end if call skip_hashlines Read(10,*,ERR=1000) df(i), fc(i), fco(i), dg(i) call skip_hashlines Read(10,*,ERR=1000) dfae(i), fcae(i),fcae2(i),dgae(i), & ! Damage parameters bar(i), cal_id(i),cal_ed(i) call skip_hashlines Read(10,*) pcr_type(i), pcr(i), ttu(i), fctd(i),e(i),b0(i),b1(i),b2(i) call skip_hashlines Read(10, *) topp(i), bottomp(i),topl(i), bottoml(i), dip(i) ! layer perforation depths and sand depths Nr(i) = dp/dg(i) Nr2(i) = Nr(i)**2 End Do If (wt==cwell) Then ! Core call skip_hashlines Read(10,*,ERR=1000) npv_max, alpha_min, dnpv !Max run time and time step in PVs for core Else call skip_hashlines Read(10,*,ERR=1000) t_max, alpha_min, dtday, hist_inj_rates, hist_avg_res_prs, pres_multiple_flag, fracture_closure !Max run time and time step in days for the rest dt = dtday*day2s End If call skip_hashlines Read(10,*,ERR=1000) out_id, out_pp, out_ihl ! Permeability profile out flag If ( ((wt == 0).And. ((realct==2) .OR. (realct==3) .OR. (realct==4))) .OR. & ((wt == 1).And. ((realct==2) .OR. (realct==3) .OR. (realct==4) .OR. (realct==5))) ) Then !7/13/98 New Read statements for the new Fluid and Rock properties Do i = 1,lp_ct call skip_hashlines Read (10,*) rhoo(i), rhow(i), cw(i), co(i), mor(i), mwi(i), Tr(i), Tw(i), Chw(i), Cho(i) call skip_hashlines Read (10,*) Sor(i), Swi(i), Krw(i), kro(i), rhog(i), n(i), Cgr(i), Cf(i), Y(i), Sigmamin(i), Chg(i), B(i), dumpar1 ctot(i)= cf(i)+swi(i)*cw(i)+(1-swi(i))*co(i) if ( (wt == 0 .AND. realct==4) .or. ck_eqfp==1 ) then !frac-pack completion data call skip_hashlines Read (10,*) fpp(i),fpd(i),fpk(i),lfp(i),avgwfp(i) endif call skip_hashlines Read (10,*) frac_grad(i), stress_change_pore_pressure(i) end do End If if (ck_dipping==1) then Do i=lp_ct+1, ltnum lname(i) = trim(lname(i-lp_ct)) //' downwards' perf_ck(i) = perf_ck(i-lp_ct) h(i) = h(i-lp_ct) tst(i) = tst(i-lp_ct) res_pr(i) = res_pr(i-lp_ct) topp(i) = topp(i-lp_ct) bottomp(i) = bottomp(i-lp_ct) topl(i) = topl(i-lp_ct) bottoml(i) = bottoml(i-lp_ct) dip(i) = dip(i-lp_ct) kmh(i) = kmh(i-lp_ct) kmv(i) = kmv(i-lp_ct) pm(i) = pm(i-lp_ct) df(i) = df(i-lp_ct) fc(i) = fc(i-lp_ct) fco(i) = fco(i-lp_ct) dg(i) = dg(i-lp_ct) dfae(i) = dfae(i-lp_ct) fcae(i) = fcae(i-lp_ct) fcae2(i) = fcae2(i-lp_ct) dgae(i) = dgae(i-lp_ct) bar(i) = bar(i-lp_ct) cal_id(i) = cal_id(i-lp_ct) cal_ed(i) = cal_ed(i-lp_ct) pcr_type(i) = pcr_type(i-lp_ct) pcr(i) = pcr(i-lp_ct) ttu(i) = ttu(i-lp_ct) fctd(i) = fctd(i-lp_ct) e(i) = e(i-lp_ct) b0(i) = b0(i-lp_ct) b1(i) = b1(i-lp_ct) b2(i) = b2(i-lp_ct) Nr(i) = Nr(i-lp_ct) Nr2(i) = Nr2(i-lp_ct) rhoo(i) = rhoo(i-lp_ct) rhow(i) = rhow(i-lp_ct) cw(i) = cw(i-lp_ct) co(i) = co(i-lp_ct) mor(i) = mor(i-lp_ct) mwi(i) = mwi(i-lp_ct) Tr(i) = Tr(i-lp_ct) Tw(i) = Tw(i-lp_ct) Chw(i) = Chw(i-lp_ct) Cho(i) = Cho(i-lp_ct) Sor(i) = Sor(i-lp_ct) Swi(i) = Swi(i-lp_ct) Krw(i) = Krw(i-lp_ct) kro(i) = kro(i-lp_ct) rhog(i) = rhog(i-lp_ct) n(i) = n(i-lp_ct) Cgr(i) = Cgr(i-lp_ct) Cf(i) = Cf(i-lp_ct) ctot(i) = ctot(i-lp_ct) Y(i) = Y(i-lp_ct) Sigmamin(i) = Sigmamin(i-lp_ct) if (i==3) then !Sigmamin(i) = 19182*6895 !Downdip IS001 A10 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 20944*6895 !Downdip IS001 A10 Sigma hmin for Chevron Tahiti Feb 2012 high stressgrad.0.85 psi/ft !Sigmamin(i) = 19299*6895 !Downdip IS002 A10 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 21068*6895 !Downdip IS002 A10 Sigma hmin for Chevron Tahiti Feb 2012 high stressgrad.0.85 psi/ft else if (i==4) then !Sigmamin(i) = 19221*6895 !Downdip IS001 A20 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 20987*6895 !Downdip IS001 A20 Sigma hmin for Chevron Tahiti Feb 2012 high stressgrad.0.85 psi/ft !Sigmamin(i) = 19347*6895 !Downdip IS002 A20 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 21120*6895 !Downdip IS002 A20 Sigma hmin for Chevron Tahiti Feb 2012 high stressgrad.0.85 psi/ft end if !Sigmamin(i) = 18910*6895 !Downdip IS001 B40 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 20406*6895 !Downdip IS001 B40 Sigma hmin for Chevron Tahiti Feb 2012, high stress grad.0.85 psi/ft !Sigmamin(i) = 19027*6895 !Downdip IS002 B40 Sigma hmin for Chevron Tahiti Feb 2012 !Sigmamin(i) = 20529*6895 !Downdip IS002 B40 Sigma hmin for Chevron Tahiti Feb 2012, high stress grad.0.85 psi/ft Chg(i) = Chg(i-lp_ct) B(i) = B(i-lp_ct) if ( (wt == 0 .AND. realct==4) .or. ck_eqfp==1 ) then !frac-pack completion data fpp(i) = fpp(i-lp_ct) fpd(i) = fpd(i-lp_ct) fpk(i) = fpk(i-lp_ct) lfp(i) = lfp(i-lp_ct) avgwfp(i)= avgwfp(i-lp_ct) endif frac_grad(i)= frac_grad(i-lp_ct) stress_change_pore_pressure(i)= stress_change_pore_pressure(i-lp_ct) EndDo Endif Close (10) Ok=.True. Call Alloc2 Write(99,*) 'Input File Read Successfully by UTWID FORTRAN CODE!' !Call VCheck Write(99,*) 'Basic Input File Variables Have Been Checked For Non-Zero Values!' Return 900 Continue Write(99,*) 'Could not open input file!' Return 1000 Continue Write(99,*) 'Error reading input file!' Return Contains ! Skip lines in the input file starting with hash (#) Subroutine skip_hashlines Character(1)::input input = '#' ! Assume a hash to read the line atleast once DO WHILE (input(1:1) .EQ. '#') READ (10, *) input END DO backspace(10) end subroutine skip_hashlines ! Now that we know the number of layers, ! we can allocate memory Subroutine Alloc Write(99,*) 'Starting Variable Allocation' Allocate(lw(Ltnum),ecc(ltnum),kmh(Ltnum),kmv(Ltnum),pm(Ltnum),h(Ltnum),tst(Ltnum),res_pr(ltnum),topp(ltnum),bottomp(ltnum),topl(ltnum),bottoml(ltnum)) Allocate(dg(Ltnum),Nr(Ltnum),Nr2(Ltnum),df(Ltnum)) Allocate(fc(Ltnum),fco(ltnum),fcg(Ltnum),fcgo(ltnum),dfae(Ltnum),fcae(Ltnum),fcae2(Ltnum),dgae(Ltnum)) Allocate(bar(Ltnum),cal_ed(Ltnum),cal_id(Ltnum)) Allocate(pcr_type(Ltnum),pcr(Ltnum),fctd(Ltnum)) Allocate(e(Ltnum),b0(Ltnum),b1(Ltnum),b2(Ltnum)) Allocate(lname(Ltnum),ttu(ltnum),tt(ltnum),ttwm(ltnum),hcwm(ltnum),ttg(ltnum),ttf(ltnum,Ns+1)) Allocate(lambda0(ltnum,Ns),lambda0_oil(ltnum,Ns),lambda0wm(ltnum,Ns),lambda0wm_oil(ltnum,Ns),lambda(ltnum,Ns),lambda_oil(ltnum,Ns),lambdawm(ltnum,Ns),lambdawm_oil(ltnum,Ns)) Allocate(avg_lambda(ltnum,Ns),avg_lambda_oil(ltnum,Ns),sum_lambda(ltnum,Ns),sum_lambda_oil(ltnum,Ns)) Allocate(lambda0g(ltnum,Ns+1),lambda0g_oil(ltnum,Ns+1),lambdag(ltnum,Ns+1),lambdag_oil(ltnum,Ns+1),lambda00(ltnum),lambda00_oil(ltnum)) Allocate(sigma(ltnum,Ns),sigma_oil(ltnum,Ns),sigmag(ltnum,Ns),sigmag_oil(ltnum,Ns)) Allocate(k(ltnum,Ns),kwm(ltnum,Ns),kgg(ltnum,Ns),r(Ns), rgg(Ns),c(Ns),c_oil(Ns), ql(ltnum),cg(Ns),cg_oil(Ns)) Allocate(ila(ltnum),Rl(ltnum),Rl0(ltnum),Rl01(ltnum),Aface(ltnum)) Allocate(Lfrw(ltnum), Lf(ltnum), Lfold(ltnum),Afacett(ltnum),Rint_tt(ltnum)) Allocate(Swi(ltnum), Sor(ltnum),Krw(ltnum), kro(ltnum), rhog(ltnum),n(ltnum),Cgr(ltnum)) Allocate(Cf(ltnum),cw(ltnum),co(ltnum),ctot(ltnum),Y(ltnum),Sigmamin(ltnum),sigmamin1(ltnum),Chg(ltnum),B(ltnum)) Allocate(Tr(ltnum),Chw(ltnum),Cho(ltnum),rhoo(ltnum),rhow(ltnum),mor(ltnum),mwi(ltnum),Piwf(ltnum), Piwfcheck(ltnum)) Allocate(Wi(ltnum),Res_Res(ltnum)) Allocate(Sig_min_cur(ltnum),maj_axis_w(ltnum),min_axis_w(ltnum),maj_axis_p(ltnum),min_axis_p(ltnum),maj_axis_t(ltnum),min_axis_t(ltnum),maj_axis_D(ltnum),min_axis_D(ltnum),Tw(ltnum)) Allocate(lf_ck(ltnum),trans(ltnum),Rl_vert(ltnum),perf_ck(ltnum),hadj(ltnum), kadj(ltnum),hcalc(ltnum),kcalc(ltnum)) Allocate(hc(ltnum),Res1(ltnum),Res2(ltnum),Res3(ltnum),Res4(ltnum),Rint(ltnum),Rcc(ltnum),Rud(ltnum),Rskin(ltnum),Resf(ltnum),Resp(ltnum)) ! Added by Ajay on Sept 06 2006 Allocate(delp1(ltnum),delp2(ltnum),delp3(ltnum),delp4(ltnum),delptrans(ltnum),delpint(ltnum),delpcc(ltnum),delpud(ltnum),delps_ini(ltnum),delpf(ltnum),wf(ltnum),delpp(ltnum),P1(ltnum),Ptip(ltnum),RHS(ltnum),Pfrac(ltnum),sminh(ltnum),dst(ltnum),dsp(ltnum)) ! Added by Ajay on Sept 15 2006 Allocate(dip(ltnum),frac_grad(ltnum),stress_change_pore_pressure(ltnum)) ! Added by Ajay on Dec 19 2007 Allocate(vda(ltnum,Ns)) If (wt==0 .AND. realct==4) then !frac-packed well Allocate(dy(ltnum),vdwm(ltnum,Ns), vdga(ltnum,Ns), vdfpi(ltnum,0:Ns), qfp(ltnum,0:Ns+1), wfp(ltnum,0:Ns), vdfpo(ltnum,0:Ns+1),qfpo(ltnum,0:Ns+1)) End If !if (ck_eqfp==1 .or. (wt==0 .AND. realct==4) )then !Fractured well Allocate(fpp(ltnum),fpd(ltnum),fpk(ltnum),lfp(ltnum),avgwfp(ltnum)) !end if Allocate(p_conc(nstage), conc_oil(nstage),p_dia(nstage),oil_dia(nstage),den_p(nstage),den_f(nstage),kp_in(nstage),np_in(nstage),kpt_in(nstage),npt_in(nstage)) Allocate(den_oil(nstage), coal(nstage),startt(nstage),endd(nstage),cake_perm(nstage),cake_por(nstage),flow_rate(nstage)) Allocate(cfp(ltnum,Ns,Ns),kgf(ltnum,Ns+1,Ns),cfg(ltnum,Ns),cfg_oil(ltnum,Ns),cfp_oil(ltnum,Ns,Ns)) Allocate(sigmawm(ltnum,Ns),sigmawm_oil(ltnum,Ns),sigmafp_in_solid(ltnum,Ns),sigmafp_in_oil(ltnum,Ns),sigmafp_perp_solid(ltnum,Ns+1,Ns), sigmafp_perp_oil(ltnum,Ns+1,Ns)) Allocate(pttg(ltnum),pttfp(ltnum,Ns),pttf(ltnum)) Allocate(Rfp_ellipse(ltnum),Rcore(ltnum,Ns+1)) Allocate(Riwm(ltnum),Riwmd(ltnum),Rcwm(ltnum)) ! Added by Ajay on Dec 31 2006 Allocate (Acore(ltnum,Ns+1)) Allocate (Lcore(ltnum,Ns+1)) Allocate (Afrac(ltnum,1:Ns)) Allocate (RL0core(ltnum,Ns)) Allocate (Rrf(ltnum,Ns+1)) Allocate (Rrfd(ltnum,Ns+1)) Allocate (Rrfg(ltnum,Ns)) Allocate (dyg(ltnum,Ns)) Allocate (Rwell(ltnum),Rfracpack(ltnum),fracr1(ltnum),Rfracpack0(ltnum)) Allocate (cum_parr(ltnum),cum_oill(ltnum),cum_parr_lf(ltnum),cum_oill_lf(ltnum),cum_parrtt(ltnum),cum_oilltt(ltnum)) Allocate (cum_parr_lambda(ltnum),cum_oill_lambda(ltnum)) Write(99,*) 'Finished Variable Allocation' End Subroutine Alloc Subroutine Alloc2 !history matching for Petrobras Guando Arin GUA-024A vertical injection well ubound=t_max*86400/dt+1 Allocate(pres_multiple(ltnum,1:ubound)) Allocate(pres_1(1:ubound)) Allocate(q1(1:ubound)) !history matching Petrobras Guando ARIN3 GUA-096 injection well, Nexen, Bigfoot !fracture closing parameters for cumulative solids and oil in a given frac length at time t Allocate(qlhist(ltnum,1:ubound)) Allocate(lfhist(ltnum,1:ubound)) Allocate(c0hist(1:ubound)) Allocate(c0_oilhist(1:ubound)) Allocate(coal_frhist(1:ubound)) Allocate(lambdahist(ltnum,1:ubound)) Allocate(lambda_oilhist(ltnum,1:ubound)) end subroutine Alloc2 !------------------------------------ ! VCheck Check Input Variables !------------------------------------ Subroutine VCheck Integer i ! Counter Logical :: Okk(14) real(8) :: Zery Okk(:) = .True. Zery = Dble(0.0) If (wt==cwell) Then If (d<=Zery) Okk(1) = .False. If (L<=Zery) Okk(2) = .False. Else !If (ct==phcmpl) Then ! If (rp<=Zery) Okk(3) = .False. ! If (Lp<=Zery) Okk(4) = .False. ! If (ds<=Zery) Okk(5) = .False. !EndIf EndIf DO i = 1,ltnum If (h(i)1) Then Write(UNIT=10,FMT=100) tc, alpha, q, p, ql(:), ila(:) Else Write(UNIT=10,FMT=100) tc, alpha, q*(10**6)*60, p/6894.76 !q is in cm3/min and p is in psi End if Write(99,FMT=100) tc, alpha ! To screen !Write(919,*) tc, ql(:)/q ! To screen !WRITE (929,*) tc, " ", skin !WRITE (939, *) tc, alpha ! Write to Permeability file ! -------------------------- 110 FORMAT(500F14.4) 120 FORMAT(500E13.5) If (out_pp) Then Do j=1,ltnum Write(20,110) npv, k(j,:)*10.0**15 !Permeability output in md rather than m2 End Do End If If (wt == 2) Then ! Core ! 110 FORMAT (500F12.5) Write(129,110) npv, p/6894.76+0 !writing core inlet pressure in psi Write(191,110) npv, hc*1000 ! writing external cake thickess in mm Write(192,110) npv,t/3600 ! writing injected time (hrs) as a function of no of pv end if End SubRoutine DoIt !------------------------------------------------ ! ccalc Calculate Suspension Concentration ! This procedure is based on suspended conc. ! being in equilibrium with the filtration ! coefficient. I am currently in a discussion ! with Alex Hansen on whether this is valid. ! Input: ! lam(N) Filtration coefficient vector ! x(N) Position vector ! N Number of points ! c0 Conc. at c=0 ! Output: ! c(N) Concentration profile !------------------------------------------------ Subroutine ccalc(lam,x,N,c0,cc) Integer, Intent(In) :: N real(8), Intent(in) :: lam(N), x(N), c0 real(8), Intent(out) :: cc(N) Integer :: i ! Counter real(8) :: dx cc(1) = c0 ! Well surface Do i = 2,N dx = x(i)-x(i-1) cc(i)= cc(i-1)/(1+lam(i-1)*dx) ! Upwind weighing End Do End Subroutine ccalc !------------------------------------------------ ! lambdaUpdate Calculate Filtration coeff. !------------------------------------------------ SubRoutine lambdaUpdate(N) Integer, Intent(In) :: N ! Ns Integer :: i,j ! Counters Do j=1,ltnum If (tt(j)Vc) then VCF=0.0 !March 2013 Anadarko Heidelberg Frac Pack Injection if (wt==0 .and. realct/=4) then WRITE(*,*) 'Time =',t/86400, 'Velocity greater than critical velocity' WRITE(99,*) 'Time =',t/86400, 'Velocity greater than critical velocity' end if else VCF=1/Vc*(Vc-v/f) endif !VCF correction is only applied to frac-packed well used up to July 2013 Anadarko Heidelberg Project !Will be used thereafter for all the projects starting from Anadarko K-2 Project ! if (wt==0 .and. realct==4) then lambda0c=VCF*lambda0c ! end if !Previous lambda0c in UTWID (May 27 2009) !lambda0c = As*(1-f)**(0.33333)*3/2/dg* & !(0.72*NLo**(1/Dble(8))*Nr**(15/Dble(8))+2.4d-3*Ng**(1.2)*Nr**(-0.4)) !+ & ! Tien 7.5 !6*(As*NPe)**(-2/3)) ! Diffusion term IF (lambda0c>real(10000)) lambda0c=real(10000) ! Elseif (dgae=2) Then ! Pang's correlation ! lambda0c = 0.00081896-0.024318*sr+28.011*(sr**2) !filtercoeff a la Pang ! End If End function lambda0c !------------------------------------------------ ! lambdac Calculate Initial Filter coefficient !------------------------------------------------ real(8) Function lambdac(lambda0,sigma,e,b0,b1,b2,Nr) real(8), intent(in) :: lambda0,sigma,e,b0,b1,b2,Nr lambdac = lambda0*(1+sigma**e *(b0+b1*Nr+b2*Nr**2)) End function !------------------------------------------------ ! ttime Check if transition time is reached ! Input ! sig Deposited Concentration (fraction) ! por0 Original Porosity (fraction) ! PorCr Critical Porosity (fraction) ! Output ! Transition time reached: ttime = True ! Else False !------------------------------------------------ real(8) Function ttime(sig,por0,pcr_typ,porcr,ttu) real(8), Intent(IN) :: sig,por0,porcr,ttu Integer, Intent(In) :: pcr_typ real(8) :: rempor,trt trt= dble(-1.0) ! Not reached yet rempor = por0 - sig ! If (rempor<=porcr) then ! Porosity criterium trt = t !*s2day ! time in seconds end if IF (pcr_typ==2) then ! User time criterion If (t>ttu) then trt = t !*s2day ! time in seconds End If End If ttime = trt End Function ttime !------------------------------------------------ ! ParCop Calculate the resistance of those in ! a vector, R, parallell coupled !------------------------------------------------ real(8) Function ParCop(R) real(8) :: R(:) ! Resistance vector ParCop = 1/SUM(1/R) End Function ParCop !------------------------------------------------ ! RadGrid ! Calculate a logr distribution of r!s ! Input ! r1,r2 Inner and outer radius, m ! N Number of points ! Output ! r Radius vector (r(1)=r1, r(N)=r2/dr), m ! dr r(i+1)/r(i) !------------------------------------------------ Subroutine radgrid(r1,r2,N,r,dr) real(8), Intent(In) :: r1,r2 Integer, Intent(In) :: N real(8), Intent(Out) :: r(:), dr Integer i dr = (r2/r1)**(1/Dble(N)) ! Determine geom. step so that r(i+1)=r(i)*dr r(1) = r1 ! Set First point in vect to r1 Do i = 2,N r(i) = r(i-1)*dr ! Determine other points, r(N+1) will be r2 End Do End Subroutine !------------------------------------------------ ! StopCheck !------------------------------------------------ Logical Function StopCheck(alpha,t) real(8), Intent(In) :: alpha,t real(8) :: tday StopCheck=.True. !If (alphanpv_max) StopCheck = .FALSE. !stop at t_max Else tday = t*s2day If (Int(tday)>t_max) StopCheck = .FALSE. !stop at t_max End If End Function StopCheck !------------------------------------------------ ! Inittt Initialize transition time ! !------------------------------------------------ Subroutine Inittt Integer :: j Do j=1,ltnum If (cal_id(j)==1) Then tt(j) = dble(-1) Else tt(j) = Dble(0.0) End If End Do End Subroutine Inittt Subroutine Initttg Integer :: j Do j=1,ltnum If (cal_id(j)==1) Then ttg(j) = dble(-1) Else ttg(j) = Dble(0.0) End If End Do End Subroutine Initttg Subroutine Initttfp Integer :: j,i Do j=1,ltnum If (cal_id(j)==1) Then ttf(j,:) = dble(-1) Else ttf(j,:) = Dble(0.0) End If End Do End Subroutine Initttfp !-------------------------------------- ! qpUpdate !-------------------------------------- SubRoutine qpUpdate(R,q,p) real(8), Intent(IN) :: R real(8), Intent(InOut) :: q,p ! Update p first time !constrate = .true. ! Deleted mu in p RHS added on May 10 2007 If (p<=0.00000001) Then p = R*q End If If (ConstRate) then ! Deleted mu in p RHS added on May 10 2007 p = R*q else ! Deleted mu in p RHS denominator added on May 10 2007 q = p/R End If End Subroutine qpUpdate !------------------------------------------------ ! Calc_Core ! Calculate the internal damage in core floods !------------------------------------------------ Subroutine Calc_Core() real(8), External :: PermDecl real(8) :: & dx,& ! Core slice thickness Rc,& ! Cake resistance Rint,& ! Internal resistance PorVol ! Pore Volume real(8)::hc_new real(8)::perm_array(Ns), perm_store(Ns), g_dia(Ns), por_new Integer i, j ! Counter Logical & loopy, & ! Loop true or false new_k, & current_stage 70 FORMAT(A110) 80 FORMAT(A95) !------------------------------------------------------------------------------------------------------------- ! Opening output files for writing the results and headers !------------------------------------------------------------------------------------------------------------- open (Unit=129, NAME="Average_BHP.tmp", Action='Write') Write(129,*) "This file outputs the no. of pore volumes injected and inlet pressure" Write(129,*) "No.of_PV's Inlet_pressure(psi)" open (Unit=191, NAME="cake_thickness.tmp", Action='Write') Write(191,*) "This file outputs the no. of pore volumes injected and cake thickness" Write(191,*) "No.of_PV's Cake_thickness(mm)" open (Unit=192, NAME="npv.tmp", Action='Write') Write(192,*) "This file outputs the no. of pore volumes injected and injection time" Write(192,*) "No.of_PV's Injection_time(hrs)" ! Initial !--------------------- ! 1) Allocations Write(99,*) "Reached core, t is", t kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) q0=flow_rate(1) ! Shear rate parameters, np, kp is used to calculate Hp Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(1)*pm(1))**((1.0-np)/2.0) c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) ! 2) Initialize resistances Aface(1) = pi*(d/2)**2 ! Core area mu=Hp*(q0/Aface(1))**(np-1) !! Change 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 15 !! with new resistivity definition, multiplied with mu (single phase flow) R0tot = L*mu/kmh(1)/Aface(1) ! Initial resistance in core Rint = R0tot ! Initial internal resistance PorVol = Aface(1)*L*pm(1) ! Core PV Rc=0.0000 hc=0.0 ! 3) Transition time, flux, grid etc. Call Inittt dx = L/Ns ! Slice width, m Do i = 1,Ns ! Build r-vector r(i) = (i-1)*dx End Do Call qpUpdate(R0tot,q0,p0) q = q0 p = p0 vda(1,:) = q /Aface(1) ! Core interstitial velocity Call WriteInj ! Write this first trivial point !Writing permeability in the core at t=0 ! open (Unit=21, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles ! Write(21,80) "This file outputs the permeability of the reservoir perpendicular to the fracture for each segment of the damage zone (md)" ! Write(21,70) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" ! If (out_pp==1) Then ! Do j=1,ltnum ! k(j,:)=kmh(j) ! Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md ! End Do ! endif ! Write(21,*) ! 4) Initialize Filtration coefficient and sigma If (fcae(1)) Then lambda0(1,:) = lambda0c(dp,dg(1),rhop,rhol,mu,vda(1,1),pm(1)) if (c0_oil>0) then lambda0_oil(1,:)=lambda0c(doil,dg(1),rhooil,rhol,mu,vda(1,1),pm(1)) endif Else lambda0(1,:) = fc(1) ! Determined by user lambda0_oil(1,:)=fco(1) End If lambda(1,:) = lambda0(1,:) ! Determined by user lambda_oil(1,:)=lambda0_oil(1,:) sigma(1,:) = Dble(0.0) lambda00(1) = lambda0(1,1) ! output for writing lambda00_oil(1)=lambda0_oil(1,1) ! output for writing ! 5) Time loop loopy = .True. current_stage=1 perm_store=kmh(1) perm_array=kmh(1) por_new=pm(1) Do While (loopy) do i=1,nstage if (npv>startt(i) .AND. npv<=endd(i)) Then if (i/=current_stage) then perm_store=perm_array por_new=por_new-sigma(1,1) sigma=0 current_stage=i endif q=flow_rate(i) c0=p_conc(i) rhop=den_p(i) rhol=den_f(i) dp=p_dia(i) c0_oil=conc_oil(i) doil=oil_dia(i) rhooil=den_oil(i) coal_fr=coal(i) kc= cake_perm(i) pc=cake_por(i) endif enddo npv = npv+dnpv ! Number of pore volumes dt = dnpv/(q/porvol) ! Elapsed time (sec) t = t+dt ! Total time (s) ! Internal !--------------------- Call lambdaUpdate(Ns) If (tt(1)<0) Then !Call ccalc(lambda(1,:)*10,r,Ns,c0,c) Call ccalc(lambda(1,:),r,Ns,c0,c) !Ajay added on Nov 10 2009 by removing the multiplication of lambda by 10 if (c0_oil>0) then call ccalc(lambda_oil(1,:),r,Ns,c0_oil*(1-coal_fr),c_oil) ! Find concentration endif Rint = 0 Do i=1,Ns if (c0_oil>0) then sigma(1,i)=sigma(1,i)+lambda(1,i)*(vda(1,1)*c(i)*dt)+lambda_oil(1,i)*(vda(1,1)*c_oil(i)*dt) else sigma(1,i)=sigma(1,i)+lambda(1,i)*10*(vda(1,1)*c(i)*dt) endif if (sigma(1,i)>(pm(1)-pcr(1))) then sigma(1,i)=pm(1)-pcr(1)+0.001 end if k(1,i) = perm_store(i)*PermDecl(sigma(1,i),pm(1),dg(1),dp,df(1)) !! Change 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 !! with new resistivity definition, multiplied with mu (single phase flow) Rint=Rint+(mu*dx/Aface(1))/k(1,i) perm_array(i)=k(1,i) End Do ! In case of external calculation, stop internal ! when transition time is reached tt(1) = ttime(sigma(1,1),por_new,pcr_type(1),pcr(1),ttu(1)) ! Set false if t > transtime If (tt(1)>0) tt(1)=npv ! Pore volumes for core ! External !--------------------- Else PartVol = (c0*q*dt+c0_oil*(1-coal_fr)*q*dt)/(1-pc) ! Particle volume in dt hc_new = PartVol/AFace(1) ! Cake thickness hc = hc+hc_new !! Change 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 !! with new resistivity definition, multiplied with mu (single phase flow) Rc = Rc+mu*hc_new/kc/Aface(1) End If ! Find Rtot Rtot = Rint+Rc ! Total resistance Call qpUpdate(Rtot,q,p) IF (.NOT. ConstRate) Then ! recalc q, v and lambda0 vda(1,:) = q/Aface(1) End If Call lambdaUpdate(Ns) alpha = R0tot/Rtot ! Injectivity at this point Call WriteInj loopy = StopCheck(alpha,npv) ! open (unit=12, file="coreout.txt") ! Write (12,*)t,Rtot, R0tot ! Write(6,*) t,Rtot,R0tot,"rr" 110 FORMAT (500F14.5) ! open (Unit=129, NAME="Average_BHP.tmp", Action='Write') ! Write(129,110) t/86400, p/6894.76+14.67 !writing core inlet pressure in psi ! open (Unit=191, NAME="cake_thickness.tmp", Action='Write') ! Write(191,110) t/86400, hc*1000 ! writing external cake thickess in mm ! open (Unit=192, NAME="npv.tmp", Action='Write') ! Write(192,110) t/86400, npv ! writing no of pore volumes injected End Do ! loopy End Subroutine Calc_Core !------------------------------------------------ ! Calc_V_unfrac ! Calculate the internal damage for an openhole ! geometry. !------------------------------------------------ Subroutine Calc_V_unfrac() real(8), External :: PermDecl real(8) :: dr ! Geom. radius step real(8), Dimension(:), Allocatable :: & Rc,& ! Layer Resistance (m3) Rnw,& ! Layer Resistance (m3) Rout,& ! Outer Resistance (m3) rck ! Filter cake radius, rc <= rw real(8):: avg_res_present, factr Integer i,j ! Counters Logical loopy ! Loop true or false ! Initialize all variables ! ------------------------- ! 1) Allocate vector Variables, see above for comments Allocate(Rc(ltnum)) Allocate(Rnw(ltnum)) Allocate(Rout(ltnum)) Allocate(rck(ltnum)) open (Unit=919, NAME="qll.tmp", Action='Write') open (Unit=929, NAME="skinn.tmp", Action='Write') q0=flow_rate(1) c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) ! Added by Ajay on Dec 05 2007 rf = rf+rw ! 2) Resistances ! Area, flux and Velocity If (ct==ohcmpl) Then ! Open hole Aface(:) = 2*pi*rw*h(:) ! Area (Array mult) ElseIf (ct==phcmpl) Then ! Perforations Aface(:) = 2*pi*rp*Lp*ds*h(:) rw = Aface(1)/2/Pi/h(1) End If !!!Change1111111111111111111111111111111111111 !! with new resistivity definition (Rout RHS is multiplied by mu) Rc(:) = Dble(0.0) ! No filter cake initially Do j=1,ltnum !!!Change22222222222222222222222222222222222222 !! with new resistivity definition (Rnw RHS is multiplied by mu) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*pm(j))**((1.0-np)/2.0) mu=Hp*(q0/sum(Aface))**(np-1) Rout(j) = mu*Log(re/rf)/(2*pi*kmh(j)*h(j)) ! Undamaged part (Array) Rnw(j) = mu*Log(rf/rw)/(2*pi*kmh(j)*h(j)) ! Initial resistance initial_res(j)=Rnw(j)+Rout(j) !!!Change33333333333333333333333333333333333333 !! with new resistivity definition (initial_factor & Rskin RHS are multiplied by mu) initial_factor(j)=mu/(2*pi*kmh(j)*h(j)) Rskin(j) = mu*skin_ini/(2*pi*kmh(j)*h(j)) ! Skin resistance Rl(j) = Rnw(j)+Rout(j)+ Rskin(j) ! Layer resistance Rl0(j) = Rl(j) ! Layer resistance End Do avg_res=0 Do j=1, ltnum avg_res=avg_res+1/initial_res(j) enddo factr=0 Do j=1, ltnum factr=factr+1/initial_factor(j) enddo factr=1/factr avg_res=1/avg_Res avg_res_present=0 Do j=1, ltnum avg_res_present=avg_res_present+1/Rl(j) enddo avg_res_present=1/avg_res_present skin=(avg_res_present-avg_res)/factr rck(:) = rw ! No filter cake thickness initially R0tot = ParCop(Rl(:)) ! Initial total resistance ! 3) Transition time, Flux and grid Call qpUpdate(R0tot,q0,p0) q = q0 p = p0 Call Inittt ql(:) = q*R0tot/Rl(:) ! Flux ila(:) = 1 Call radgrid(rw,rf,Ns,r,dr) ! Define radial grid Do j=1,ltnum vda(j,:) = ql(j)/Aface(j)*rw/r(:) ! Darcy velocity Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*pm(j))**((1.0-np)/2.0) mu=Hp*(vda(j,1))**(np-1) End Do Call WriteInj ! Write this first trivial point ! 4) Initiate sigma and lambda ! Sigma sigma(:,:) = Dble(0.0) ! Clogged concentration ! Filtration coefficient Do j=1,Ltnum If (fcae(j)==1) Then DO i=1,Ns lambda0(j,i)=lambda0c(dp,dg(j),rhop,rhol,mu,vda(j,i),pm(j)) if (c0_oil>0) then lambda0_oil(j,i)=lambda0c(doil,dg(j),rhooil,rhol,mu,vda(j,i),pm(j)) endif End Do Else lambda0(j,:)=fc(j) lambda0_oil(j,:)=fco(j) End If End Do lambda(:,:)=lambda0(:,:) ! Set filtr. coeff. equla to init. lambda_oil(:,:)=lambda0_oil(:,:) lambda00(:) = lambda0(:,1) !lambda output for results lambda00_oil(:) = lambda0_oil(:,1) !lambda output for results ! 5) Time loop varianbles and Start time loop ! ---------------- loopy = .True. Do While (loopy) ! Outer time loop t = t+dt !Stage parameters do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400) Then q0=flow_rate(i) c0=p_conc(i) rhop=den_p(i) rhol=den_f(i) dp=p_dia(i) c0_oil=conc_oil(i) doil=oil_dia(i) rhooil=den_oil(i) coal_fr=coal(i) kc= cake_perm(i) pc=cake_por(i) kp=kp_in(i) np=np_in(i) kpt=kpt_in(i) npt=npt_in(i) endif enddo ! Start layer loop ! ---------------- Do j = 1,Ltnum ! Check if internal resistance shall be ! calculated for this layer, and calc. ! if cal_id is true and trans. time is ! not reached. if cal_ed(j)=0, tt will ! never be reached. If (tt(j) transtime ElseIf (tt(j)>=Dble(0.0)) Then PartVol = c0*ql(j)*dt/(1-pc) ! Particle volume in dt ! The next line updates the radius out to the filter cake ! The first time, rc=rw *****&&**** ! Check and make sure filter cake radius isn't negative ! if it has we'll be taking the sqrt of a negative so ! set the radius to a very small number and set an error variable ! to true so that later we Write to the ! error file err2.tmp rck(j) = (rck(j)**2-PartVol/pi/h(j)) if (rck(j) <= 0) then rck(j) = 1e-3 else rck(j) = sqrt(rck(j)) endif !!!!Change55555555555555555555555555555555555555555555 !! with new resistivity definition (multiplied with mu) Rc(j) = mu*log(rw/rck(j))/(2*pi*kc*h(j)) ! External resistance EndIf Rl(j) = Rnw(j)+Rc(j)+Rskin(j)+Rout(j) ! Total layer resistance End Do ! Layers Rtot = Parcop(Rl) ! Total resistance Call qpUpdate(Rtot,q,p) ! The next lines updates layer injectivity, layer flow ! velocity, lambda0 and lambda Do j=1,ltnum Ila(j) = Rl0(j)/Rl(j) ! Layer Injectivity ql(j) = q*Rtot/Rl(j) ! Layer flux vda(j,:) = ql(j)/Aface(j)*rw/r(:) ! Darcy Velocity End Do Call lambdaUpdate(Ns) ! Store result vectors alpha = R0tot/Rtot !!!!Change66666666666666666666666666666666666666666666666666666666666 !! with new resistivity definition (deleted mu, was multiplied before) delpres = q0*(Rnw(1)-R0tot) skinr = (4*pi*kmh(1)*h(1)*delpres)/(q0*mu) avg_res_present=0 Do j=1, ltnum avg_res_present=avg_res_present+1/Rl(j) enddo avg_res_present=1/avg_res_present skin=(avg_res_present-avg_res)/factr Call WriteInj ! Determine whether to stop calculations loopy = StopCheck(alpha,t) End do ! Time loop DeAllocate(Rnw,Rc,Rout,rck) End subroutine Calc_V_unfrac !------------------------------------------------ ! Calc_GOH ! Calculate the internal damage for a Gravel pack ! geometry. !------------------------------------------------ Subroutine Calc_GOH() real(8), External :: PermDecl real(8) :: dr, drg ! Geom. radius step real(8), Dimension(:), Allocatable :: & Rc,& ! Layer Resistance (m3) Rnw,& ! Layer Resistance (m3) Rout,& ! Outer Resistance (m3) Rrg ,& ! Gravel Resistance Rgc ,& ! Cake resistance inside Gravel rck ,& ! Filter cake radius, rc <= rw rcg ! Filter Cake radius inside gravel real(8):: avg_res_present, factr Integer i,j ! Counters Logical loopy ! Loop true or false real(8)::dum1 ! Initialize all variables ! ------------------------- ! 1) Allocate vector Variables, see above for comments Allocate(Rc(ltnum)) Allocate(Rnw(ltnum)) Allocate(Rout(ltnum)) Allocate(rck(ltnum)) Allocate(rgc(ltnum)) Allocate(rcg(ltnum)) Allocate(Rrg(ltnum)) !1)Initialize variables rf = rf+rw ! Added by Ajay on Dec 05 2007 rck=0 Rgc=0 rcg=0 r_liner=rw*0.7 gpp=0.25 gpk=1000e-13 gpd=700e-6 dfg=100 !damage factor for gravel pack q0=flow_rate(1) kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) ! 2) Resistances ! Area, flux and Velocity If (ct==ohcmpl) Then ! Open hole Aface(:) = 2*pi*rw*h(:) ! Area (Array mult) ElseIf (ct==phcmpl) Then ! Perforations Aface(:) = 2*pi*rp*Lp*ds*h(:) rw = Aface(1)/2/Pi/h(1) End If !!!!Change7777777777777777777777777777777777777777777777777777777777 !! with new resistivity definition (multiplied with mu, wasn't there before) Rc(:) = Dble(0.0) ! No filter cake initially Do j=1,ltnum !!!!Change8888888888888888888888888888888888888888888888888888888888 !! with new resistivity definition (multiplied with mu, wasn't there before) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*pm(j))**((1.0-np)/2.0) mu=Hp*(q0/sum(Aface))**(np-1) Rout(:) = mu*Log(re/rf)/(2*pi*kmh(:)*h(:)) ! Undamaged part (Array) Rnw(j) = mu*Log(rf/rw)/(2*pi*kmh(j)*h(j)) ! Initial resistance Rrg(j)= mu*Log(rw/r_liner)/(2*pi*gpk*h(j)) ! Initial resistance initial_res(j)=Rnw(j)+Rout(j)+Rrg(j) !!!!Change9999999999999999999999999999999999999999999999999999999999 !! with new resistivity definition (multiplied with mu, wasn't there before) initial_factor(j)=mu/(2*pi*kmh(j)*h(j)) Rskin(j) = mu*skin_ini/(2*pi*kmh(j)*h(j)) ! Skin resistance Rl(j) = Rnw(j)+Rout(j)+ Rskin(j)+Rrg(j) ! Layer resistance Rl0(j) = Rl(j) ! Layer resistance End Do avg_res=0 Do j=1, ltnum avg_res=avg_res+1/initial_res(j) enddo avg_res=1/avg_Res factr=0 Do j=1, ltnum factr=factr+1/initial_factor(j) enddo factr=1/factr avg_res_present=0 Do j=1, ltnum avg_res_present=avg_res_present+1/Rl(j) enddo avg_res_present=1/avg_res_present skin=(avg_res_present-avg_res)/factr rck(:) = rw ! No filter cake thickness initially rcg(:) = r_liner R0tot = ParCop(Rl(:)) ! Initial total resistance ! 3) Transition time, Flux and grid Call qpUpdate(R0tot,q0,p0) q = q0 p = p0 Call Inittt Call Initttg ql(:) = q*R0tot/Rl(:) ! Flux ila(:) = 1 Call radgrid(rw,rf,Ns,r,dr) ! Define radial grid Call radgrid(r_liner,rw,Ns,rgg,drg) Do j=1,ltnum vda(j,:) = ql(j)/Aface(j)*rw/r(:) ! Darcy velocity vdga(j,:) = ql(j)/Aface(j)*rw/rgg(:) End Do Call WriteInj ! Write this first trivial point ! 4) Initiate sigma and lambda ! Sigma sigma(:,:) = Dble(0.0) ! Clogged concentration sigma(:,:) = Dble(0.0) ! Filtration coefficient Do j=1,Ltnum Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*pm(j))**((1.0-np)/2.0) mu=Hp*(vda(j,1))**(np-1) If (fcae(j)==1) Then DO i=1,Ns lambda0(j,i)=lambda0c(dp,dg(j),rhop,rhol,mu,vda(j,i),pm(j)) if (c0_oil>0) then lambda0_oil(j,i)=lambda0c(doil,dg(j),rhooil,rhol,mu,vda(j,i),pm(j)) endif End Do Else lambda0(j,:)=fc(j) lambda0_oil(j,:)=fco(j) End If mu=Hp*(vdga(j,1))**(np-1) If (fcae(j)==1) Then DO i=1,Ns lambda0g(j,i)=lambda0c(dp,gpd,rhop,rhol,mu,vdga(j,i),gpp) if (c0_oil>0) then lambda0g_oil(j,i)=lambda0c(doil,gpd,rhooil,rhol,mu,vdga(j,i),gpp) endif End Do Else lambda0g(j,:)=fcg(j) lambda0g_oil(j,:)=fcgo(j) End If End Do lambda(:,:)=lambda0(:,:) ! Set filtr. coeff. equla to init. lambda_oil(:,:)=lambda0_oil(:,:) lambdag(:,:)=lambda0g(:,:) ! Set filtr. coeff. equla to init. lambdag_oil(:,:)=lambda0g_oil(:,:) lambda00(:) = lambda0(:,1) !output for writing lambda00_oil(:) = lambda0_oil(:,1) !output for writing ! 5) Time loop varianbles and Start time loop ! ---------------- loopy = .True. Do While (loopy) ! Outer time loop t = t+dt !Stage parameters do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400) Then q0=flow_rate(i) c0=p_conc(i) rhop=den_p(i) rhol=den_f(i) dp=p_dia(i) c0_oil=conc_oil(i) doil=oil_dia(i) rhooil=den_oil(i) coal_fr=coal(i) kc= cake_perm(i) pc=cake_por(i) kp=kp_in(i) np=np_in(i) kpt=kpt_in(i) npt=npt_in(i) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif endif enddo ! Start layer loop ! ---------------- Do j = 1,Ltnum ! Check if internal resistance shall be ! calculated for this layer, and calc. ! if cal_id is true and trans. time is ! not reached. if cal_ed(j)=0, tt will ! never be reached. Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*krw(j)*pm(j)*(1-sor(j)))**((1.0-np)/2.0) mu=Hp*(vdga(j,1))**(np-1) IF (ttg(j)0) then call ccalc(lambdag_oil(j,:),rgg(:),Ns,c0_oil*(1-coal_fr),cg_oil(:)) ! Find concentration endif cg0=cg(Ns) cg0_oil=cg_oil(Ns) Rrg(j)=Dble(0.0) Do i=1,Ns sigmag(j,i) = sigmag(j,i)+lambdag(j,i)*vdga(j,i)*cg(i)*dt sigmag_oil(j,i) = sigmag_oil(j,i)+lambdag_oil(j,i)*vdga(j,i)*cg_oil(i)*dt kgg(j,i) = gpk*PermDecl(sigmag(j,i)+sigmag_oil(j,i),gpp,gpd,dp,dfg) !!!!Change10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 !! with new resistivity definition (multiplied with mu, wasn't there before) Rrg(j) = Rrg(j)+mu*Log(drg)/(2*pi*kgg(j,i)*h(j)) End Do ttg(j) = ttime(sigmag(j,1)+sigmag_oil(j,1),gpp,pcr_type(j),pcr(j),ttu(j)) If (tt(j) transtime ElseIf (tt(j)>=Dble(0.0)) Then PartVol = c0*ql(j)*dt/(1-pc)/gpp ! Particle volume in dt ! The next line updates the radius out to the filter cake ! The first time, rc=rw *****&&**** ! Check and make sure filter cake radius isn't negative ! if it has we'll be taking the sqrt of a negative so ! set the radius to a very small number and set an error variable ! to true so that later we Write to the ! error file err2.tmp rck(j) = (rck(j)**2-PartVol/pi/h(j)) if (rck(j) <= r_liner**2) then rck(j) = sqrt(r_liner**2+1e-4) ttg(j) = 1 else rck(j) = sqrt(rck(j)) Call radgrid(r_liner,rck(j),Ns,rgg,drg) endif !! with new resistivity definition (multiplied with mu, wasn't there before) Rc(j) = mu*log(rw/rck(j))/(2*pi*kc*h(j)) ! External resistance EndIf ELSE ! External only PartVol = c0*ql(j)*dt/(1-pc) ! Particle volume in dt rcg(j) = (rcg(j)**2-PartVol/pi/h(j)) if (rcg(j) <= 0) then rcg(j) = 1e-3 else rcg(j) = sqrt(rcg(j)) endif !!!!Change1212121212121212121212121212121212121212121212121212121212121212 !! with new resistivity definition (multiplied with mu, wasn't there before) Rgc(j) = mu*log(rw/rcg(j))/(2*pi*kc*h(j)) ! External resistance ENDIF Rl(j) = Rnw(j)+Rc(j)+Rskin(j)+Rout(j)+Rrg(j)+Rgc(j) End Do ! Layers Rtot = Parcop(Rl) ! Total resistance Call qpUpdate(Rtot,q,p) ! The next lines updates layer injectivity, layer flow ! velocity, lambda0 and lambda Do j=1,ltnum Ila(j) = Rl0(j)/Rl(j) ! Layer Injectivity ql(j) = q*Rtot/Rl(j) ! Layer flux vda(j,:) = ql(j)/Aface(j)*rw/r(:) ! Darcy Velocity vdga(j,:) = ql(j)/Aface(j)*rw/rgg(:) End Do Call lambdaUpdate(Ns) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Call lambdaupdateg ! Store result vectors alpha = R0tot/Rtot !!!!Change1313131313131313131313131313131313131313131313131313131313131313 !! with new resistivity definition (deleted factor mu, was multiplied before) delpres = q0*(Rnw(1)-R0tot) skinr = (4*pi*kmh(1)*h(1)*delpres)/(q0*mu) avg_res_present=0 Do j=1, ltnum avg_res_present=avg_res_present+1/Rl(j) enddo avg_res_present=1/avg_res_present skin=(avg_res_present-avg_res)/factr Call WriteInj ! Determine whether to stop calculations loopy = StopCheck(alpha,t) End do ! Time loop DeAllocate(Rnw,Rc,Rout,rck) End subroutine Calc_GOH !---------------------------------------------------------------------------------------------------------------- ! calc_H_longitudinal_frac Added on Dec 13 2007 for longitudinal fracture growth in horizontal injectors ! Main global variables calculated: ! lf(:) Fracture length in each layer ! ql(:) Flow rate in each layer !---------------------------------------------------------------------------------------------------------------- Subroutine calc_H_longitudinal_frac() External pgfellipse2 character(240) :: layer_names, dummy_name real(8) :: & skin, & ! skin rwp, & ! equivalent radius of damaged well in frac inj calculations alphfrc, & ! injectivity of a plugged fracture Piwfdd,& idealdp ! ideal dp (with out skin or fracture from darcy law) real(8)::dh(ltnum) !difference in depth between the top layer and the respective layer real(8)::excess_res_pr(ltnum) !excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_res_pr_ini(ltnum) !initial excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_q !excess q (flow rate) from the over-pressured layers real(8)::avg_pres real(8)::dummy1, dummy2 real(8)::sum_excess_res_pr Integer :: i,j,points_counter = 0, bhpconverge = 0,counter = 1 ! Counters Integer :: layer, present_stage, perf_zone, layers, sumofBHPaveraginglayers,fileopencounter real(8):: dummy,v,app_vis,initial_dp !initial deltaP taking into account initial skin in frac case real(8):: pi=3.14159 real(8):: initial_injectivity, injectivity_1_hour, injectivity_1_day !injectivites real(8):: sig_kh real(8):: tt1, tt2 real(8):: dumpar1,dumpar2,dumpar3,dumpar4,dumpar5,dumpar6,dumpar7,dumpar8,dumpar9,dumpar10,dumpar11,dumpar12 real(8):: piwfleast, realdp, kavg(ltnum),ksum real(8)::idealdp_Uf,idealdp_f,IR !Uf = unfractured, f = fractured, Ji = Injectivity ratio of fractured well with ideal well ! Variables added for horizontal well real(8):: Rh,& ! Horizontal resistance Rout,& ! Outer resistance aj,& ! Ellipsoid major axis delta,& ! distance between the horizontal well axis and the middle of the payzone. fp_por(ltnum) ! Frac-pack porosity !----------------------------------------------------------------------------------------------- ! The following code was added on Oct 10 2010 for adding headers to the output files ! Making a string that has layer names in it layer_names = " Time(days) " do i = 1, ltnum dummy_name=trim(lname(i)) layer_names=trim(layer_names)//" "//trim(dummy_name) end do 60 FORMAT(A125) 70 FORMAT(A100) 80 FORMAT(A95) 90 Format(A246) !----------------------------------------------------------------------------------------------- !Opening The Output Files !----------------------------------------------------------------------------------------------- do i = 1, ltnum open (Unit=177+i, NAME="delp "//trim(lname(i))//".tmp", Action='Write') Write(177+i,80) "This file outputs the pressure drops in the various regions around the reservoir and the fracture" Write(177+i,90) "Time(days) delp1(psi) delp2(psi) delp3(psi) delp4(psi) delptrans(psi) delpint(psi) delpcc(psi) delpud(psi) delps_ini(psi) delpf(psi) delpp(psi) Ptip(psi) Pfrac(psi) Sminh(psi) sigmamin(psi) dst(psi) dsp(psi)" end do do i = 1, ltnum open(Unit=39+i, NAME="filtration "//trim(lname(i))//".tmp", ACTION = 'Write') Write(39+i,80) "This file outputs the transition time and filtration coefficient of a layer by the file name" Write(39+i,*) "Time(days) Transition_time(days) Filtration_coefficient(1/m)" end do open (unit=871, NAME="maj_axis_thermal.tmp", Action='Write') Write(871,*) "This file outputs the major axis of the Thermal Front (ft) in all the layers" Write(871,90) layer_names open (unit=872, NAME="min_axis_thermal.tmp", Action='Write') Write(872,*) "This file outputs the minor axis of the Thermal Front (ft) in all the layers" Write(872,90) layer_names open (unit=9, NAME="maj_axis_waterflood.tmp", Action='Write') Write(9,80) "This file outputs the major axis of the Water-flood front (ft) in all the layers" Write(9,90) layer_names open (unit=10, NAME="min_axis_waterflood.tmp", Action='Write') Write(10,80) "This file outputs the minor axis of the Water-flood Front (ft) in all the layers" Write(10,90) layer_names open (Unit=17,NAME="Well_Injectivity.tmp", Action='Write') Write(17,*) "This file outputs the injectivity of the well (bpd/psi)" Write(17,90) layer_names open (Unit=129, NAME="Average_BHP.tmp", Action='Write') Write(129,80) "This file outputs the bottom hole pressure (psi) at the mid depth of the top layer" Write(129,*) "Time(days) BHP(psi)" open (unit=16, NAME="pfrac.tmp", Action='Write') Write(16,*) "This file outputs the fracture propagation pressure (psi) in all the layers" Write(16,90) layer_names open (unit=18, NAME="ptip.tmp", Action='Write') Write(18,*) "This file outputs the pressure at the tip of the fracture (psi)" Write(18,90) layer_names open (Unit=21, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles Write(21,60) "This file outputs the permeability of the reservoir perpendicular to the fracture for each segment of the damage zone (md)" Write(21,90) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" open (Unit=8, NAME="well_skin.tmp", Action='Write') Write(8,80) "This file outputs the total skin in the injector as a function of time" Write(8,*) "Time(days) Total_well_skin(dimensionless)" open (Unit=11, NAME="frac_length.tmp", Action='Write') Write(11,*) "This file outputs the fracture length (ft) in all the layers" Write(11,90) layer_names open (Unit=197, NAME="flowrate.tmp", Action='Write') Write(197,*) "This file outputs the injection flow rate in each layer (bpd)" Write(197,90) layer_names open (Unit=198, NAME="fraction_flowrate.tmp", Action='Write') Write(198,*) "This file outputs the fraction of flow injected in each layer" Write(198,90) layer_names open (Unit=199, NAME="layer_bhp.tmp", Action='Write') Write(199,80) "This file outputs the BHP (psi) in each layer corrected for the depth. They should be quite same" Write(199,90) layer_names open (Unit=200, NAME="cum_particles.tmp", Action='Write') Write(200,70) "This file outputs the cumulative Solids (ft3) injected in each layer" Write(200,90) layer_names open (Unit=201, NAME="cake_thickness.tmp", Action='Write') Write(201,80) "This file outputs the thickness of the cake formed at the fracture face of each layer (mm)" Write(201,90) layer_names open (Unit=293, NAME="wfmax.tmp", Action='Write') Write(293,*) "This file outputs the maximum width of the fracture in all the layers(mm)" Write(293,90) layer_names !--------------------------------------------------------------------------------------------- !Reading shear thinning polymer parameters n and k at injection temp and reservoir temp !--------------------------------------------------------------------------------------------- !OPEN(Unit=41, NAME="polymer_k&n.tmp", ACTION = 'Read') !Read(41,*) dummy, np,kp !dummy reads the temperature & then reading n and k for polymer at inj temperature !Read(41,*) dummy, npt,kpt !reading n and k for polymer solution at reservoir temperature !Close(41) kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif !Outputting apparent viscosity of the injected polymer as a function of r from the well up to re ! OPEN(Unit=42, NAME="app_vis.tmp", ACTION = 'Write') ! Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(1)*krw(1)*pm(1)*(1-sor(1)))**((1.0-np)/2.0) ! do i=0,100 ! v=flow_rate(1)/2/pi/(rw+i*h(1)/2/100)/lw(1) ! app_vis=Hp*v**(np-1) ! Write(42,*) (rw+i*h/2/100)*3.28, app_vis*1000 ! end do ! close(42) !Rheology of Shell's Brazil Offshore Polymer Solution for Viscous Oil Displacement !np = 0.5335 !kp = 168.46*1E-3 !npt = 0.5335 !kpt = 168.46*1E-3 be = Sqrt(kmh(1)/kmv(1)) ! Anisotropy factor !Read injection rates and/or average reservoir pressure from a .tmp file av_q_tot=0 if (hist_inj_rates == 1) then !Reading Bigfoot-SW23 injection rates OPEN(Unit=63, NAME="historical_q.txt", ACTION = 'Read') Read(63,*, end = 600) dummy_name Read(63,*, end = 600) dummy_name do i = 1, int(t_max/dtday) if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then Read(63,*, end = 600) dummy_time, q1(i), pres_multiple(:,i) !reading rate in bpd and reservoir pr. in psi pres_multiple(:,i)=pres_multiple(:,i)*6894.76 !converts from psi to pascals for SI else Read(63,*, end = 600) dummy_time, q1(i), pres_1(i) !reading rate in bpd and reservoir pr. in psi pres_1(i)=pres_1(i)*6894.76 !converts from psi to pascals for SI end if else Read(63,*, end = 600) dummy_time, q1(i) !reading in bpd end if q1(i) = max(0.0, q1(i)/543439.6331) !converts from bpd in m3/s for SI with min. rate of 0 bpd av_q_tot=av_q_tot+q1(i) end do 600 Close(63) av_q_tot=av_q_tot/int(t_max/dtday) else do i=1,nstage av_q_tot=av_q_tot+flow_rate(i) end do av_q_tot=av_q_tot/nstage endif do i = 1,ltnum dh(i)=((topl(i)+bottoml(i))/2-(topl(1)+bottoml(1))/2) end do if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then pres_ini = pres_multiple(1,1) pres = pres_multiple(1,1) res_pr(1)=pres_multiple(1,1) else pres_ini = pres_1(1) pres = pres_1(1) res_pr(1)=pres_1(1) end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,1) !Added in Jan 27 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do else pres_ini = res_pr(1) ! when reservoir pressure is provided in the GUI pres = res_pr(1) end if write(99,*) write(99,*) 'Reservoir pressure in top layer at time 0 =', pres_ini/6894.76, 'psi' write(99,*) sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr_ini(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr_ini(i) end do !------------------------------------------------------------------------------------------------------------------------------ !--------------------------------------------------------------------------------------------- ! Initialization of total resistivity, deposition, cumulative water, particle, & oil injection ! External filter cake thickness = 0, initial fracture length guess. !--------------------------------------------------------------------------------------------- fileopencounter=0 ! 0 means output files are not open, 1 means the files are already open, so need not open again. dnpv = 1 ! Calculating the apparent wellbore radius in case of perforated completion If (realct==3) Then ! Perforated rw = rp*lp*ds End If if (ck_eqfp==0) then Lfrw=2*rw !Equivalent fracture for the wellbore fp_por=1 avgwfp=0 else Lfrw=Lfp fp_por=fpp end if trans(:)=1 Lf=lfrw !Initialization of Lf lfold=lfrw lfhist(:,counter)=lfold RL0tot=0 !Initial total resistivity of the reservoir Wi(:)=0 !Cumulative water injected in each layer ! Initialized: hc, Cum_parr, Cum_oill = 0 by Ajay on Sept 06 2006 hc(:)=0 !External filter cake thickness in each layer Rcc(:)=0 !External filter cake resistivity Cum_parr=0 !Cumulative volume of particles injected in each layer, units m3 Cum_oill=0 !Cumulative volume of oil injected in each layer, units m3 Cum_parr_lambda=0 !Cumulative of lambda times volume of particles injected in each layer, units m3 Cum_oill_lambda=0 !Cumulative of lambda times volume of oil injected in each layer, units m3 sigmamin1=sigmamin !Initializing the minimum horizontal stress for all layers dst(:)=0 !Initial stress change because of temperature difference dsp(:)=0 !Initial stress change because of pore pressure change !------------------------------------------------------------------------------------- !Setting variables for the first stage of injection !------------------------------------------------------------------------------------- q0=flow_rate(1) !if reading the injection rates and or res pr. from a file if (hist_inj_rates==1) then q0=q1(1) !added in June 2012 for Moondyne Pressure Depletion Case end if if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,1) else pres=pres_1(1) !added in June 2012 for Moondyne Pressure Depletion Case end if end if c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) !--------------------------------------------------------------------------------------------- !2) Initialization of total resistance for each layer !--------------------------------------------------------------------------------------------- !Call calc_Rl_vert ! Calculating vertical resistance for flow into unperforated layers Do layer=1,ltnum Aface(layer) = 4*lw(layer)*Lf(layer) !initialization of Aface End Do do j = 1,ltnum ! Shear rate parameters, np, kp is used to calculate Hp Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)/be*pm(j))**((1.0-np)/2.0) ! Joshis Horizontal Resistance aj = (lw(j)/2)* (0.5+Sqrt(0.25+1/(0.5*lw(j)/re)**4))**0.5 ! Joshi (8) ! Multiplied mu in Rh added on May 10 2007 Rh = mor(j)/(2*pi*kmh(j)*kro(j)*h(j))*Log((aj+Sqrt(aj**2-(lw(j)/2)**2))/(lw(j)/2)) ! Joshi (1,2) ! Joshis vertical resistance, divided in 2 parts delta=h(j)/2*ecc(j) ! Multiplied mu in Rout added on May 10 2007 Rout = mor(j)/(2*pi*kmh(j)*kro(j)*lw(j))*be*Log(((be*h(j)/(be+1))**2+be**2*delta**2)/(be*h(j)*(lf(j)/2)/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. ! Added initial skin resistance on Dec 03 2007 Rskin(j) = mor(j)/(2*pi*kmh(j)*lw(j))*be*skin_ini RL0(j)=Rh+Rout+Rskin(j) Rl(j) = rl0(j) delp1(j)=q0*(Rh+Rout) delp2(j)=0 delp3(j)=0 delp4(j)=0 delps_ini(j)=q0*Rskin(j) end do do j=1,ltnum RL0tot = RL0tot + 1/RL0(j) end do RL0tot=1/RL0tot Rtot=rl0tot do i = 1, ltnum Write(177+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377,delptrans(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 !Write(177+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 end do !--------------------------------------------------------------------------------------------- ! Initializing the flow rate distribution for each layer ! The sum of flow rate into each layer is equal to the total flow rate !--------------------------------------------------------------------------------------------- if (ck_dipping == 1) then q=2*q0 else q=q0 endif excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr_ini(layer)/rl0(layer) end do !Estimate of the initial flow rate in each layer. Do layer=1,ltnum ql(layer) = Rl0tot/RL0(layer)*(q+excess_q-excess_res_pr_ini(layer)/Rl0tot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) ql(layer) = q*RL0tot/RL0(layer) qlhist(layer,counter)=ql(layer) vda(layer,:)=ql(layer)/Aface(layer) End Do !--------------------------------------------------------------------------------------------- initial_dp=RL0(1)*ql(1) Write(129,110) 0, (Pres+initial_dp)*0.0001450377 ! writing bottom hole pressure in psi at t=0 !----------------------------------------------------------------------------------------------- ! 4) Initialize Filtration coefficient and sigma for internal filtration around the horizontal well !----------------------------------------------------------------------------------------------- Do layer=1,ltnum Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) If (fcae(layer)) Then ! 1 means auto evaluate i.e. calculate filtration coeff using program do i=1,Ns mu=Hp*vda(layer,i)**(np-1) if (vda(layer,i)>0) then lambda0(layer,i) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,i),pm(layer)) else lambda0(layer,i) = 0 end if if ( (lambda0(layer,i)==0) .AND. (vda(layer,i)>0) )then !velocity > critical velocity lambda0(layer,i)=0.1 end if if ( (c0_oil>0) .and. (vda(layer,i)>0) ) then lambda0_oil(layer,i)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,i),pm(layer)) if (lambda0_oil(layer,i)==0) then !if velocity > critical velocity lambda0_oil(layer,i)=0.1 end if else lambda0_oil(layer,i) = 0 endif end do Else lambda0(layer,:) = fc(layer) ! Determined by user !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda0_oil(layer,:) = fco(layer) ! Determined by user !endif End If End Do lambda(:,:) = lambda0(:,:) ! The filtration coeff = Initial filtration coeff !------------------------------------------------------------------------------------- ! Calculating the length of damage based on the initial filtration coefficient !------------------------------------------------------------------------------------- L = 0.01 ! 1 cm same as 0.01 m is the minimum length of damage as the default value do i = 1, ltnum ! ltnum = 1 if (log(10000.0)/lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = log(10000.0)/lambda(i,1) end if end do if (rf < L+rw) then rf = L+rw !rf is updated if the user specified depth of damage is less than needed endif !------------------------------------------------------------------------------------- Call Inittt ! Initialize the check for transition time dx = L/Ns ! Slice of the damaged core perpendicular to the fracture face, m !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(:,:) = lambda0_oil(:,:) !endif sigma(:,:) = Dble(0.0) ! The specific deposit = 0 lambda00(:) = lambda0(:,1) ! This value is written out as the lambda of the layer lambda00_oil(:) = lambda0_oil(:,1) ! This value is written out as the lambda of the layer Do layer=1,ltnum Do i=1,Ns if ((lambda0(layer,i)>10000) .or. (lambda0_oil(layer,i)>10000)) then tt(layer)=0 Afacett=Aface(layer) Rint_tt(layer)=RL0tot endif End Do End Do If (out_pp==1) Then Do j=1,ltnum k(j,:)=kmh(j) Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md End Do endif Write(21,*) sum_lambda(:,:)=0 !May 2013 sum_lambda_oil(:,:)=0 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! Time loop Begins ! Injection of water into the layers start !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !tt1 = 3600 ! The first time step is fixed and equal to 1 hour tt1 = dt ! The first time step is equal to the time step if (dt>dt_max) then dt = dt_max ! The largest time step allowed is 1 day, i.e. 86400 seconds endif !bhpconverge =1 Do t=tt1,t_max*86400,dt !PGF frac calculations time loop begins !if (t/86400>908) then ! Write(*,*) 'Time is = ',t/86400 !endif !--------------------------------------------------------------------- ! Setting the injection stage according to the current injection time !--------------------------------------------------------------------- 108 do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400) Then present_stage=i endif enddo !Injection parameter based on the present injection stage q0=flow_rate(present_stage) if (ck_dipping==1) then q=2*q0 flow_rate(present_stage)=2*flow_rate(present_stage) else q=q0 endif c0=p_conc(present_stage) c0hist(counter)=c0 c0_oil=conc_oil(present_stage) c0_oilhist(counter)=c0_oil coal_fr=coal(present_stage) coal_frhist(counter)=coal_fr dp=p_dia(present_stage) doil=oil_dia(present_stage) kc=cake_perm(present_stage) pc=cake_por(present_stage) rhop=den_p(present_stage) rhol=den_f(present_stage) rhooil=den_oil(present_stage) kp=kp_in(present_stage) np=np_in(present_stage) kpt=kpt_in(present_stage) npt=npt_in(present_stage) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif ! The code below should be active only when reading the injection rates from an input file June 2012 if (hist_inj_rates == 1) then q0=q1(counter) ! Note the first time step t=tt1, the counter is 1 and the rate is the same as before (just a repeat) if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else pres=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if end if if (ck_dipping==1) then q0=2*q0 else q0=q0 end if q=q0 end if ! The above code should be active only when reading the injection rates from an input file !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Code included on Jan 25 2012 for Chevron Tahiti project if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then res_pr(1)=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else res_pr(1)=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,counter) !for Chevron Tahiti Project 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr(i) end do else do i = 1,ltnum excess_res_pr(i)=excess_res_pr_ini(i) end do end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Changing the layer flow rate according to the new flow rate if (q/=qold) then trans(:)=1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0.1 bpd in case there is crossflow (from reservoir to the well) qlhist(layer,counter)=ql(layer) vda(layer,:)=ql(layer)/Aface(layer) End Do end if !------------------------------------------------------------------------------------------------------- ! Recalculating the Filtration coefficient May 2013 !------------------------------------------------------------------------------------------------------- Do layer=1,ltnum dummy=0 !dummy used instead of ql as av_q_tot is used for calculating vda for lambda since it can 0 or negative at a given time step. if (perf_ck(layer)==1) then If (fcae(layer)) Then ! 1 means auto evaluate i.e. calculate filtration coeff using program !dummy = Rtot/Rl(layer)*av_q_tot dummy = Rtot/Rl(layer)*q Aface(layer) = 4*tst(layer)*Lf(layer) !Recalculating the fracture face area vda(layer,:)=dummy/Aface(layer) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vda(layer,1)**(np-1) !Note for polymer vda would decrease with increase in lf, and so mu will increase and so lambda will?? if (vda(layer,1)>0) then lambda(layer,:) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,1),pm(layer)) if (lambda(layer,1) == 0 ) then lambda(layer,:) = 0.1 ! April 2013 end if !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(layer,:)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,1),pm(layer)) if (lambda_oil(layer,1) == 0 ) then lambda_oil(layer,:) = 0.1 ! April 2013 end if !endif else lambda(layer,:) = 0 ! May 2013 lambda_oil(layer,:) = 0 ! May 2013 end if Else lambda(layer,:) = fc(layer) ! Determined by user !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(layer,:) = fco(layer) ! Determined by user !endif End If endif End Do do layer = 1, ltnum sum_lambda(layer,1)=sum_lambda(layer,1)+lambda(layer,1) sum_lambda_oil(layer,1)=sum_lambda_oil(layer,1)+lambda_oil(layer,1) end do do layer = 1, ltnum avg_lambda(layer,:)=sum_lambda(layer,1)/counter avg_lambda_oil(layer,:)=sum_lambda_oil(layer,1)/counter end do lambdahist(:,counter)=lambda(:,1) lambda_oilhist(:,counter)=lambda_oil(:,1) L = 0.01 ! 1 cm is the minimum length of damage do i = 1, ltnum if (perf_ck(i)==1 .AND. avg_lambda(i,1) /= 0) then if (log(10000.0)/avg_lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = log(10000.0)/avg_lambda(i,1) end if end if end do if (L>100) then !Max L is 100 meters modified on april 2012 L = 100 endif if (rf > L) then !L is overwritten by the User specified depth of damage (if it is more than L) L = rf endif write(99,*) "vda(:,1)", vda(:,1) write(99,*) "lambda(:,1)", lambda(:,1) write(99,*) "avg_lambda(:,1)",avg_lambda(:,1) write(99,*) "L",L write(99,*) !----------------------------------------------------------------------------------------- ! Calculating fracture length in each layer ! The fracture length depends on the tip pressure which should be less than ! the fracturing pressure. The fracturing pressure is determined by the minimum ! horizontal stress and one another term as given by equation (3.29) in UTWID user manual. !----------------------------------------------------------------------------------------- Do layer=1,ltnum if (t==tt1) then Wi(layer)=Wi(layer)+ql(layer)*tt1 ! Cumulative rate*dt in a layer cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*tt1*c0 ! Cum vol of solids injected in a layer cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)! Cum vol of oil injected in a layer cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected in a layer cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1)! Cum vol of oil injected in a layer else Wi(layer)=Wi(layer)+ql(layer)*dt ! Cumulative rate*dt in a layer cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*dt*c0 ! Cum vol of solids injected in a layer cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*dt*c0_oil*(1-coal_fr) ! Cum vol of oil injected in a layer cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected in a layer cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1)! Cum vol of oil injected in a layer end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*(ql(layer)/Aface(layer))**(np-1) Call PGFellipse2(wt,realct,perf_ck(layer),skin_ini,np,kp,npt,kpt,be,lw(layer),ecc(layer),layer,ltnum,dip(layer),& frac_grad(layer),stress_change_pore_pressure(layer),& Wi(layer),Cum_parr(layer),Cum_oill(layer),Cum_parr_lambda(layer),Cum_oill_lambda(layer),Ns,dx,avg_lambda(layer,:),& avg_lambda_oil(layer,:),lambdahist(layer,:),lambda_oilhist(layer,:),pm(layer),pcr(layer),ql(layer),& qlhist(layer,:),dt,counter,trans(layer),c0,c0hist,c0_oil,c0_oilhist,coal_fr,coal_frhist,dg(layer),dp,doil,kmh(layer),& df(layer),t,pc,kc,U,n(layer),Y(layer),Tw(layer),Tr(layer),& Swi(layer),Sor(layer),rhol,rhoo(layer),rhog(layer),Chw(layer),Cho(layer),Chg(layer),B(layer),ds,rp,re,rw,h(layer),& pres_ini+excess_res_pr_ini(layer),pres+excess_res_pr(layer),kro(layer),krw(layer),mor(layer),mwi(layer),mu,sigmamin(layer),& ck_dipping,cgr(layer),ctot(layer),lfrw(layer),avgwfp(layer),& fp_por(layer),lfold(layer),lfhist(layer,:),fracture_closure,& ! Up to here all are input variables lf(layer),cum_parr_lf(layer),cum_oill_lf(layer),maj_axis_w(layer),min_axis_w(layer),maj_axis_p(layer),& min_axis_p(layer),maj_axis_t(layer),& min_axis_t(layer),maj_axis_D(layer),min_axis_D(layer),dst(layer),dsp(layer),Sminh(layer),Ptip(layer),& Pfrac(layer),Piwf(layer),delp1(layer),delp2(layer),delp3(layer),delp4(layer),delptrans(layer),delpint(layer),& delpcc(layer),& delpud(layer),delps_ini(layer),delpf(layer),wf(layer),delpp(layer),res1(layer),res2(layer),res3(layer),res4(layer),& rint(layer),rcc(layer),rud(layer),rskin(layer),resf(layer),resp(layer),tt(layer),hc(layer),k(layer,:)) if (ck_dipping==1) then !Aface(layer) = 2*lw*lf(layer) ! Area of fracture face with dip Aface(layer) = 4*lw(layer)*lf(layer) ! Area of fracture face with dip Else Aface(layer) = 4*lw(layer)*lf(layer) ! Area of fracture face with no dip Endif End Do ! End of layer loop Lfold=lf !setting the old fracture length to the current fracture length !------------------------------------------------------------------------------------------------- ! New resistivities calculated based on the new fracture lengths, fronts and cakes !------------------------------------------------------------------------------------------------- Rtot=0 Do layer=1,ltnum Rl(layer)=Res1(layer)+Res2(layer)+Res3(layer)+Res4(layer)+Rint(layer)+Rcc(layer)+Rskin(layer)+Resf(layer)+Resp(layer)!+Rl_vert(layer) commented out Rl_vert Ajay Oct 2013 Rtot=Rtot+1/Rl(layer) End Do Rtot=1/Rtot !------------------------------------------------------------------------------------------------------------------- ! New flow rates in the layers are calculated based on the new fracture length and new resistance in the layer ! for this time step !--------------------------------------------------------------------------------------------------------------------- counter=counter+1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = q*Rtot/Rl(layer) ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) qlhist(layer,counter)=ql(layer) ! Storing the current flow rate going into the fracture June 2012 vda(layer,:) = ql(layer)/Aface(layer) lfhist(layer,counter)=lf(layer) ! Storing the current frac length End Do !----------------------------------------------------------------------------------------------- ! Calculate the bottom hole pressure at the end of this time step with the new value of flow rate in each layer. Do layer=1,ltnum Piwf(layer)=(pres+excess_res_pr(layer))+Rl(layer)*ql(layer) end do !----------------------------------------------------------------------------------------------- Piwfdd=0 sumofBHPaveraginglayers = 0 Do layer=1,ltnum if (perf_ck(layer) == 1) then sumofBHPaveraginglayers = sumofBHPaveraginglayers + 1 Piwfdd=piwf(layer)+Piwfdd end if End Do Piwfdd=Piwfdd/sumofBHPaveraginglayers !calculating the average injection pressure in the layers !Calculate the bottom hole pressure in each layer with the new value of flow rate in each layer. !Do layer=1,ltnum !Piwfcheck(layer)=pres+Rl(layer)*ql(layer)*mu !end do ! Updated by Ajay on Dec 14'07 realdp=Piwf(1)-(pres+excess_res_pr(1)) if (ql(1)==0) then skin=0 else skin=(realdp-initial_dp)*(2*pi*kmh(1)*be*kro(1)*lw(1))/(ql(1)*mor(1)) + skin_ini endif !calculate average skin for the well with all layers. dummy=0 do i = 1,ltnum !if (ql(i) /= 0) then !dummy = dummy + 1/(kmh(i)*kro(i)*h(i)/ql(i)/mor(i)) dummy = dummy + 1/(kmh(i)*kro(i)*lw(i)/mor(i)) !end if end do skin = (realdp-idealdp)/dummy/q + skin_ini !----------------------------------------------------------------------------------------------- !Injectivity Calculations !----------------------------------------------------------------------------------------------- IF (t==3600) then injectivity_1_hour=q0/(piwfdd-pres)*6.289810*86400/.0001450377 ELSEIF (t==3600+86400) then injectivity_1_day=q0/(piwfdd-pres)*6.289810*86400/.0001450377 ENDIF alphfrc = initial_dp*flow_rate(present_stage)/flow_rate(1)/(piwfdd-pres) ! Injectivity ratio calculation !alphfrc = flow_rate(present_stage)/(piwfdd-pres) ! Actual Injectivity !----------------------------------------------------------------------------------------------- !Writing to The Output Files !----------------------------------------------------------------------------------------------- 100 FORMAT (1000E13.5) 110 FORMAT (1000F14.4) !Writing delp in the layers with time do i = 1, ltnum Write(177+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377,delptrans(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 end do !Writing layer no, transition time, filtration coefficient and specific deposit do i = 1, ltnum Write(39+i,110) t/86400,tt(i)/86400,lambda(i,1) end do !open (Unit=172, NAME="Res_initial.tmp", Action='Write') !Write(172,100) t/86400, Rl0 !open (Unit=173, NAME="Res_layer.tmp", Action='Write') !Write(173,100) t/86400, Rl !open (Unit=174, NAME="Res_int_cake.tmp", Action='Write') !Write(174,100) t/86400, Rint !open (Unit=175, NAME="Res_ext_cake.tmp", Action='Write') !Write(175,100) t/86400, Rcc !open (Unit=176, NAME="Res_UDF.tmp", Action='Write') !Write(176,100) t/86400, Rud !open (Unit=177, NAME="Res_vertical.tmp", Action='Write') !Write(177,100) t/86400, Rl_vert Write (871,110) t/86400,maj_axis_t*3.28 !writing the major axes of the thermal fronts in ft Write (872,110) t/86400,min_axis_t*3.28 !writing the minor axes of the thermal fronts in ft Write (9,110) t/86400, maj_axis_w*3.28 !writing the major axes of the waterflood fronts in ft Write (10,110) t/86400, min_axis_w*3.28 !writing the minor axes of the waterflood fronts in ft Write(17,110) t/86400, flow_rate(present_stage)*543439.6331/((piwfdd-pres)/6894.76) !alphfrc ! writing injectivity ratio Write(129,110) t/86400, Piwfdd*0.0001450377 !writing bottom hole pressure in psi Write (16,110) t/86400, Pfrac*0.0001450377 ! writing current min horizontal stress (psi) Write (18,110) t/86400, Ptip*0.0001450377 ! writing pressure at the fracture tip (psi) If (out_pp==1) Then Do j=1,ltnum Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md End Do endif Write(21,*) !do j=1,ltnum ! kavg(j)=0 ! ksum=0 ! do i = 1,Ns ! ksum=ksum+L/Ns/k(j,i) ! end do ! kavg(j)=L/ksum !end do !open (Unit=192, NAME="kdamage_for_GEM.tmp", Action='Write') !Write(192,110) t/86400, kavg(:)*1e15 ! writing avg damage zone perm in md !open (Unit=193, NAME="Ldamage_for_GEM.tmp", Action='Write') !Write(193,110) t/86400, L*1000.0 ! writing damage zone depth in mm !open (Unit=194, NAME="kcake_for_GEM.tmp", Action='Write') !Write(194,110) t/86400, kc ! writing cake perm in md !open (Unit=195, NAME="Lcake_for_GEM.tmp", Action='Write') !Write(195,110) t/86400, hc*1000.0 ! writing external cake thickess in mm Write(8,110) t/86400, skin ! writing skin Write(11,110) t/86400, lf*3.28 ! time in days and fracture length in ft Write(197,110) t/86400, ql*543439.6331 ! writing flow rate in each layer (bpd) if (q==0) then ! injection rate = 0 Write(198,110) t/86400, 1 ! writing fraction of total flow rate in each layer else Write(198,110) t/86400, ql/q ! writing fraction of total flow rate in each layer endif Write(199,110) t/86400, piwf*0.0001450377 ! writing layer bottom hole pressure in psi Write(200,110) t/86400, cum_parr ! Cumulative particles injected Write(201,110) t/86400, hc*1000 ! writing external cake thickess in mm Write(293,110) t/86400, wf*1000.0 ! writing maximum width of the fracture in mm ! if (Bhpconverge <=0) then ! Bhpconverge = Bhpconverge + 1 ! goto 108 ! end if ! Bhpconverge = 1 fileopencounter = 1 End Do !end of frac calculations time loop !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Time loop Ends !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ End Subroutine calc_H_longitudinal_frac !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! End of Subroutine !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@!---------------------------------------------------------------------------------------------------------------- ! calc_H_transverse_frac Added on January 10 2008 for transverse fracture growth in horizontal injectors ! Main global variables calculated: ! lf(:) Fracture length in each layer ! ql(:) Flow rate in each layer !---------------------------------------------------------------------------------------------------------------- Subroutine calc_H_transverse_frac() real(8), External :: PermDecl External pgfellipse2 character(240) :: layer_names, dummy_name real(8) :: & skin, & ! skin rwp, & ! equivalent radius of damaged well in frac inj calculations alphfrc, & ! injectivity of a plugged fracture Piwfdd,& idealdp ! ideal dp (with out skin or fracture from darcy law) Integer :: i,j,points_counter = 0, bhpconverge = 0,counter = 1 ! Counters Integer :: layer, present_stage, perf_zone, layers, sumofBHPaveraginglayers,fileopencounter real(8):: dummy,v,app_vis,initial_dp !initial deltaP taking into account initial skin in frac case real(8):: pi=3.14159 real(8):: initial_injectivity, injectivity_1_hour, injectivity_1_day !injectivites real(8):: sig_kh real(8):: tt1, tt2 real(8):: dumpar1,dumpar2,dumpar3,dumpar4,dumpar5,dumpar6,dumpar7,dumpar8,dumpar9,dumpar10,dumpar11,dumpar12 real(8):: piwfleast, realdp, kavg(ltnum),ksum,acool,bcool,Vcool,Vcw,Vinj real(8)::idealdp_Uf,idealdp_f,IR !Uf = unfractured, f = fractured, Ji = Injectivity ratio of fractured well with ideal well real(8)::dh(ltnum) !difference in depth between the top layer and the respective layer real(8)::excess_res_pr(ltnum) !excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_res_pr_ini(ltnum) !initial excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_q !excess q (flow rate) from the over-pressured layers real(8)::avg_pres real(8)::dummy1, dummy2 real(8)::sum_excess_res_pr ! Variables added for horizontal well real(8):: dr,& ! geometric ratio of the damage segments around the horizontal well Rh,& ! horizontal well horizontal resistance (far away elliptical flow resistance) Rout,& ! Outer resistance Rout1,& ! Outer resistance (from rf to rad_inj) Rout2,& ! Outer resistance (from rad_inj to h/2) Rc,& ! Cake resistance rck,& ! internal radius of the well with the cake aj,& ! Ellipsoid major axis delta,& ! distance between the horizontal well axis and the middle of the payzone. aw_inj(ltnum),& ! major axis of polymer front along horizontal well. aw_conw(ltnum),& ! major axis of the displaced connate water front along horizontal well. aw_cool(ltnum),& ! major axis of the cooled injected fluid (polymer/water) front along the horizontal well. bw_inj(ltnum),& ! minor axis of polymer front perpendicular to horizontal well. bw_conw(ltnum),& ! minor axis of the displaced connate water front perpendicular to the horizontal well. bw_cool(ltnum),& ! minor axis of the cooled injected fluid (polymer/water) front perpendicular to the horizontal well. rad_inj(ltnum),& ! radius of polymer injected zone around the horizontal well rad_conw(ltnum),& ! radius of displaced connate water front around the horizontal well rad_cool(ltnum),& ! radius of cooled injected fluid (polymer/water) front around the horizontal well RL0_f(ltnum),& ! horizontal well initial total resistance RL0_w(ltnum),& ! horizontal well initial total resistance Rwtot(ltnum),& ! horizontal well total resistance Rwh1(ltnum),& ! horizontal well horizonal resistance Rwh2(ltnum),& ! horizontal well horizonal resistance Rwh3(ltnum),& ! horizontal well horizonal resistance Rwh4(ltnum),& ! horizontal well horizonal resistance Rwh(ltnum),& ! horizontal well horizonal resistance Rwr1(ltnum),& ! horizontal well radial resistance Rwr2(ltnum),& ! horizontal well radial resistance Rwr3(ltnum),& ! horizontal well radial resistance Rwr4(ltnum),& ! horizontal well radial resistance Rwr(ltnum),& ! horizontal well radial resistance Rint_w(ltnum),& ! horizontal well near well bore damage resistance Rcc_w(ltnum),& ! horizontal well cake resistance Resp_w(ltnum),& ! horizontal well perforations resistance RwD(ltnum),& ! horizontal well total damage resistance RLtot(ltnum),& ! Total flow resistance for a layer qLtot(ltnum),& ! Total flow rate into a layer !Horizontal Well Variables (Note the variables for flow into the transverse fracture are mostly global variables with same name & ext. _w. Aface_w(ltnum),& res1_w(ltnum),& res2_w(ltnum),& res3_w(ltnum),& res4_w(ltnum),& delp1_w(ltnum),& delp2_w(ltnum),& delp3_w(ltnum),& delp4_w(ltnum),& delptrans_w(ltnum),& delpint_w(ltnum),& delpud_w(ltnum),& delpcc_w(ltnum),& delpp_w(ltnum),& ! perforations pressure drop in the well vp_w(ltnum),& ! velocity throught perforations in the well Wi_w(ltnum),& ! Cumulative volume of water injected in a layer at t ql_w(ltnum),& ! Water Injection rate in a layer at t cum_parr_w(ltnum),& ! Cumulative volume of solid particles (other than oil) been injected in a layer in time t cum_oill_w(ltnum),& ! Cumulative volume of oil particles been injected in a layer in time t lambda_w(ltnum,1:Ns),& ! Filtration coefficient in the near well bore around the horizontal well at any time t lambda_w_oil(ltnum,1:Ns),& ! Filtration coefficient in the near well bore around the horizontal well at any time t sigma_w(ltnum,1:Ns) ,& ! Deposited concentration of solids around the horizontal well sigma_w_oil(ltnum,1:Ns),& ! Deposited concentration of oil around the horizontal well vda_w(ltnum,1:Ns),& ! Darcy/superficial velocity in the near well bore region around the horizontal well at any time t tt_w(ltnum),& ! Transition time for completion of internal filtration in a layer hc_w(ltnum),& ! External filter cake thickness in the horizontal wellbore in a layer rck_w(ltnum),& ! Horizontal wellbore radius with an external filter cake in a layer (Note it will be less than rw) k_w(ltnum,1:Ns),& ! Permeability profile around the horizontal well in a particular layer fp_por(ltnum) ! Frac-pack porosity !Front Ellipse and thermal and pore pressure stress calculation variables real(8) :: dTemp, & ! DeltT (difference between reservoir temperature and injected water temp) dppr, & ! dp for poroelastic stress avg_res_pr_change, & ! change in average reservoir pressure TERM2A, & ! for Eqn 5A in P&G 1985 TERM2B, & ! for Eqn 5A in P&G 1985 TERM2C, & ! for Eqn 5A in P&G 1985 TERM2, & ! for Eqn 5A in P&G 1985 Ji ! Linear coef of expansion of pore pressure !------------------------------------------------------------------------------------------------------------------------------ ! The following code was added on Oct 11 2010 for adding headers to the output files ! Making a string that has layer names in it layer_names = " Time(days) " do i = 1, ltnum dummy_name=trim(lname(i)) layer_names=trim(layer_names)//" "//trim(dummy_name) end do 70 FORMAT(A110) 80 FORMAT(A95) 90 FORMAT(A246) !------------------------------------------------------------------------------------------------------------------------------ !----------------------------------------------------------------------------------------------- !Opening Output Files !----------------------------------------------------------------------------------------------- do i = 1, ltnum open (Unit=177+i, NAME="delp "//trim(lname(i))//".tmp", Action='Write') Write(177+i,70) "This file outputs the pressure drops in the various regions of the reservoir around the transverse fracture" Write(177+i,90) "Time(days) delp1(psi) delp2(psi) delp3(psi) delp4(psi) delptrans(psi) delpint(psi) delpcc(psi) delpud(psi) delps_ini(psi) delpf(psi) delpp(psi) Ptip(psi) Pfrac(psi) Sminh(psi) sigmamin(psi) dst(psi) dsp(psi)" open (Unit=197+i, NAME="delp_w "//trim(lname(i))//".tmp", Action='Write') Write(197+i,70) "This file outputs the pressure drops in the various regions of the reservoir around the horizontal well" Write(197+i,90) "Time(days) delp1(psi) delp2(psi) delp3(psi) delp4(psi) delptrans(psi) delpint(psi) delpcc(psi) delpud(psi) delps_ini(psi) delpw(psi) delpp(psi) Ptip(psi) Pfrac(psi) Sminh(psi) sigmamin(psi) dst(psi) dsp(psi)" end do !Writing layer no, transition time, filtration coefficient and specific deposit do i = 1, ltnum open(Unit=39+i, NAME="filtration "//trim(lname(i))//".tmp", ACTION = 'Write') Write(39+i,70) "This file outputs the transition time and filtration coeff. of the fracture in the layer by the file name" Write(39+i,*) "Time(days) Transition_time(days) Filtration_coefficient(1/m)" open(Unit=217+i, NAME="filtration "//trim(lname(i))//"_w.tmp", ACTION = 'Write') Write(217+i,70) "This file outputs the transition time and filtration coeff. of the well in the layer by the file name" Write(217+i,*) "Time(days) Transition_time(days) Filtration_coefficient(1/m)" end do open (unit=871, NAME="maj_axis_thermal.tmp", Action='Write') Write(871,70) "This file outputs the major axis of the Thermal Front (ft) around the transverse fracture in all the layers" Write(871,90) layer_names open (unit=260, NAME="maj_axis_thermal_w.tmp", Action='Write') Write(260,90) "This file outputs the major axis of the Thermal Front (ft) around the well in radial and along the well direction, First set is around the well direction (max is height of the layer), the next set is for all the layers along the well direction" Write(260,90) layer_names open (unit=872, NAME="min_axis_thermal.tmp", Action='Write') Write(872,70) "This file outputs the minor axis of the Thermal Front (ft) around the transverse fracture in all the layers" Write(872,90) layer_names open (unit=261, NAME="min_axis_thermal_w.tmp", Action='Write') Write(261,90) "This file outputs the minor axis of the Thermal Front (ft) around the well in radial and along the well direction, First set is around the well direction (max is height of the layer), the next set is for all the layers along the well direction" Write(261,90) layer_names open (unit=9, NAME="maj_axis_waterflood.tmp", Action='Write') Write(9,70) "This file outputs the major axis of the Water-flood front (ft) around the transverse fracture in all the layers" Write(9,90) layer_names open (unit=262, NAME="maj_axis_waterflood_w.tmp", Action='Write') Write(262,90) "This file outputs the major axis of the Water-flood front (ft) around the well in radial and along the well direction, First set is around the well direction (max is height of the layer), the next set is for all the layers along the well direction" Write(262,90) layer_names open (unit=10, NAME="min_axis_waterflood.tmp", Action='Write') Write(10,70) "This file outputs the minor axis of the Water-flood Front (ft) around the transverse frac in all the layers" Write(10,90) layer_names open (unit=263, NAME="min_axis_waterflood_w.tmp", Action='Write') Write(263,90) "This file outputs the minor axis of the Water-flood Front (ft) around the well in radial and along the well direction, First set is around the well direction (max is height of the layer), the next set is for all the layers along the well direction" Write(263,90) layer_names open (Unit=17,NAME="Well_Injectivity.tmp", Action='Write') Write(17,*) "This file outputs the injectivity of the well (bpd/psi)" Write(17,*) "Time(days) Well_Injectivity(bpd/psi)" open (Unit=129, NAME="Average_BHP.tmp", Action='Write') Write(129,80) "This file outputs the bottom hole pressure (psi) at the mid depth of the top layer" Write(129,*) "Time(days) BHP(psi)" open (unit=16, NAME="pfrac.tmp", Action='Write') Write(16,*) "This file outputs the fracture propagation pressure (psi) in all the layers" Write(16,90) layer_names open (unit=18, NAME="ptip.tmp", Action='Write') Write(18,*) "This file outputs the pressure at the tip of the fracture (psi)" Write(18,90) layer_names open (Unit=21, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles Write(21,80) "This file outputs the permeability of the reservoir perpendicular to the fracture for each segment of the damage zone (md)" Write(21,90) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" open (Unit=22, NAME="frac_perm_w.tmp", Action='Write') ! writing permeability profiles Write(22,80) "This file outputs the permeability of the reservoir around the well for each segment of the damage zone (md)" Write(22,90) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" open (Unit=8, NAME="well_skin.tmp", Action='Write') Write(8,*) "This file outputs the total skin in the injector as a function of time" Write(8,*) "Time(days) Total_well_skin(dimensionless)" open (Unit=11, NAME="frac_length.tmp", Action='Write') Write(11,*) "This file outputs the fracture length (ft) in all the layers" Write(11,90) layer_names open (Unit=286, NAME="flowrate.tmp", Action='Write') Write(286,80) "This file outputs the flow rate into the transverse fracture of each layer (bpd)" Write(286,90) layer_names open (Unit=287, NAME="flowrate_w.tmp", Action='Write') Write(287,80) "This file outputs the flow rate from the horizontal well into the matrix of each layer (bpd)" Write(287,90) layer_names open (Unit=288, NAME="fraction_flowrate.tmp", Action='Write') Write(288,*) "This file outputs the fraction of flow injected in each layer" Write(288,90) layer_names open (Unit=289, NAME="layer_bhp.tmp", Action='Write') Write(289,70) "This file outputs the BHP (psi) in each layer corrected for the depth. They should be quite same" Write(289,90) layer_names open (Unit=290, NAME="cum_particles.tmp", Action='Write') Write(290,70) "This file outputs the cumulative Solids (ft3) injected in each layer" Write(290,90) layer_names open (Unit=291, NAME="cake_thickness.tmp", Action='Write') Write(291,80) "This file outputs the thickness of the cake formed at the fracture face of each layer (mm)" Write(291,90) layer_names open (Unit=292, NAME="cake_thickness_w.tmp", Action='Write') Write(292,80) "This file outputs the thickness of the cake in the horizontal wellbore of each layer (mm)" Write(292,90) layer_names open (Unit=293, NAME="wfmax.tmp", Action='Write') Write(293,*) "This file outputs the maximum width of the fracture in all the layers(mm)" Write(293,90) layer_names open (Unit=294, NAME="well_radius.tmp", Action='Write') Write(294,*) "This file outputs the open well radius (mm) after substracting the cake" Write(294,90) layer_names !--------------------------------------------------------------------------------------------- !Reading shear thinning polymer parameters n and k at injection temp and reservoir temp !--------------------------------------------------------------------------------------------- !OPEN(Unit=41, NAME="polymer_k&n.tmp", ACTION = 'Read') !Read(41,*) dummy, np,kp !dummy reads the temperature & then reading n and k for polymer at inj temperature !Read(41,*) dummy, npt,kpt !reading n and k for polymer solution at reservoir temperature !Close(41) kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif !--------------------------------------------------------------------------------------------- !Outputting apparent viscosity of the injected polymer as a function of r from the well up to re !--------------------------------------------------------------------------------------------- ! OPEN(Unit=42, NAME="app_vis.tmp", ACTION = 'Write') ! Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(1)*krw(1)*pm(1)*(1-sor(1)))**((1.0-np)/2.0) ! do i=0,100 ! v=flow_rate(1)/2/pi/(rw+i*h(1)/2/100)/lw(1) ! app_vis=Hp*v**(np-1) ! Write(42,*) (rw+i*h/2/100)*3.28, app_vis*1000 ! end do ! close(42) be = Sqrt(kmh(1)/kmv(1)) ! Anisotropy factor !------------------------------------------------------------------------------------------------------------------------------ !Read injection rates and/or average reservoir pressure from a .tmp file av_q_tot=0 if (hist_inj_rates == 1) then !Reading Bigfoot-SW23 injection rates OPEN(Unit=63, NAME="historical_q.txt", ACTION = 'Read') Read(63,*, end = 600) dummy_name Read(63,*, end = 600) dummy_name do i = 1, int(t_max/dtday) if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then Read(63,*, end = 600) dummy_time, q1(i), pres_multiple(:,i) !reading rate in bpd and reservoir pr. in psi pres_multiple(:,i)=pres_multiple(:,i)*6894.76 !converts from psi to pascals for SI else Read(63,*, end = 600) dummy_time, q1(i), pres_1(i) !reading rate in bpd and reservoir pr. in psi pres_1(i)=pres_1(i)*6894.76 !converts from psi to pascals for SI end if else Read(63,*, end = 600) dummy_time, q1(i) !reading in bpd end if q1(i) = max(0.0, q1(i)/543439.6331) !converts from bpd in m3/s for SI with min. rate of 0 bpd av_q_tot=av_q_tot+q1(i) end do 600 Close(63) av_q_tot=av_q_tot/int(t_max/dtday) else do i=1,nstage av_q_tot=av_q_tot+flow_rate(i) end do av_q_tot=av_q_tot/nstage endif do i = 1,ltnum dh(i)=((topl(i)+bottoml(i))/2-(topl(1)+bottoml(1))/2) end do if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then pres_ini = pres_multiple(1,1) pres = pres_multiple(1,1) res_pr(1)=pres_multiple(1,1) else pres_ini = pres_1(1) pres = pres_1(1) res_pr(1)=pres_1(1) end if do i = 2,ltnum if (pres_multiple_flag==1) then !introduced flag on April 2013 res_pr(i)=pres_multiple(i,1) !Added in Jan 27 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do else pres_ini = res_pr(1) ! when reservoir pressure is provided in the GUI pres = res_pr(1) end if write(99,*) write(99,*) 'Reservoir pressure in top layer at time 0 =', pres_ini/6894.76, 'psi' write(99,*) sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr_ini(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr_ini(i) end do !------------------------------------------------------------------------------------------------------------------------------ !--------------------------------------------------------------------------------------------- ! Initialization of total resistivity, deposition, cumulative water, particle, & oil injection ! External filter cake thickness = 0, initial fracture length guess. !--------------------------------------------------------------------------------------------- fileopencounter=0 ! 0 means output files are not open, 1 means the files are already open, so need not open again. dnpv = 1 ! Calculating the apparent wellbore radius in case of perforated completion If (realct==3) Then ! Perforated rw = rp*lp*ds End If !The wellbore acts radially for the horizontal well with radius rw !The wellbore develops a transverse fracture in the center with length lfrw and height h when Pw >= Pfrac if (ck_eqfp==0) then Lfrw=2*rw !Equivalent fracture for the wellbore fp_por=1 avgwfp=0 else Lfrw=Lfp fp_por=fpp end if trans(:)=1 Lf=lfrw !Initialization of Lf lfold=lfrw lfhist(:,counter)=lfold Wi(:)=0 !Cumulative water injected in each layer rck_w(:) = rw tt_w(:) = -1 hc(:)=0 !External filter cake thickness in each layer Rcc(:)=0 !External filter cake resistivity Cum_parr=0 !Cumulative volume of particles injected in each layer, units m3 Cum_oill=0 !Cumulative volume of oil injected in each layer, units m3 Cum_parr_lambda=0 !Cumulative of lambda times volume of particles injected in each layer, units m3 Cum_oill_lambda=0 !Cumulative of lambda times volume of oil injected in each layer, units m3 Cum_parr_w=0 !Cumulative volume of particles injected in each layer, units m3 Cum_oill_w=0 !Cumulative volume of oil injected in each layer, units m3 sigmamin1=sigmamin !Initializing the minimum horizontal stress for all layers dst(:)=0 !Initial stress change because of temperature difference dsp(:)=0 !Initial stress change because of pore pressure change aw_cool(:)=lw(:)/2 bw_cool(:)=0 rad_cool(:) =rw aw_inj(:)=lw(:)/2 bw_inj(:)=0 rad_inj(:) =rw aw_conw(:)=lw(:)/2 bw_conw(:)=0 rad_conw(:) =rw !------------------------------------------------------------------------------------- !Setting variables for the first stage of injection !------------------------------------------------------------------------------------- q0=flow_rate(1) !if reading the injection rates and or res pr. from a file if (hist_inj_rates==1) then q0=q1(1) !added in June 2012 for Moondyne Pressure Depletion Case end if if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,1) else pres=pres_1(1) !added in June 2012 for Moondyne Pressure Depletion Case end if end if c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) !------------------------------------------------------------------------------------------------------------------------- !2) Initialization of total horizontal well resistance for each layer, RL0_w=Rwh0+Rwr0+Rskin, Initial RwD=Rint_w+Rcc_w=0 !------------------------------------------------------------------------------------------------------------------------- do j = 1,ltnum ! Joshis Horizontal Resistance aj = (lw(j)/2)* (0.5+Sqrt(0.25+1/(0.5*lw(j)/re)**4))**0.5 ! Joshi (8) Rwh1(j) = mor(j)/(2*pi*kmh(j)*kro(j)*h(j))*Log((aj+Sqrt(aj**2-(lw(j)/2)**2))/(lw(j)/2)) ! Joshi (1,2) ! Joshis vertical resistance, divided in 2 parts delta=h(j)/2*ecc(j) Rwr1(j) = mor(j)*be/(2*pi*kmh(j)*kro(j)*lw(j))*Log(((be*h(j)/(be+1))**2+be**2*delta**2)/(be*h(j)*(lf(j)/2)/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. ! Added initial skin resistance on Dec 03 2007 Rskin(j) = mor(j)*be*skin_ini/(2*pi*kmh(j)*kro(j)*lw(j)) RL0_w(j)=Rwh1(j)+Rwr1(j)+Rskin(j) end do !------------------------------------------------------------------------------------------------------------------- !2) Initialization of total transverse fracture resistance for each layer, Rf0=Rfi+Rfh; Initial RfD=Rfd+Rfc=0 !------------------------------------------------------------------------------------------------------------------- Do layer=1,ltnum Aface(layer) = 4*h(layer)*Lf(layer) !initialization of Aface End Do do j = 1,ltnum ! Rfi, Flow resistance within the fracture Resf(j) = 0 !Needs to be updated ! delpf=(16/3/pi*(2*np+1)**np*(np+1)*abs(ql)**np*kp*lf*Y**(2*np+1)/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/h**(3*np+1))**(1/(2*np+2)) ! Flow resistance from the assumed transverse fracture up to the drainage boundary Res1(j) = mor(j)/(2*pi*kmh(j)*kro(j)*h(j))*log(2*re/lf(j)) ! Added initial skin resistance on Dec 03 2007 RL0_f(j)=Resf(j)+Res1(j) end do !----------------------------------------------------------------------------------------------------- RL0tot=0 ! Initial total resistance of the reservoir (all the layers) do j=1,ltnum RL0(j)=1/RL0_w(j)+1/RL0_f(j) ! Initial total resistance of a layer RL0(j)=1/RL0(j) RL0tot = RL0tot + 1/RL0(j) end do RL0tot=1/RL0tot !Initializing the resistances that are used in the first time step Rtot = RL0tot !total flow resistance RLtot(:) = RL0(:) !total layer flow resistance RL(:) = RL0_f(:) !total layer well flow resistance Rwtot(:) = RL0_w(:) !total layer fracture flow resistance !----------------------------------------------------------------------------------------------------- if (ck_dipping == 1) then q0=2*q0 else q0=q0 endif q=q0 !----------------------------------------------------------------------------------------------------- ! Initializing the flow rate distribution for each layer based on its total initial flow resistance excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr_ini(layer)/rl0(layer) end do !Estimate of the initial flow rate in each layer. Do layer=1,ltnum qltot(layer) = Rl0tot/RL0(layer)*(q0+excess_q-excess_res_pr_ini(layer)/Rl0tot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC qltot(layer) = max(0.0, qltot(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) qltot(layer) = q0*RL0tot/RL0(layer) End Do !Calculating the initial flow distribution between the horizontal well and the transverse fracture Do layer=1,ltnum ql_w(layer) = qltot(layer)*RL0(layer)/RL0_w(layer) Aface_w(layer)=2*pi*rw*lw(layer) vda_w(layer,1)=ql_w(layer)/Aface_w(layer) ql(layer)=qltot(layer)*RL0(layer)/RL0_f(layer) qlhist(layer,counter)=ql(layer) vda(layer,:)=ql(layer)/Aface(layer) End Do !------------------------------------------------------------------------------------------------------------------- ! Calculating initial pressure drop in the different zones for the horizontal well and the transverse fracture !------------------------------------------------------------------------------------------------------------------- do j = 1,ltnum !Horizontal well delp1_w(j)=ql_w(j)*(Rwh1(j)+Rwr1(j)) delp2_w(j)=0 delp3_w(j)=0 delp4_w(j)=0 delptrans_w(j)=0 delps_ini(j)=ql_w(j)*Rskin(j) !Transverse fracture delp1(j)=ql(j)*Res1(j) delp2(j)=0 delp3(j)=0 delp4(j)=0 delpf(j)=0 !Needs to be updated !Common !Velocity thru perforations vp is relevant ony for the perforated well If (ds>0) Then !Perforation shot density vp = ql(j)/((pi*rp*rp)*lw(j)*ds) !velocity through perforations Else vp = 0 End If delpp(j)=0.8338*(rhol*vp*vp) ! pressure drop in the perforations around the horizontal well Resp(j)=delpp(j)/ql_w(j) end do initial_dp=RL0_w(1)*ql_w(1) piwf(1)=(Pres+initial_dp)*0.0001450377 Write(129,110) 0, piwf(1) ! writing bottom hole pressure in psi at t=0 !---------------------------------------------------------------------------------------------------------- ! Calculating the updated minimum horizontal stress due to thermal and pore pressure stress !---------------------------------------------------------------------------------------------------------- !calculation of TERM2 in eqn. (3) P&G 1985 acool=rw bcool=rw Do layer=1,ltnum TERM2A = (bcool/acool)/(1+(bcool/acool)) TERM2B = 1/(1+(bcool/acool)) TERM2C = 1+0.5*(1.45*(h(layer)/(2*bcool))**0.9 + 0.35*(h(layer)/(2*bcool))**2)*(1+(bcool/acool)**0.774) TERM2 = (1/(1-n(layer)))*(TERM2A + TERM2B/TERM2C) dppr = (delp1_w(layer)+delp2_w(layer)+delp3_w(layer)+delp4_w(layer)) Ji = ((1-2*n(layer))/Y(layer))-Cgr(layer)/3 dsp(layer) = Y(layer)*Ji*dppr*TERM2 ! Pore pressure change due to injection the presence of fracture dTemp = Tw(layer)-Tr(layer) ! is independent of time but is a layer property: hence dTemp should be an array if needed dst(layer) = Y(layer)*B(layer)*dTemp*TERM2 ! Thermal stress change due to injection in the presence of fracture Sminh(layer) = Sigmamin(layer) + dst(layer) + dsp(layer) ! Current min horizontal stress end do Pfrac(1)= (Sminh(1) + sqrt((pi*U*Y(1))/(2*(1-n(1)*n(1))*lw(1)/2)))*0.0001450377 if (piwf(1)>pfrac(1)) then Write(99,*) Write(99,*) "The BHP at t=0 > frac pres with dst and dsp correction" Write(99,*) Write(*,*) "The BHP at t=0 > frac press with dst and dsp correction" endif !----------------------------------------------------------------------------------------------- ! 4) Initialize Filtration coefficient and sigma for the horizontal wellbore at Ns=1 !----------------------------------------------------------------------------------------------- Do layer=1,ltnum If (fcae(layer)) Then ! 1 means auto evaluate i.Y. calculate filtration coeff using program !dummy = av_q_tot*RL0tot/RL0(layer) !Not using average flow rate of the entire injection time May 2013 dummy = q0*RL0tot/RL0(layer) dummy1 = dummy*RL0(layer)/RL0_w(layer) vda_w(layer,1)=dummy1/Aface_w(layer) dummy2=dummy*RL0(layer)/RL0_f(layer) qlhist(layer,counter)=dummy2 vda(layer,:)=ql(layer)/Aface(layer) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*abs(vda_w(layer,1))**(np-1) if (vda_w(layer,1)>0) then lambda_w(layer,1) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda_w(layer,1),pm(layer)) else lambda_w(layer,1) = 0 end if mu=Hp*abs(vda(layer,1))**(np-1) if (vda(layer,1)>0) then lambda(layer,:) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,1),pm(layer)) if (lambda(layer,1)==0) then !for the case of velocity > critical velocity May 2013 lambda(layer,:)=0.1 endif else lambda(layer,:) = 0 end if !commented out Ajay Oct 2013 !if (c0_oil>0) then mu=Hp*abs(vda_w(layer,1))**(np-1) if (vda_w(layer,1)>0) then lambda_w_oil(layer,1)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda_w(layer,1),pm(layer)) else lambda_w_oil(layer,1)=0 endif mu=Hp*abs(vda(layer,1))**(np-1) if (vda(layer,1)>0) then lambda_oil(layer,:)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,1),pm(layer)) if (lambda_oil(layer,1)==0) then !since this filtration coefficient is used away from fracture May 2013 lambda_oil(layer,:)=0.1 end if else lambda_oil(layer,:)=0 endif !endif Else lambda_w(layer,:) = fc(layer) ! Determined by user, not correct since filtration coefficient can not be constant around the well lambda(layer,:) = fc(layer) ! Determined by user, this may be okay May 2013 !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_w_oil(layer,:) = fco(layer) ! Determined by user lambda_oil(layer,:) = fco(layer) ! Determined by user !endif End If End Do lambda00(:)=lambda(:,1) !for writing the output in write results sub filtration.tmp file lambda00_oil(:)=lambda_oil(:,1) !for writing the output in write results sub filtration.tmp file lambda0=lambda lambda0_oil=lambda_oil !------------------------------------------------------------------------------------- lambda(:,:) = lambda0(:,:) ! The filtration coeff = Initial filtration coeff (only solid particles, excluding oil) !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(:,:) = lambda0_oil(:,:) !endif !-------------------------------------------------------------------------------------------------------------------------------------- ! Calculating the length of damage based on the initial filtration coefficient around the horizontal wellbore & the transverse fracture !-------------------------------------------------------------------------------------------------------------------------------------- L = 0.01 ! 1 cm is the minimum length of damage do i = 1, ltnum if (log(10000.0)/lambda_w(i,1) > L .OR. log(10000.0)/lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = max(log(10000.0)/lambda_w(i,1),log(10000.0)/lambda(i,1)) end if end do if (L>100) then !Max L is 100 meters L = 100 endif if (rf > L) then !L is overwritten by the User specified depth of damage (if it is more than L) L = rf endif !------------------------------------------------------------------------------------------------------ ! Creating Ns discretized segments with geometric progression radially around the horizontal well !------------------------------------------------------------------------------------------------------ Call radgrid(rw,L+rw,Ns,r,dr) ! Define radial grid around the horizontal well Do j=1,ltnum vda_w(j,:) = vda_w(j,1)*rw/r(:) ! Darcy velocity around the horizontal well End Do !------------------------------------------------------------------------------------------------------ ! Initializing lambda for the radial segments around the horizontal well and ! Initializing transition time (if internal filtration is allowed then it is equal to -1, otherwise = 0 !------------------------------------------------------------------------------------------------------ Call Inittt ! Initialize the check for transition time dx = L/Ns ! Slice of the damaged core perpendicular to the transverse fracture face, m Do layer=1,ltnum If (fcae(layer)) Then ! 1 means auto evaluate i.e. calculate filtration coeff using program do i=1,Ns mu=Hp*abs(vda_w(layer,i))**(np-1) if (vda_w(layer,i) > 0) then lambda_w(layer,i) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda_w(layer,i),pm(layer)) else lambda_w(layer,i) = 0 end if !commented out Ajay Oct 2013 !if (c0_oil>0) then if (vda_w(layer,i) > 0) then lambda_w_oil(layer,i)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda_w(layer,i),pm(layer)) else lambda_w_oil(layer,i) = 0 end if !endif end do end if End Do sigma_w(:,:) = Dble(0.0) ! The specific deposit = 0 sigma_w_oil(:,:) = Dble(0.0) ! The specific deposit = 0 !------------------------------------------------------------------------------------------------------ If (out_pp==1) Then Do j=1,ltnum k(j,:)=kmh(j) Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md End Do endif Write(21,*) !------------------------------------------------------------------------------------------------------ ! Initial delp output !------------------------------------------------------------------------------------------------------ do i = 1, ltnum Write(177+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377, delptrans(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 Write(197+i,110) t/86400, delp1_w(i)*0.0001450377, delp2_w(i)*0.0001450377, delp3_w(i)*0.0001450377, delp4_w(i)*0.0001450377, delptrans_w(i)*0.0001450377,delpint_w(i)*0.0001450377, delpcc_w(i)*0.0001450377, 0.00, delps_ini(i)*0.0001450377, 0.00, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 end do sum_lambda(:,:)=0 !May 2013 sum_lambda_oil(:,:)=0 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! Time loop Begins ! Injection of water into the layers start !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ tt1 = dt ! The first time step is equal to time step if (dt>dt_max) then dt = dt_max ! The largest time step allowed is 1 day, i.e. 86400 seconds endif !bhpconverge =1 Do t=tt1,t_max*86400,dt !PGF frac calculations time loop begins qold = q !if (t/86400>829) then ! Write(*,*) 'Time is = ',t/86400 !endif !--------------------------------------------------------------------- ! Setting the injection stage according to the current injection time !--------------------------------------------------------------------- 108 do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400) Then present_stage=i endif enddo !Injection parameter based on the present injection stage q0=flow_rate(present_stage) if (ck_dipping==1) then q=2*q0 flow_rate(present_stage)=2*flow_rate(present_stage) else q=q0 endif c0=p_conc(present_stage) c0_oil=conc_oil(present_stage) c0hist(counter)=c0 c0_oilhist(counter)=c0_oil dp=p_dia(present_stage) doil=oil_dia(present_stage) coal_fr=coal(present_stage) coal_frhist(counter)=coal_fr kc=cake_perm(present_stage) pc=cake_por(present_stage) rhop=den_p(present_stage) rhol=den_f(present_stage) rhooil=den_oil(present_stage) kp=kp_in(present_stage) np=np_in(present_stage) kpt=kpt_in(present_stage) npt=npt_in(present_stage) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif ! The code below should be active only when reading the injection rates from an input file June 2012 if (hist_inj_rates == 1) then q0=q1(counter) ! Note the first time step t=tt1, the counter is 1 and the rate is the same as before (just a repeat) if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else pres=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if end if if (ck_dipping==1) then q0=2*q0 else q0=q0 end if q=q0 end if ! The above code should be active only when reading the injection rates from an input file !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Code included on Jan 25 2012 for Chevron Tahiti project if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then res_pr(1)=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else res_pr(1)=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,counter) !for Chevron Tahiti Project 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr(i) end do else do i = 1,ltnum excess_res_pr(i)=excess_res_pr_ini(i) end do end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Changing the layer flow rate according to the new flow rate if (q/=qold) then trans(:)=1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rltot(layer) end do Do layer=1,ltnum qltot(layer) = Rtot/RLtot(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC qltot(layer) = q*Rtot/Rltot(layer) qltot(layer) = max(0.0, qltot(layer)) !Converts minimum rate to 0.1 bpd in case there is crossflow (from reservoir to the well) ql_w(layer) = qltot(layer)*RLtot(layer)/Rwtot(layer) vda_w(layer,1)=ql_w(layer)/Aface_w(layer) ql(layer)=qltot(layer)*RLtot(layer)/RL(layer) qlhist(layer,counter)=ql(layer) vda(layer,:)=ql(layer)/Aface(layer) End Do end if !----------------------------------------------------------------------------------------------------------------- ! Updating filtration coefficient around the horizontal well and the transverse fracture !----------------------------------------------------------------------------------------------------------------- ! First updating the Darcy velocity around the horizontal well if (present_stage/=1) then Do j=1,ltnum vda_w(j,:) = vda(j,1)*rw/r(:) ! Darcy velocity around the horizontal well End Do endif Do layer=1,ltnum If (fcae(layer)) Then ! 1 means auto evaluate i.e. calculate filtration coeff using program Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) do i=1,Ns mu=Hp*abs(vda_w(layer,i))**(np-1) if (vda_w(layer,i) > 0) then lambda_w(layer,i) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda_w(layer,i),pm(layer)) else lambda_w(layer,i) = 0 end if if ((c0_oil>0) .and. (vda_w(layer,i)>0) ) then lambda_w_oil(layer,i)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda_w(layer,i),pm(layer)) else lambda_w_oil(layer,i) = 0 endif end do mu=Hp*abs(vda(layer,1))**(np-1) if (vda(layer,1)>0) then lambda(layer,:) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,1),pm(layer)) if (lambda(layer,1)==0) then !for the case of velocity > critical velocity May 2013 lambda(layer,:)=0.1 endif else lambda(layer,:) = 0 end if !commented out Ajay Oct 2013 !if (c0_oil>0) then mu=Hp*abs(vda(layer,1))**(np-1) if (vda(layer,1)>0) then lambda_oil(layer,:)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,1),pm(layer)) if (lambda_oil(layer,1)==0) then !since this filtration coefficient is used away from fracture May 2013 lambda_oil(layer,:)=0.1 end if else lambda_oil(layer,:)=0 endif !endif End If End Do do layer = 1, ltnum sum_lambda(layer,1)=sum_lambda(layer,1)+lambda(layer,1) sum_lambda_oil(layer,1)=sum_lambda_oil(layer,1)+lambda_oil(layer,1) end do do layer = 1, ltnum avg_lambda(layer,:)=sum_lambda(layer,1)/counter avg_lambda_oil(layer,:)=sum_lambda_oil(layer,1)/counter end do lambdahist(:,counter)=lambda(:,1) lambda_oilhist(:,counter)=lambda_oil(:,1) L = 0.01 ! 1 cm is the minimum length of damage do i = 1, ltnum if (perf_ck(i)==1 .AND. avg_lambda(i,1) /= 0) then if (log(10000.0)/avg_lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = log(10000.0)/avg_lambda(i,1) end if end if end do if (L>100) then !Max L is 100 meters modified on april 2012 L = 100 endif if (rf > L) then !L is overwritten by the User specified depth of damage (if it is more than L) L = rf endif write(99,*) "lambda(:,1)", lambda(:,1) write(99,*) "lambda(:,1)", lambda(:,1) write(99,*) "avg_lambda(:,1)",avg_lambda(:,1) write(99,*) "avg_lambda(:,1)",avg_lambda(:,1) write(99,*) "L",L write(99,*) Do layer=1,ltnum if (t==tt1) then !For transverse fracture Wi(layer)=Wi(layer)+ql(layer)*tt1 ! Cumulative rate*dt in the transverse fracture cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*tt1*c0 ! Cum vol of solids injected into the transverse fracture cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr) ! Cum vol of oil injected into the transverse fracture cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected into the transverse fracture cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1) ! Cum vol of oil injected into the transverse fracture !For horizontal well Wi_w(layer)=Wi_w(layer)+ql_w(layer)*tt1 ! Cumulative rate*dt in the horizontal well cum_parr_w(layer)=cum_parr_w(layer)+max(0.0,ql_w(layer))*tt1*c0 ! Cum vol of solids injected in the horizontal well cum_oill_w(layer)=cum_oill_w(layer)+max(0.0,ql_w(layer))*tt1*c0_oil*(1-coal_fr) ! Cum vol of oil injected in the horizontal well else !For transverse fracture Wi(layer)=Wi(layer)+ql(layer)*dt ! Cumulative rate*dt in the transverse fracture cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*dt*c0 ! Cum vol of solids injected into the transverse fracture cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*dt*c0_oil*(1-coal_fr) ! Cum vol of oil injected into the transverse fracture cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected into the transverse fracture cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1) ! Cum vol of oil injected into the transverse fracture !For horizontal well Wi_w(layer)=Wi_w(layer)+ql_w(layer)*dt ! Cumulative rate*dt in the horizontal well cum_parr_w(layer)=cum_parr_w(layer)+max(0.0,ql_w(layer))*dt*c0 ! Cum vol of solids injected in the horizontal well cum_oill_w(layer)=cum_oill_w(layer)+max(0.0,ql_w(layer))*dt*c0_oil*(1-coal_fr) ! Cum vol of oil injected in the horizontal well rad_inj(layer) = rad_inj(layer)+(ql_w(layer)*dt/pi/lw(layer)/pm(layer)/(1-sor(layer)))**0.5 end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) ! Internal damage calculation with resistance up to rf !------------------------------------------------------ If (tt_w(layer)<0) Then ! Determine suspended concentration Call ccalc(lambda_w(layer,:),r,Ns,c0,c) ! Concentration vector for solids Call ccalc(lambda_w_oil(layer,:),r,Ns,c0_oil*(1-coal_fr),c_oil) ! Concentration vector for oil ! Calculate deposited particle concentration, n ! and Dimensionless permeability impairment Rint_w(layer) = 0.0 Do i = 1,Ns !,1,-1 sigma_w(layer,i) = sigma_w(layer,i)+lambda_w(layer,i)*vda_w(layer,i)*c(i)*dt ! Deposited concentration at r sigma_w_oil(layer,i) = sigma_w_oil(layer,i)+lambda_w_oil(layer,i)*vda_w(layer,i)*c_oil(i)*dt ! Deposited concentration at r if ( (sigma_w(layer,i)+sigma_w_oil(layer,i)) > (pm(layer)-pcr(layer)) ) then !to ensure that sigma_w does not exceed (por-critical por) tt_w(layer)=t !Reduced sigma_w and sigma_w_oil in their initial proportions with their sum = pm-pcr sigma_w(layer,i)=(pm(layer)-pcr(layer))*sigma_w(layer,i)/(sigma_w(layer,i)+sigma_w_oil(layer,i)) sigma_w_oil(layer,i)=(pm(layer)-pcr(layer))-sigma_w(layer,i) goto 957 endif 957 k_w(layer,i) = kmh(layer)*PermDecl(sigma_w(layer,i)+sigma_w_oil(layer,i),pm(layer),dg(layer),dp,df(layer)) ! Permeability decline at this point ! Multiplied mu in Rint_w added on May 10 2007 ! Modified by Ajay to include the near wellbore anisotropy on Dec 03 2007 if (r(i) >= rad_inj(layer)) then ! the mobile phase is the reservoir fluid between r(i) and r(i+1)=r(i)*dr radial element mu=Hp*vda_w(layer,i)**(np-1) Rint_w(layer) = Rint_w(layer) + mu/(2*pi*kmh(layer)*kro(layer)*lw(layer))*be*log(dr) !this is because the damage hasn't reached r(i) else ! the radial element has been invaded by the injection polymer Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k_w(layer,i)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) ! Hp is recalculated Rint_w(layer) = Rint_w(layer)+ ql_w(layer)**(np-1)*Hp*be/(2*pi*lw(layer))**np/k_w(layer,i)/krw(layer)*((r(i)*dr)**(1-np)-r(i)**(1-np))/(1-np) ! ignored anisotropy inside the big bracket end if End Do ! External Damage (Time > Transition Time) ! ---------------- ElseIf (tt_w(layer)>=0) Then if (rck_w(layer) > 0.01) then PartVol = (c0+c0_oil*(1-coal_fr))*ql_w(layer)*dt/(1-pc) ! Particle volume in dt ! The next line updates the radius out to the filter cake ! The first time, rck=rw dummy= (rck_w(layer)**2-PartVol/pi/lw(layer)) if (dummy<0.0001) then dummy=0.0001 OPEN(Unit=40, NAME="err.tmp", ACTION = 'Write') Write(40,141)'Wellbore Filled up at ', t/86400,' days. The minimum wellbore radius is made 1 cm due to shearing. The results may not be consistent thereafter.' 141 format(a21,f6.1,a308) endif rck_w(layer)=sqrt(dummy) !The minimum wellbore radius is kept equal to 1 cm, 0.01 m hc_w(layer)=rw-rck_w(layer) endif ! Multiplied mu in Rc added on May 10 2007 Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) ! Hp is recalculated Rcc_w(layer) = ql_w(layer)**(np-1)*Hp/(2*pi*lw(layer))**np/kc*(rw**(1-np)-rck_w(layer)**(1-np))/(1-np) ! Cake resistance with polymer flow Rcc_w(layer) = ql_w(layer)**(np-1)*Hp*hc_w(layer)/(2*pi*rck_w(layer)*lw(layer))**np/kc delpcc_w(layer)=Rcc_w(layer)*ql_w(layer) End If delpint_w(layer)=Rint_w(layer)*ql_w(layer) RwD(layer)=Rint_w(layer)+Rcc_w(layer) ! End of Internal and external resistance calculation !------------------------------------------------------ !------------------------------------------------------ ! Cool,thermal,connate water and oil fronts calculation !------------------------------------------------------ dTemp = Tw(layer)-Tr(layer) ! is independent of time but is a layer property: hence dTemp should be an array if needed if (Swi(layer)<1) then Vcw = Wi(layer)/(pm(layer)*(1-Sor(layer)-Swi(layer))) Vinj = Wi(layer)/(pm(layer)*(1-Sor(layer))) if (dtemp ==0) then Vcool=Vcw else Vcool = (rhol*Chw(layer)*Wi(layer))/(rhog(layer)*Chg(layer)*(1-pm(layer))+rhol*Chw(layer)*pm(layer)*(1-Sor(layer))+rhoo(layer)*Cho(layer)*pm(layer)*Sor(layer)) !vol of cooled zone end if else Vcw=Wi(layer)/pm(layer) Vinj = Wi(layer)/(pm(layer)*(1-Sor(layer))) if (dtemp ==0) then Vcool=Vcw else Vcool = (rhol*Chw(layer)*Wi(layer))/(rhog(layer)*Chg(layer)*(1-pm(layer))+rhol*Chw(layer)*pm(layer)) end if end if rad_cool(layer) = sqrt(rw**2+Vcool/(pi*lw(layer))) ! radius of a cylindrically growing cool injected water/polymer front rad_inj(layer) = sqrt(rw**2+Vinj/(pi*lw(layer))) ! radius of a cylindrically growing injected water/polymer front rad_conw(layer) = sqrt(rw**2+Vcw/(pi*lw(layer))) ! radius of a cylindrically growing oil/water interface if (rad_cool(layer) > h(layer)/2) then rad_cool(layer) = h(layer)/2 endif if (rad_inj(layer) > h(layer)/2) then rad_inj(layer) = h(layer)/2 endif if (rad_conw(layer) > h(layer)/2) then rad_conw(layer) = h(layer)/2 endif !---------------------------------------------------------- ! Horizontal well radial flow resistance between rw and h/2 !---------------------------------------------------------- ! Rwr = Rwr1 + Rwr2 + Rwr3 + Rwr4 ! Rwr1: Radial flow resistance from the connate water front to the upper and lower boundary of the layer in which the horizontal well is ! Rwr2: Radial flow resistance from the hot injection fluid front to the displaced connate water front ! Rwr3: Radial flow resistance from the cooled injection fluid front to the hot injection fluid front ! Rwr4: Radial flow resistance from the damage depth to the cooled injection fluid front ! Note that the above assumes that the connate water front hasn't reached the layer boundaries. ! Rwr1 if (rad_cool(layer)>rf) then ! cool front has crossed the damage zone Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) Rwr4(layer) = ql_w(layer)**(np-1)*Hp*be/(2*pi*lw(layer))**np/kmh(layer)/krw(layer)*(rad_cool(layer)**(1-np)-rf**(1-np))/(1-np) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) Rwr3(layer) = ql_w(layer)**(npt-1)*Hp*be/(2*pi*lw(layer))**npt/kmh(layer)/krw(layer)*(rad_inj(layer)**(1-npt)-rad_cool(layer)**(1-npt))/(1-npt) !Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(((be*2*rad_conw(layer)/(be+1))**2+be**2*delta**2)/(be*2*rad_conw(layer)*rad_inj(layer)/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(rad_conw(layer)/rad_inj(layer)) Rwr1(layer) = mor(layer)*be/(2*pi*kmh(layer)*kro(layer)*lw(layer))*Log(((be*h(layer)/(be+1))**2+be**2*delta**2)/(be*h(layer)*rad_conw(layer)/(be+1))) elseif (rad_inj(layer)>rf) then ! polymer front has crossed the damage zone Rwr4(layer) = 0 Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) Rwr3(layer) = ql_w(layer)**(npt-1)*Hp*be/(2*pi*lw(layer))**npt/kmh(layer)/krw(layer)*(rad_inj(layer)**(1-npt)-rf**(1-npt))/(1-npt) !Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(((be*2*rad_conw(layer)/(be+1))**2+be**2*delta**2)/(be*2*rad_conw(layer)*rad_inj(layer)/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(rad_conw(layer)/rad_inj(layer)) Rwr1(layer) = mor(layer)*be/(2*pi*kmh(layer)*kro(layer)*lw(layer))*Log(((be*h(layer)/(be+1))**2+be**2*delta**2)/(be*h(layer)*rad_conw(layer)/(be+1))) elseif (rad_conw(layer)>rf) then ! connate water front has crossed the damage zone Rwr4(layer) = 0 Rwr3(layer) = 0 !Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(((be*2*rad_conw(layer)/(be+1))**2+be**2*delta**2)/(be*2*rad_conw(layer)*rf/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Rwr2(layer) = mwi(layer)*be/(2*pi*kmh(layer)*krw(layer)*lw(layer))*Log(rad_conw(layer)/rf) Rwr1(layer) = mor(layer)*be/(2*pi*kmh(layer)*kro(layer)*lw(layer))*Log(((be*h(layer)/(be+1))**2+be**2*delta**2)/(be*h(layer)*rad_conw(layer)/(be+1))) else ! connate water hasn't even reached the damage depth Rwr4(layer) = 0 Rwr3(layer) = 0 Rwr2(layer) = 0 Rwr1(layer) = mor(layer)*be/(2*pi*kmh(layer)*kro(layer)*lw(layer))*Log(((be*h(layer)/(be+1))**2+be**2*delta**2)/(be*h(layer)*rf/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. end if Rwr(layer)=Rwr1(layer)+Rwr2(layer)+Rwr3(layer)+Rwr4(layer) !--------------------------------------------------------------------------------------------------- ! Horizontal well elliptical flow resistance between lw(layer) and re ! In case any of the front reaches the layer, Rwh is modified from Joshi's single flow equation !--------------------------------------------------------------------------------------------------- ! Rwh = Rwh1 + Rwh2 + Rwh3 + Rwh4 ! Rwh1: Horizontal/elliptical flow resistance for oil flowing zone at Swi ! Rwh2: Horizontal/elliptical flow resistance for connate water flowing zone ! Rwh3: Horizontal/elliptical flow resistance for injected water/polymer flowing zone (at reservoir temperature) ! Rwh4: Horizontal/elliptical flow resistance for cool injected water/polymer ! Horizontal well elliptical flow front dimension in the direction of horizontal well. ! Note it is assumed that the fronts will grow as a cuboid with lw(layer)/h ratio in the x-y direction with z = h constant. aw_cool(layer)=min(max(lw(layer)/2,0.5/h(layer)*sqrt(lw(layer)*Vcool)),aj-0.0001) bw_cool(layer)=min(max(h(layer)/2,0.5*sqrt(Vcool/lw(layer))),Sqrt(aj**2-(lw(layer)/2)**2)-0.0001) !if (bw_cool(layer) <= h(layer)/2) then ! bw_cool(layer) = 0 !endif aw_inj(layer)=min(max(lw(layer)/2,0.5/h(layer)*sqrt(lw(layer)*Vinj)),aj-0.0001) bw_inj(layer)=min(max(h(layer)/2,0.5*sqrt(Vinj/lw(layer))),Sqrt(aj**2-(lw(layer)/2)**2)-0.0001) !if (bw_inj(layer) <= h(layer)/2) then ! bw_inj(layer) = 0 !endif aw_conw(layer)=min(max(lw(layer)/2,0.5/h(layer)*sqrt(lw(layer)*Vcw)),aj-0.0001) bw_conw(layer)=min(max(h(layer)/2,0.5*sqrt(Vcw/lw(layer))),Sqrt(aj**2-(lw(layer)/2)**2)-0.0001) !if (bw_conw(layer) <= h(layer)/2) then ! bw_conw(layer) = 0 !endif ! Horizontal well horizontal flow resistance between re and lw(layer) if (aw_cool(layer) > lw(layer)/2) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) Rwh4(layer) = ql_w(layer)**(np-1)*Hp/(2*pi*h(layer))**np/kmh(layer)/krw(layer)*(((aw_cool(layer)+bw_cool(layer))/2)**(1-np)-(lw(layer)/4)**(1-np))/(1-np) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) Rwh3(layer) = ql_w(layer)**(npt-1)*Hp/(2*pi*h(layer))**npt/kmh(layer)/krw(layer)*(((aw_inj(layer)+bw_inj(layer))/2)**(1-npt)-((aw_cool(layer)+bw_cool(layer))/2)**(1-npt))/(1-npt) Rwh2(layer) = mwi(layer)/(2*pi*kmh(layer)*krw(layer)*h(layer))*Log((aw_conw(layer)+bw_conw(layer))/(aw_inj(layer)+bw_inj(layer))) Rwh1(layer) = mor(layer)/(2*pi*kmh(layer)*kro(layer)*h(layer))*Log((aj+Sqrt(aj**2-(lw(layer)/2)**2))/(aw_conw(layer)+bw_conw(layer))) ! Modified Joshi elseif (aw_inj(layer) > lw(layer)/2) then Rwh4(layer) = 0 Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)/be*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) Rwh3(layer) = ql_w(layer)**(npt-1)*Hp/(2*pi*h(layer))**npt/kmh(layer)/krw(layer)*(((aw_inj(layer)+bw_inj(layer))/2)**(1-npt)-(lw(layer)/2)**(1-npt))/(1-npt) Rwh2(layer) = mwi(layer)/(2*pi*kmh(layer)*krw(layer)*h(layer))*Log((aw_conw(layer)+bw_conw(layer))/(aw_inj(layer)+bw_inj(layer))) Rwh1(layer) = mor(layer)/(2*pi*kmh(layer)*kro(layer)*h(layer))*Log((aj+Sqrt(aj**2-(lw(layer)/2)**2))/(aw_conw(layer)+bw_conw(layer))) ! Modified Joshi elseif (aw_conw(layer) > lw(layer)/2) then Rwh4(layer) = 0 Rwh3(layer) = 0 Rwh2(layer) = mwi(layer)/(2*pi*kmh(layer)*krw(layer)*h(layer))*Log((aw_conw(layer)+bw_conw(layer))/(lw(layer)/2)) Rwh1(layer) = mor(layer)/(2*pi*kmh(layer)*kro(layer)*h(layer))*Log((aj+Sqrt(aj**2-(lw(layer)/2)**2))/(aw_conw(layer)+bw_conw(layer))) ! Modified Joshi else Rwh4(layer) = 0 Rwh3(layer) = 0 Rwh2(layer) = 0 Rwh1(layer) = mor(layer)/(2*pi*kmh(layer)*kro(layer)*h(layer))*Log((aj+Sqrt(aj**2-(lw(layer)/2)**2))/(lw(layer)/2)) ! Joshi endif Rwh(layer)=Rwh1(layer)+Rwh2(layer)+Rwh3(layer)+Rwh4(layer) Res1_w(layer)=Rwr1(layer)+Rwh1(layer) Res2_w(layer)=Rwr2(layer)+Rwh2(layer) Res3_w(layer)=Rwr3(layer)+Rwh3(layer) Res4_w(layer)=Rwr4(layer)+Rwh4(layer) delp1_w(layer)=ql_w(layer)*Res1_w(layer) delp2_w(layer)=ql_w(layer)*Res2_w(layer) delp3_w(layer)=ql_w(layer)*Res3_w(layer) delp4_w(layer)=ql_w(layer)*Res4_w(layer) !Velocity thru perforations in the horizontal well If (ds>0) Then !Perforation shot density vp_w(layer) = ql_w(layer)/(2*pi*rp*lp*lw(layer)*ds) !velocity through perforations Else vp_w(layer) = 0 End If delpp_w(layer)=0.8338*(rhol*vp_w(layer)**2.0) ! pressure drop in the perforations around the horizontal well if (j ==1) then !if (j ==1 .OR. j==8) then Case 2 for BHP Moondyne Horizontal Injector !delpp_w(layer) = delpp_w(layer) + 0.0003*1e5*(ql_w(layer)*86400)**1.9995 !added on June 11 2012 for Moondyne ICD's else !delpp_w(layer) = delpp_w(layer) + 0.00007*1e5*(ql_w(layer)*86400)**1.995 !added on June 11 2012 for Moondyne ICD's end if Resp_w(layer)=delpp_w(layer)/ql_w(layer) !--------------------------------------------------------------------------------------------------- !Total horizontal well flow resistance !--------------------------------------------------------------------------------------------------- Rwtot(layer)=RwD(layer)+Rwr(layer)+Rwh(layer)+Rskin(layer)+Resp_w(layer) !Calculate Rftot(layer) when pwf(layer)>pfrac(layer) !For pfrac(layer) !---------------------------------------------------------------------------------------------- ! Calculating transverse fracture length in each layer ! The fracture length depends on the tip pressure which should be less than pfrac, ! the fracturing pressure. The fracturing pressure is determined by the minimum ! horizontal stress and a surface energy term as given by equation (3.29) in UTWID user manual. !---------------------------------------------------------------------------------------------- mu=Hp*vda(layer,1)**(np-1) Call PGFellipse2(wt,realct,perf_ck(layer),skin_ini,np,kp,npt,kpt,be,lw(layer),ecc(layer),layer,ltnum,dip(layer),frac_grad(layer),stress_change_pore_pressure(layer),& Wi(layer),Cum_parr(layer),Cum_oill(layer),Cum_parr_lambda(layer),Cum_oill_lambda(layer),Ns,dx,avg_lambda(layer,:),avg_lambda_oil(layer,:),lambdahist(layer,:),lambda_oilhist(layer,:),pm(layer),pcr(layer),ql(layer),& qlhist(layer,:),dt,counter,trans(layer),c0,c0hist,c0_oil,c0_oilhist,coal_fr,coal_frhist,dg(layer),dp,doil,kmh(layer),& df(layer),t,pc,kc,U,n(layer),Y(layer),Tw(layer),Tr(layer),& Swi(layer),Sor(layer),rhol,rhoo(layer),rhog(layer),Chw(layer),Cho(layer),Chg(layer),B(layer),ds,rp,re,rw,h(layer),& pres_ini+excess_res_pr_ini(layer),pres+excess_res_pr(layer),kro(layer),krw(layer),mor(layer),mwi(layer),mu,sigmamin(layer),ck_dipping,cgr(layer),ctot(layer),lfrw(layer),avgwfp(layer),& fp_por(layer),lfold(layer),lfhist(layer,:),fracture_closure,& ! Up to here all are input variables lf(layer),cum_parr_lf(layer),cum_oill_lf(layer),maj_axis_w(layer),min_axis_w(layer),maj_axis_p(layer),& min_axis_p(layer),maj_axis_t(layer),& min_axis_t(layer),maj_axis_D(layer),min_axis_D(layer),dst(layer),dsp(layer),Sminh(layer),Ptip(layer),& Pfrac(layer),Piwf(layer),delp1(layer),delp2(layer),delp3(layer),delp4(layer),delptrans(layer),delpint(layer),& delpcc(layer),& delpud(layer),delps_ini(layer),delpf(layer),wf(layer),delpp(layer),res1(layer),res2(layer),res3(layer),res4(layer),& rint(layer),rcc(layer),rud(layer),rskin(layer),resf(layer),resp(layer),tt(layer),hc(layer),k(layer,:)) Aface(layer) = 4*lw(layer)*lf(layer) ! Updating New Area of fracture faces End Do ! End of layer loop Lfold=lf !setting the old fracture length to the current fracture length !------------------------------------------------------------------------------------------------- ! New resistivities calculated based on the new fracture lengths, fronts and cakes !------------------------------------------------------------------------------------------------- Rtot=0 Do layer=1,ltnum !Rl(layer)=Res1(layer)+Res2(layer)+Res3(layer)+Res4(layer)+Rint(layer)+Rcc(layer)+Rskin(layer)+Resf(layer)+Resp(layer)+Rl_vert(layer) Rl(layer)=Res1(layer)+Res2(layer)+Res3(layer)+Res4(layer)+Rint(layer)+Rcc(layer)+Resf(layer)+Resp(layer)+Rskin(layer) !June 2012 RLtot(layer)=1/Rwtot(layer)+1/Rl(layer) !Adding horizontal well total resistance and the transverse frac total resistance in parallel RLtot(layer)=1/RLtot(layer) Rtot=Rtot+1/RLtot(layer) End Do Rtot=1/Rtot !--------------------------------------------------------------------------------------------------------------------- ! New flow rates in the layers are calculated based on the new fracture length and new resistance in the layer ! for this time step !--------------------------------------------------------------------------------------------------------------------- counter=counter+1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rltot(layer) end do Do layer=1,ltnum qltot(layer) = Rtot/RLtot(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC qltot(layer) = q*Rtot/Rltot(layer) qltot(layer) = max(0.0, qltot(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) ql(layer) = qltot(layer)*RLtot(layer)/Rl(layer) qlhist(layer,counter)=ql(layer) ! Storing the current flow rate going into the fracture June 2012 vda(layer,:) = ql(layer)/Aface(layer) lfhist(layer,counter)=lf(layer) ! Storing the current frac length ql_w(layer) = qltot(layer)*RLtot(layer)/Rwtot(layer) vda_w(layer,1)=ql_w(layer)/Aface_w(layer) End Do !----------------------------------------------------------------------------------------------- ! Calculate the bottom hole pressure at the end of this time step with the new value of flow rate in each layer. Do layer=1,ltnum Piwf(layer)=(pres+excess_res_pr(layer))+Rltot(layer)*qltot(layer) end do !----------------------------------------------------------------------------------------------- Piwfdd=0 sumofBHPaveraginglayers = 0 Do layer=1,ltnum if (perf_ck(layer) == 1) then sumofBHPaveraginglayers = sumofBHPaveraginglayers + 1 Piwfdd=piwf(layer)+Piwfdd end if End Do Piwfdd=Piwfdd/sumofBHPaveraginglayers !calculating the average injection pressure in the layers !----------------------------------------------------------------------------------------------- realdp=Piwf(1)-(pres+excess_res_pr(1)) if (ql(1)==0) then skin = 0 else skin=(realdp-initial_dp)*(2*pi*kmh(1)*be*kro(1)*lw(1))/(ql(1)*mor(1)) + skin_ini !in layer 1, it could be different for other layers. endif !calculate average skin for the well with all layers. dummy=0 do i = 1,ltnum !if (ql(i) /= 0) then !dummy = dummy + 1/(kmh(i)*kro(i)*h(i)/ql(i)/mor(i)) dummy = dummy + 1/(kmh(i)*kro(i)*lw(i)/mor(i)) !end if end do skin = (realdp-idealdp)/dummy/q + skin_ini !----------------------------------------------------------------------------------------------- !Injectivity Calculations !----------------------------------------------------------------------------------------------- IF (t==3600) then injectivity_1_hour=q/(piwfdd-pres)*6.289810*86400/.0001450377 ELSEIF (t==3600+86400) then injectivity_1_day=q/(piwfdd-pres)*6.289810*86400/.0001450377 ENDIF alphfrc = initial_dp*flow_rate(present_stage)/flow_rate(1)/(piwfdd-pres) ! Injectivity ratio calculation !alphfrc = flow_rate(present_stage)/(piwfdd-pres) ! Actual Injectivity !----------------------------------------------------------------------------------------------- !Writing to The Output Files !----------------------------------------------------------------------------------------------- 100 FORMAT (500E13.5) 110 FORMAT (500F14.4) !Writing delp in the layers with time do i = 1, ltnum Write(177+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377, delptrans(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 Write(197+i,110) t/86400, delp1_w(i)*0.0001450377, delp2_w(i)*0.0001450377, delp3_w(i)*0.0001450377, delp4_w(i)*0.0001450377, delptrans_w(i)*0.0001450377,delpint_w(i)*0.0001450377, delpcc_w(i)*0.0001450377, 0.00, delps_ini(i)*0.0001450377, 0.00, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 end do !Writing layer no, transition time, filtration coefficient and specific deposit do i = 1, ltnum Write(39+i,110) t/86400,tt(i)/86400,lambda(i,1) Write(217+i,110) t/86400,tt_w(i)/86400,lambda_w(i,1) end do !open (Unit=172, NAME="Res_initial.tmp", Action='Write') !Write(172,100) t/86400, Rl0 !open (Unit=173, NAME="Res_layer.tmp", Action='Write') !Write(173,100) t/86400, Rltot !open (Unit=203, NAME="Res_layer_f.tmp", Action='Write') !Write(203,100) t/86400, Rl !open (Unit=204, NAME="Res_layer_w.tmp", Action='Write') !Write(204,100) t/86400, Rwtot !open (Unit=174, NAME="Res_int_cake_f.tmp", Action='Write') !Write(174,100) t/86400, Rint !open (Unit=200, NAME="Res_int_cake_w.tmp", Action='Write') !Write(200,100) t/86400, Rint_w !open (Unit=175, NAME="Res_ext_cake.tmp", Action='Write') !Write(175,100) t/86400, Rcc !open (Unit=201, NAME="Res_ext_cake_w.tmp", Action='Write') !Write(201,100) t/86400, Rcc_w !open (Unit=176, NAME="Res_UDF.tmp", Action='Write') !Write(176,100) t/86400, Rud !open (Unit=177, NAME="Res_vertical.tmp", Action='Write') !Write(177,100) t/86400, Rl_vert Write (871,110) t/86400,maj_axis_t*3.28 !writing the major axes of the thermal fronts around transverse frac in ft Write (260,110) t/86400,rad_cool*3.28 ,(aw_cool/2)*3.28 !writing the major axes of the thermal fronts around well in ft Write (872,110) t/86400,min_axis_t*3.28 !writing the minor axes of the thermal fronts around transverser frac in ft Write (261,110) t/86400,rad_cool*3.28 ,(aw_cool/2)*3.28 !writing the minor axes of the thermal fronts around well in ft Write (9,110) t/86400, maj_axis_w*3.28 !writing the major axes of the waterflood fronts around transverse frac in ft Write (262,110) t/86400, rad_conw*3.28 ,(aw_conw/2)*3.28 !writing the major axes of the waterflood fronts around well in ft Write (10,110) t/86400, min_axis_w*3.28 !writing the minor axes of the waterflood fronts around transverse frac in ft Write (263,110) t/86400, rad_conw*3.28 ,(aw_conw/2)*3.28 !writing the minor axes of the waterflood fronts around well in ft Write(17,110) t/86400, flow_rate(present_stage)*543439.6331/((piwfdd-pres)/6894.76) !alphfrc ! writing injectivity ratio Write(129,110) t/86400, Piwfdd*0.0001450377 !writing bottom hole pressure in psi Write (16,110) t/86400, Pfrac*0.0001450377 ! writing current min horizontal stress (psi) Write (18,110) t/86400, Ptip*0.0001450377 ! writing pressure at the fracture tip (psi) If (out_pp==1) Then Do j=1,ltnum Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md around the transverse fracture Write(22,110) t/86400, k_w(j,:)*1e15 ! Permeability in md around the horizontal well End Do endif Write(21,*) Write(22,*) !do j=1,ltnum ! kavg(j)=0 ! ksum=0 ! do i = 1,Ns ! ksum=ksum+L/Ns/k(j,i) ! end do ! kavg(j)=L/ksum !end do !open (Unit=192, NAME="kdamage_for_GEM.tmp", Action='Write') !Write(192,110) t/86400, kavg(:)*1e15 ! writing avg damage zone perm in md !open (Unit=193, NAME="Ldamage_for_GEM.tmp", Action='Write') !Write(193,110) t/86400, L*1000.0 ! writing damage zone depth in mm !open (Unit=194, NAME="kcake_for_GEM.tmp", Action='Write') !Write(194,110) t/86400, kc ! writing cake perm in md !open (Unit=195, NAME="Lcake_for_GEM.tmp", Action='Write') !Write(195,110) t/86400, hc*1000.0 ! writing external cake thickess in mm Write(8,110) t/86400, skin ! writing skin Write(11,110) t/86400, lf*3.28 ! time in days and fracture length in ft Write(286,110) t/86400, ql*543439.6331 ! writing flow rate in each layer (bpd) Write(287,110) t/86400, ql_w*543439.6331 ! writing flow rate in each layer (bpd) if (q==0) then ! injection rate = 0 Write(288,110) t/86400, 1 ! writing fraction of total flow rate in each layer else Write(288,110) t/86400, qltot/q ! writing fraction of total flow rate in each layer endif Write(289,110) t/86400, piwf*0.0001450377 ! writing layer bottom hole pressure in psi Write(290,110) t/86400, cum_parr ! Cumulative particles injected Write(291,110) t/86400, hc*1000 ! writing external cake thickess in mm Write(292,110) t/86400, hc_w*1000 ! writing external cake thickess in mm Write(293,110) t/86400, wf*1000.0 ! writing maximum width of the fracture in mm Write(294,110) t/86400, rck_w*1000.0 ! writing maximum width of the fracture in mm ! if (Bhpconverge <=0) then ! Bhpconverge = Bhpconverge + 1 ! goto 108 ! end if ! Bhpconverge = 1 End Do !end of frac calculations time loop ! Writing Filtration parameters for the horizontal well OPEN(Unit=30000, NAME="Filtration_well.tmp", ACTION = 'Write') 150 FORMAT(A103) Write(30000,150) 'Layer Dam.Len.(cm) Solid.Filt.coeff.(1/m) Oil.Filt.coeff.(1/m) Trans.time(days) Cr.Por Cr.Perm(md)' 160 FORMAT(A30, 100F15.4) Do j=1,ltnum Write(30000,160) trim(lname(j))//",",L*100,lambda_w(j,1),lambda_w_oil(j,1),tt_w(j)/86400,pcr(j),k_w(j,1)*1e15 !,lambda(j,1),sigma(j,1), End Do Close(30000) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Time loop Ends !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ End Subroutine calc_H_transverse_frac !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! End of Subroutine !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !---------------------------------------------------------------------------------------------------------------- ! calc_V_frac added on 8/15/98 ! Modified by Ajay Suri November 2006 ! Models injection in a cased and perforated well with multiple layers ! Models injection of a flow rate dependent polymer, k and n ! Main global variables calculated: ! lf(:) Fracture length in each layer ! ql(:) Flow rate in each layer !---------------------------------------------------------------------------------------------------------------- Subroutine calc_V_frac() External pgfellipse2 character(240) :: layer_names, dummy_name real(8) :: & rskin_ini, & ! Initial skin resistance rwp, & ! equivalent radius of damaged well in frac inj calculations alphfrc, & ! injectivity of a plugged fracture Piwfdd,& idealdp,& ! ideal dp in a radial well (with out skin or fracture from darcy law) idealdp_frac,& ! ideal dp in a fractured well skintot,& ! total skin of the well skin0tot ! initial total skin of the well real(8)::dummy !reads first column as injection days from a history matching file: 1. Petrobras-Guando-ARIN3-GUA-096-q.txt Integer :: i,j,points_counter = 0, bhpconverge = 0, counter = 1 ! Counters Integer :: layer, present_stage, perf_zone, layers, sumofBHPaveraginglayers,fileopencounter,a_range_flag,m real(8):: initial_dp !initial deltaP taking into account initial skin in frac case real(8):: pi=3.14159 real(8):: initial_injectivity, injectivity_1_hour, injectivity_1_day !injectivites real(8):: sig_kh real(8):: tt1, tt2 real(8):: piwfleast, realdp, kavg(ltnum),ksum,app_vis real(8)::v,fp_por(ltnum),avg_delpf,delps(ltnum) real(8)::idealdp_Uf,idealdp_f,IR !Uf = unfractured, f = fractured, Ji = Injectivity ratio of fractured well with ideal well real(8)::Eff_M,sum,pdss !transient multirate injection well pressure calculation real(8)::dh(ltnum) !difference in depth between the top layer and the respective layer real(8)::excess_res_pr(ltnum) !excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_res_pr_ini(ltnum) !initial excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_q !excess q (flow rate) from the over-pressured layers real(8)::avg_pres real(8)::dummy1 real(8)::kh_mu,lf0(ltnum), amin,amax,a,sum_excess_res_pr,tolerance,fn,fn1,fn2,delpstot,skin_frac_delp(ltnum),resf_ini(ltnum) real(8)::skin_frac(ltnum),skin0(ltnum),skin(ltnum) real(8)::qltemp(ltnum) ! used for the fraction of flow output when the total injection rate = 0 !------------------------------------------------------------------------------------------------------------------------------ ! The following code was added on Oct 10 2010 for adding headers to the output files ! Making a string that has layer names in it layer_names = " Time(days) " do i = 1, ltnum dummy_name=trim(lname(i)) layer_names=trim(layer_names)//" "//trim(dummy_name) end do 70 FORMAT(A100) 80 FORMAT(A95) 90 FORMAT(A246) !------------------------------------------------------------------------------------------------------------------------------ do i = 1, ltnum open(Unit=39+i, NAME="filtration "//trim(lname(i))//".tmp", ACTION = 'Write') Write(39+i,80) "This file outputs the transition time and filtration coefficient of a layer by the file name" Write(39+i,*) "Time(days) Transition_time(days) Solids_Filtration_coefficient(1/m) Oil_Filtration_coefficient(1/m) " end do do i = 1, ltnum open (Unit=170+i, NAME="delp "//trim(lname(i))//".tmp", Action='Write') Write(170+i,80) "This file outputs the pressure drops in the various regions of the reservoir and the fracture" Write(170+i,90) "Time(days) delp1(psi) delp2(psi) delp3(psi) delp4(psi) delptrans(psi) delpint(psi) delpcc(psi) delpud(psi) delps_ini(psi) delpf(psi) delpp(psi) Ptip(psi) Pfrac(psi) Sminh(psi) sigmamin(psi) dst(psi) dsp(psi)" end do open (Unit=129, NAME="Average_BHP.tmp", Action='Write') Write(129,80) "This file outputs the bottom hole pressure (psi) at the mid depth of the top layer" Write(129,*) "Time(days) BHP(psi)" open (unit=871, NAME="maj_axis_thermal.tmp", Action='Write') Write(871,*) "This file outputs the major axis of the Thermal Front (ft) in all the layers" Write(871,90) layer_names open (unit=9, NAME="maj_axis_waterflood.tmp", Action='Write') Write(9,80) "This file outputs the major axis of the Water-flood front (ft) in all the layers" Write(9,90) layer_names open (unit=872, NAME="min_axis_thermal.tmp", Action='Write') Write(872,*) "This file outputs the minor axis of the Thermal Front (ft) in all the layers" Write(872,90) layer_names open (unit=10, NAME="min_axis_waterflood.tmp", Action='Write') Write(10,80) "This file outputs the minor axis of the Water-flood Front (ft) in all the layers" Write(10,90) layer_names open (Unit=17,NAME="Well_Injectivity.tmp", Action='Write') Write(17,*) "This file outputs the injectivity of the well (bpd/psi)" Write(17,90) layer_names open (unit=16, NAME="pfrac.tmp", Action='Write') Write(16,*) "This file outputs the fracture propagation pressure (psi) in all the layers" Write(16,90) layer_names open (unit=18, NAME="ptip.tmp", Action='Write') Write(18,*) "This file outputs the pressure at the tip of the fracture (psi)" Write(18,90) layer_names open (Unit=21, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles Write(21,80) "This file outputs the permeability of the reservoir perpendicular to the fracture for each segment of the damage zone (md)" Write(21,90) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" open (Unit=196, NAME="wfmax.tmp", Action='Write') Write(196,*) "This file outputs the maximum width of the fracture in all the layers(mm)" Write(196,90) layer_names open (Unit=8, NAME="well_skin.tmp", Action='Write') Write(8,80) "This file outputs the total skin in the injector as a function of time" Write(8,*) "Time(days) Total_well_skin(dimensionless)" open (Unit=11, NAME="frac_length.tmp", Action='Write') Write(11,*) "This file outputs the fracture length (ft) in all the layers" Write(11,90) layer_names open (Unit=187, NAME="flowrate.tmp", Action='Write') Write(187,*) "This file outputs the injection flow rate in each layer (bpd)" Write(187,90) layer_names open (Unit=188, NAME="fraction_flowrate.tmp", Action='Write') Write(188,*) "This file outputs the fraction of flow injected in each layer" Write(188,90) layer_names open (Unit=189, NAME="layer_bhp.tmp", Action='Write') Write(189,80) "This file outputs the BHP (psi) in each layer corrected for the depth. They should be quite same" Write(189,90) layer_names open (Unit=190, NAME="cum_particles.tmp", Action='Write') Write(190,70) "This file outputs the cumulative Solids (ft3) injected in each layer" Write(190,90) layer_names open (Unit=191, NAME="cake_thickness.tmp", Action='Write') Write(191,80) "This file outputs the thickness of the cake formed at the fracture face of each layer (mm)" Write(191,90) layer_names Open (Unit=192,NAME="layer_skin.tmp", Action='Write') Write(192,*) "This file outputs the skin (Dimensionless) of each layer" Write(192,90) layer_names !open (Unit=1, NAME="cross_flow.tmp", Action='Write') !------------------------------------------------------------------------------------------------------------------------------ !Reading first injection stage shear thinning polymer parameters n and k at injection temp (kp,np) and reservoir temp (kpt,npt) !------------------------------------------------------------------------------------------------------------------------------ kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 !added on oct 28 2010 endif !------------------------------------------------------------------------------------------------------------------------------ av_q_tot=0 if (hist_inj_rates == 1) then !Reading Bigfoot-SW23 injection rates OPEN(Unit=63, NAME="historical_q.txt", ACTION = 'Read') Read(63,*, end = 600) dummy_name Read(63,*, end = 600) dummy_name do i = 1, int(t_max/dtday) if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then Read(63,*, end = 600) dummy_time, q1(i), pres_multiple(:,i) !reading rate in bpd and reservoir pr. in psi pres_multiple(:,i)=pres_multiple(:,i)*6894.76 !converts from psi to pascals for SI else Read(63,*, end = 600) dummy_time, q1(i), pres_1(i) !reading rate in bpd and reservoir pr. in psi pres_1(i)=pres_1(i)*6894.76 !converts from psi to pascals for SI end if else Read(63,*, end = 600) dummy_time, q1(i) !reading in bpd end if q1(i) = max(0.0, q1(i)/543439.6331) !converts from bpd in m3/s for SI with min. rate of 0 bpd av_q_tot=av_q_tot+q1(i) end do 600 Close(63) av_q_tot=av_q_tot/int(t_max/dtday) else do i=1,nstage av_q_tot=av_q_tot+flow_rate(i) end do av_q_tot=av_q_tot/nstage endif do i = 1,ltnum dh(i)=((topl(i)+bottoml(i))/2-(topl(1)+bottoml(1))/2) end do if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then pres_ini = pres_multiple(1,1) pres = pres_multiple(1,1) res_pr(1)=pres_multiple(1,1) else pres_ini = pres_1(1) pres = pres_1(1) res_pr(1)=pres_1(1) end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,1) !Added in Jan 27 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do else pres_ini = res_pr(1) ! when reservoir pressure is provided in the GUI pres = res_pr(1) end if write(99,*) write(99,*) 'Reservoir pressure in top layer at time 0 =', pres_ini/6894.76, 'psi' write(99,*) sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr_ini(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr_ini(i) end do !------------------------------------------------------------------------------------------------------------------------------ !Outputting apparent viscosity of the injected polymer as a function of r from the well up to re !OPEN(Unit=42, NAME="app_vis.tmp", ACTION = 'Write') !do layer=1,ltnum !Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) !Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(1)*krw(1)*pm(1)*(1-sor(1)))**((1.0-np)/2.0) !do i=0,100 !v=ql(layer)/2/pi/(rw+i*re/100)/tst(1) !v=flow_rate(1)/2/pi/(rw+i*re/100)/tst(1) !app_vis=Hp*v**(np-1) !Write(42,*) (rw+i*re/100)*3.28, app_vis*1000 !end do !end do !close(42) !--------------------------------------------------------------------------------------------- ! Initialization of total resistivity, deposition, cumulative water, particle, & oil injection ! External filter cake thickness = 0, initial fracture length guess. !--------------------------------------------------------------------------------------------- fileopencounter=0 ! 0 means output files are not open, 1 means the files are already open, so need not open again. dnpv = 1 ! Calculating the apparent wellbore radius in case of perforated completion If (realct==3) Then ! Perforated rw = rp*lp*ds End If if (ck_eqfp==0) then lfrw=2*rw !Equivalent fracture length for the wellbore !code added on July 11 2013 for Anadarko Heidelberg for reduced perforation intervals !lfrw(1)=2*rw/2 !lfrw(2)=2*rw !lfrw(3)=2*rw/2 !lfrw(4)=2*rw fp_por=1 avgwfp=0 else lfrw=lfp !Equivalent fracture length from approximate equivalent frac-pack length fp_por=fpp endif trans(:)=1 Lf=lfrw !Initialization of Lf Lfold=Lf !Initialization of Lfold lfhist(:,counter)=lfold RL0tot=0 !Initial total resistivity of the reservoir Wi(:)=0 !Cumulative water injected in each layer ! Initialized: hc, Cum_parr, Cum_oill = 0 by Ajay on Sept 06 2006 hc(:)=0 !External filter cake thickness in each layer Rcc(:)=0 !External filter cake resistivity Cum_parr=0 !Cumulative volume of particles injected in each layer, units m3 Cum_oill=0 !Cumulative volume of oil injected in each layer, units m3 Cum_parr_lambda=0 !Cumulative volume of particles injected in each layer, units m3 Cum_oill_lambda=0 !Cumulative volume of oil injected in each layer, units m3 sigmamin1=sigmamin !Initializing the minimum horizontal stress for all layers dst(:)=0 !Initial stress change because of temperature difference dsp(:)=0 !Initial stress change because of pore pressure change do i = 1,ltnum Aface(i) = 4*tst(i)*Lf(i) !initialization of Aface end do !------------------------------------------------------------------------------------- !Setting variables for the first stage of injection !------------------------------------------------------------------------------------- present_stage=1 q0=flow_rate(1) !if reading the injection rates and or res pr. from a file if (hist_inj_rates==1) then q0=q1(1) !for Nexen-C1, Petrobras-Guando-ARIN-3, Well: GUA-096, GUA-024A, needs to be excluded otherwise or Bigfoot-SW23 end if if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,1) !for Chevron Tahiti Project 2012, average reservoir pressures for first layer else pres=pres_1(1) !for Nexen-C1 or any other project, average reservoir pressure changing, needs to be excluded otherwise end if end if !if reading the injection rates and or res pr. from a file c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) if (ck_dipping==1) then q0=2*q0 else q0=q0 end if q=q0 !Call calc_Rl_vert ! Calculating vertical resistance for flow into unperforated layers commented out Ajay Oct 2013 !--------------------------------------------------------------------------------------------- ! Calculate the initial ideal pressure drop in a radial injector without any skin or fracture !--------------------------------------------------------------------------------------------- Rl0tot=0 Do layer=1,ltnum if (swi(layer)==1) then RL0(layer) = mwi(layer)*log(re/rw)/(2*pi*kmh(layer)*krw(layer)*tst(layer)) ! Ideal resistance in a radial injector with water flowing else RL0(layer) = mor(layer)*log(re/rw)/(2*pi*kmh(layer)*krw(layer)*tst(layer)) ! Ideal resistance in a radial injector with water flowing end if RL0tot=RL0tot+1/RL0(layer) End Do RL0tot=1/RL0tot idealdp=RL0tot*q0 !ideal pressure drop w/o skin in a radial injector and w/o accounting for any access pore pressure in the layers, if any !--------------------------------------------------------------------------------------------------------------------------------- ! Calculating kh/mu for skin calculations ! Note kh_mu should be used only for skin calculations and not very flow resistance, flow distribution or pressure calculations !--------------------------------------------------------------------------------------------------------------------------------- kh_mu=0 do i = 1,ltnum kh_mu = kh_mu + kmh(i)*krw(i)*tst(i)/kp end do !------------------------------------------------------------------------------------------------------------------------------------------- ! Find estimate of initial flow rate in each layer w/o well skin and pr. drop in the fracture !------------------------------------------------------------------------------------------------------------------------------------------ Rl0tot=0 Do layer=1,ltnum if (swi(layer)==1) then !commented out Rl_vert Ajay Oct 2013 RL0(layer) = log(2*re/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/mwi(layer)) !+ Rl_vert(layer) ! Initial resistance without fracture resistance else !commented out Rl_vert Ajay Oct 2013 RL0(layer) = log(2*re/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/mor(layer)) !+ Rl_vert(layer) ! Initial resistance without fracture resistance end if Rl0tot=Rl0tot+1/RL0(layer) End Do Rl0tot=1/Rl0tot excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr_ini(layer)/rl0(layer) end do !Estimate of the initial flow rate in each layer. Do layer=1,ltnum ql(layer) = Rl0tot/RL0(layer)*(q0+excess_q-excess_res_pr_ini(layer)/Rl0tot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC !ql(layer) = Rl0tot/RL0(layer)*q0 !USE THIS FOR WHEN LAYER PRESSURES ARE HYDROSTATIC (THIS SHOULD BE A SPECIAL CASE OF THE ABOVE) !ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) End Do Write(99,*) Write(99,*) 'In. flow rate distribution w/o frac pr. drop =',ql*543439.6331, 'bpd' Write(99,*) Write(*,*) Write(*,*) 'In. flow rate distribution w/o frac pr. drop =',ql*543439.6331, 'bpd' Write(*,*) !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- !Specify initial skin either by knowing frac skin and adjusting the skin with frac lengths so that it is 0 or whatever it should be !keep it default that is what is calculated by the program (would be negative if fracs are there and would be 0 if fracs are not there) !skin_ini=0 !-6.25 write(99,*)'The initial well skin = ',skin_ini delps_ini=q0/2/pi/kh_mu*skin_ini realdp = idealdp+delps_ini(1) !Write(99,*) !Write(99,*) 'In. pres. drop due to in. skin =',delps_ini/6894.76, 'psi' !Write(99,*) !Write(*,*) !Write(*,*) 'In. pres. drop due to in. skin =',delps_ini/6894.76, 'psi' !Write(*,*) Do layer=1,ltnum !if (ql(layer) .LE. 0) then ! resf_ini(layer)=0 ! skin_frac_delp(layer)=0 !else ! resf_ini(layer)=(16.0/3.0/pi*(2*np+1)**np*ql(layer)**(-np-2)*kp*lf(layer)*Y(layer)**(2*np+1)/np**np/2**(2*np-1)/(1-n(layer)**2)**(2*np+1)/tst(layer)**(3*np+1))**(1/(2*np+2)) ! skin_frac_delp(layer)=(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)*resf_ini(layer) !end if !commented out using Rl_vert Ajay Oct 2013 skin_frac(layer)=log(rw)-log(lf(layer)/2)!+(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)*Rl_vert(layer)!+skin_frac_delp(layer) !code added on July 11 2013 for Anadarko Heidelberg reduced perforations !skin_frac(layer)=log(lfrw(layer)/2)-log(lf(layer)/2)!+(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)*Rl_vert(layer)!+skin_frac_delp(layer) End Do !*************************************************************************************************************************************** ! Find initial skin distribution between the layers !*************************************************************************************************************************************** !entire code below commented out on July 11 2013 ! if (ltnum > 1) then ! ! amin = 0.0001 ! amax = 1 ! tolerance = 1E-17 ! (1E-17) ! a_range_flag = 0 ! loop: Do while (a_range_flag == 0 .or. amin==0) ! amin=amin/10.0 ! amax = amax * 10.0 ! fn1 = -kh_mu / (Log(re / rw) + skin_ini) ! fn2 = -kh_mu / (Log(re / rw) + skin_ini) ! Do i=1,ltnum ! fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + amin + skin_frac(i)) ! fn2 = fn2 + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + amax + skin_frac(i)) ! end do ! If (fn1 >= 0 .And. fn2 <= 0) Then ! a_range_flag = 1 ! End If ! If (fn1 <= 0 .And. fn2 >= 0) Then ! a_range_flag = 1 ! End If ! If (abs(fn1) <= tolerance) Then ! a = amin ! go to 10 ! a value has been found therefore no need to compute a ! End If ! If (abs(fn2) <= tolerance) Then ! a = amax ! go to 10 ! a value has been found therefore no need to compute a ! End If ! end do loop ! !Now that amin and amax have been determined (a_range_flag == 1) we find a where by fn < tolerance ! ! fn = 0 ! loop_1: Do j=1,50 ! a = 0.5 * (amin + amax) ! fn = -kh_mu / (Log(re / rw) + skin_ini) ! fn1 = -kh_mu / (Log(re / rw) + skin_ini) ! Do i = 1,ltnum ! fn = fn + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + a + skin_frac(i)) ! fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + amin + skin_frac(i)) !May 2013 ! end do ! If (Abs(fn) < tolerance) Then ! Exit loop_1 ! End If ! If (Sign(1.0,fn) == Sign(1.0,fn1)) Then ! amin = a ! ElseIf (Sign(1.0,fn) /= Sign(1.0,fn1)) Then ! amax = a ! ElseIf (fn == 0) Then ! Exit loop_1 ! End If ! end do loop_1 ! ! else ! ! a = skin_ini-skin_frac(1) ! ! endif ! 10 Do i = 1,ltnum ! skin0(i)=skin_frac(i)+a !used when the skin input is the actual skin ! March 2013 Anadarko K-2 field FracPack phase II study (layer skin = skin due to frac pack) ! April 2013 layer skin = Initial well skin (distributed evenly) - Initial fracture skin skin0(i)=skin_frac(i)+skin_ini !used when the skin input is not the actual skin but denotes some damage in the frac pack / fracture end do !Chevron Tahiti IS001 A10/A20 !skin0(1)=25.16 !skin0(2)=17.3 !skin0(3)=25.16 !skin0(4)=17.3 !Chevron Tahiti IS001 B40 !skin0(1)=97.4 !skin0(2)=97.4 !Chevron Tahiti IS002 A10/A20 !skin0(1)=39.28 !skin0(2)=41 !skin0(3)=39.28 !skin0(4)=41 !Chevron Tahiti IS002 B40 !skin0(1)=356.78/3.0 !skin0(2)=356.78/3.0 !*************************************************************************************************************************************** Write(192,110) 0, skin0 ! writing layer initial skin Write(99,*) Write(*,*) do layer = 1,ltnum Write(99,*) 'In layer',layer !write(99,*) 'The skin due to pr. drop in frac = ',skin_frac_delp(layer) write(99,*) 'The skin due to frac w/o well skin = ', skin_frac(layer) write(99,*) 'The final initial skin due to frac and well = ', skin0(layer) Write(99,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' Write(*,*) 'In layer',layer !write(*,*) 'The skin due to pr. drop in frac = ',skin_frac_delp(layer) write(*,*) 'The skin due to frac w/o well skin = ', skin_frac(layer) write(*,*) 'The final initial skin due to frac and well = ', skin0(layer) Write(*,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' end do Rl0tot=0 Do layer=1,ltnum if (swi(layer)==1) then RL0(layer) = (log(re/rw)+skin0(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/mwi(layer)) else RL0(layer) = (log(re/rw)+skin0(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/mor(layer)) endif Rl0tot=Rl0tot+1/RL0(layer) End Do Rl0tot=1/Rl0tot excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr_ini(layer)/rl0(layer) end do Do layer=1,ltnum ql(layer) = Rl0tot/RL0(layer)*(q0+excess_q-excess_res_pr_ini(layer)/Rl0tot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC !ql(layer) = Rl0tot/RL0(layer)*q0 !USE THIS FOR WHEN LAYER PRESSURES ARE HYDROSTATIC (THIS SHOULD BE A SPECIAL CASE OF THE ABOVE) !ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) End Do !Write(1,*) q0*543439.6331,a !Write(1,*) skin_ini, a, ql(1)*543439.6331 !skin_ini=skin_ini+0.1 !q0=q0+10/543439.6331 !end do Write(99,*) Write(*,*) Write(99,*) 'After including skin the flow distribution is as followed:' Write(*,*) 'After including skin the flow distribution is as followed:' do layer = 1,ltnum Write(99,*) 'In layer',layer Write(99,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' Write(*,*) 'In layer',layer Write(*,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' end do !----------------------------------------------------------------------------------------------- ! Making the layer flow resistance equal to the initial flow resistance in case it is needed !----------------------------------------------------------------------------------------------- Do layer=1,ltnum Lfold(layer)=lf(layer) rl(layer)=rl0(layer) end do rtot=rl0tot !------------------------------------------------------------------------------------------------------- ! Initialize Filtration coefficient and sigma for internal filtration !------------------------------------------------------------------------------------------------------- Do layer=1,ltnum qlhist(layer,counter)=max(0.0,ql(layer)) !qlhist(layer,counter)=ql(layer) vda(layer,:)=max(0.0,ql(layer))/Aface(layer) dummy=0 !dummy used instead of ql as av_q_tot is used instead of q in calculating vda. if (perf_ck(layer)==1) then If (fcae(layer)) Then ! 1 means auto evaluate i.Y. calculate filtration coeff using program !using av_q_tot for calculating filtration coefficient !dummy = Rl0tot/RL0(layer)*(av_q_tot+excess_q-excess_res_pr_ini(layer)/Rl0tot) !allowing for any cross flow !for the filtration coefficient cross flow is ignored !dummy = max(1/543439.6331, dummy) !Converts minimum rate to 0.1 bpd in case there is crossflow (from reservoir to the well) !done for getting constant filtration coefficient for Rosebank BHP constraint runs Jan 2013 when injection rates are read from file !dummy = Rl0tot/RL0(layer)*av_q_tot dummy = Rl0tot/RL0(layer)*q0 !May 2013 vda(layer,:)=dummy/Aface(layer) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vda(layer,1)**(np-1) !Note vda would decrease with increase in lf, and so mu will increase and so lambda will?? if (vda(layer,1)>0) then lambda0(layer,:) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,1),pm(layer)) if (lambda0(layer,1)==0) then !velocity > critical velocity lambda0(layer,:) = 0.1 end if else lambda0(layer,:) = 0 end if !commented out Ajay Oct 2013 !if (c0_oil>0) then if (vda(layer,1)>0) then lambda0_oil(layer,:)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,1),pm(layer)) if (lambda0_oil(layer,1) == 0 ) then lambda0_oil(layer,:) = 0.1 ! April 2013 end if else lambda0_oil(layer,:) = 0 end if !----------------- Jongsoo 201309 Start ------------------- !else ! lambda0_oil(layer,:) = 0 !----------------- Jongsoo 201309 End --------------------- !end if Else lambda0(layer,:) = fc(layer) ! Determined by user !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda0_oil(layer,:) = fco(layer) ! Determined by user !endif End If endif End Do !------------------------------------------------------------------------------------- lambda(:,:) = lambda0(:,:) ! The filtration coeff = Initial filtration coeff (only solid particles, excluding oil) !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(:,:) = lambda0_oil(:,:) !------------ Jongsoo 201309 Start ----------- !else ! lambda_oil(:,:) = lambda0_oil(:,:) !------------ Jongsoo 201309 End ------------- !endif !------------------------------------------------------------------------------------------------------------- ! Calculating the length of damage based on the initial filtration coefficient only for the perforated layers !------------------------------------------------------------------------------------------------------------- L = 0.01 ! 1 cm is the minimum length of damage do i = 1, ltnum if (perf_ck(i)==1 .AND. lambda(i,1) /= 0) then if (log(10000.0)/lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = log(10000.0)/lambda(i,1) end if end if end do if (L>100) then !Max L is 100 meters modified on april 2012 L = 100 endif if (rf > L) then !L is overwritten by the User specified depth of damage (if it is more than L) L = rf endif !------------------------------------------------------------------------------------------------------ ! Initializing transition time (if internal filtration is allowed then it is equal to -1, otherwise = 0 ! Creating Ns discretized segments with equal lengths for internal damage !------------------------------------------------------------------------------------------------------ Call Inittt ! Initialize the check for transition time dx = L/Ns ! Slice of the damaged core perpendicular to the fracture face, m sigma(:,:) = Dble(0.0) ! The specific deposit = 0 lambda00(:) = lambda0(:,1) ! This value is written out as the lambda of the layer lambda00_oil(:) = lambda0_oil(:,1) ! This value is written out as the lambda of the layer !-------------------------------------------------------------------------------------------- ! Permeability profile perpendicular to the fracture. !-------------------------------------------------------------------------------------------- !open (Unit=21, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles If (out_pp==1) Then Do j=1,ltnum k(j,:)=kmh(j) Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md End Do endif Write(21,*) sum_lambda(:,:)=0 !May 2013 sum_lambda_oil(:,:)=0 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! Time loop Begins ! Injection of water into the layers start !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !tt1 = 3600 ! The first time step is fixed and equal to 1 hour tt1 = dt ! The first time step is equal to the time step if (dt>dt_max) then dt = dt_max ! The largest time step allowed is 1 day, i.Y. 86400 seconds endif !bhpconverge =1 Do t=tt1,t_max*86400,dt !PGF frac calculations time loop begins !if (t/86400>=988.9167) then ! Write(*,*) 'Time is = ',t/86400 !endif !tt2=tt1/86400/365 !tt2 in years qold=q !--------------------------------------------------------------------- ! Setting the injection stage according to the current injection time !-------------------------------------------------------------------- !Injection parameter based on the next injection stage. Stage: do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400 .AND. i>present_stage) Then trans(:)=1 q0=flow_rate(i) if (ck_dipping==1) then q0=2*q0 else q0=q0 end if q=q0 rhop=den_p(i) rhol=den_f(i) rhooil=den_oil(i) kp=kp_in(i) np=np_in(i) kpt=kpt_in(i) npt=npt_in(i) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif c0=p_conc(i) dp=p_dia(i) c0_oil=conc_oil(i) doil=oil_dia(i) coal_fr=coal(i) kc=cake_perm(i) pc=cake_por(i) present_stage=i exit stage endif end do stage c0hist(counter)=c0 c0_oilhist(counter)=c0_oil coal_frhist(counter)=coal_fr ! The code below should be active only when reading the injection rates from an input file ! Petrobras-Guando-ARIN3-GUA-096.tmp , GUA-024A-q.txt have injection rate profile ! Nexen-C1.tmp have injection rate and reservoir pressure profile ! Bigfoot-SW23.tmp next injection rate if (hist_inj_rates == 1) then q0=q1(counter) ! Note the first time step t=tt1, the counter is 1 and the rate is the same as before (just a repeat) if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else pres=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if end if if (ck_dipping==1) then q0=2*q0 else q0=q0 end if q=q0 end if ! The above code should be active only when reading the injection rates from an input file !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Code included on Jan 25 2012 for Chevron Tahiti project if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then res_pr(1)=pres_multiple(1,counter) ! used for Chevron Tahiti Project 2012 for updip and downdip different reservoir pressures. else res_pr(1)=pres_1(counter) ! for reading only the top layer reservoir pressure and others are assumed to be hydrostatic end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,counter) !for Chevron Tahiti Project 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) !hydrostatic pressure is assumed for historical reservoir pressure input end if end do sum_excess_res_pr=0 do i = 1,ltnum excess_res_pr(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) sum_excess_res_pr=sum_excess_res_pr+excess_res_pr(i) end do else do i = 1,ltnum excess_res_pr(i)=excess_res_pr_ini(i) end do end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Changing the layer flow rate distribution according to the new flow rate if it is different from the previous flow rate ! For the previous flow rate the distribution is done using the same resistances as they are now. if (q/=qold) then trans(:)=1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC !ql(layer) = q*Rtot/Rl(layer) !ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0.1 bpd in case there is crossflow (from reservoir to the well) qlhist(layer,counter)=max(0.0,ql(layer)) !qlhist(layer,counter)=ql(layer) vda(layer,:) = max(0.0,ql(layer))/Aface(layer) End Do end if !------------------------------------------------------------------------------------------------------- ! Recalculating the Filtration coefficient May 2013 !------------------------------------------------------------------------------------------------------- Do layer=1,ltnum dummy=0 !dummy used instead of ql as av_q_tot is used instead of q in calculating vda. if (perf_ck(layer)==1) then If (fcae(layer)) Then ! 1 means auto evaluate i.e. calculate filtration coeff using program !dummy = Rtot/Rl(layer)*av_q_tot dummy = Rtot/Rl(layer)*q Aface(layer) = 4*tst(layer)*Lf(layer) !Recalculating the fracture face area vda(layer,:)=dummy/Aface(layer) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vda(layer,1)**(np-1) !Note vda would decrease with increase in lf, and so mu will increase and so lambda will?? if (vda(layer,1) > 0) then lambda(layer,:) = lambda0c(dp,dg(layer),rhop,rhol,mu,vda(layer,1),pm(layer)) if ( lambda(layer,1) == 0 ) then lambda(layer,:) = 0.1 end if else lambda(layer,:) = 0 endif !commented out Ajay Oct 2013 !if (c0_oil>0) then if (vda(layer,1) > 0) then lambda_oil(layer,:)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vda(layer,1),pm(layer)) if (lambda_oil(layer,1) == 0 ) then lambda_oil(layer,:) = 0.1 ! April 2013 end if else lambda_oil(layer,:)=0 endif !----------------- Jongsoo 201309 Start ------------------- !else ! lambda0_oil(layer,:) = 0 !----------------- Jongsoo 201309 End --------------------- !endif Else lambda(layer,:) = fc(layer) ! Determined by user !commented out Ajay Oct 2013 !if (c0_oil>0) then lambda_oil(layer,:) = fco(layer) ! Determined by user !endif End If endif End Do do layer = 1, ltnum sum_lambda(layer,1)=sum_lambda(layer,1)+lambda(layer,1) sum_lambda_oil(layer,1)=sum_lambda_oil(layer,1)+lambda_oil(layer,1) end do do layer = 1, ltnum avg_lambda(layer,:)=sum_lambda(layer,1)/counter avg_lambda_oil(layer,:)=sum_lambda_oil(layer,1)/counter end do lambdahist(:,counter)=lambda(:,1) lambda_oilhist(:,counter)=lambda_oil(:,1) L = 0.01 ! 1 cm is the minimum length of damage do i = 1, ltnum if (perf_ck(i)==1 .AND. avg_lambda(i,1) /= 0) then if (log(10000.0)/avg_lambda(i,1) > L) then !The conc of particles reduces by 10000 times at this distance L = log(10000.0)/avg_lambda(i,1) end if end if end do if (L>100) then !Max L is 100 meters modified on april 2012 L = 100 endif if (rf > L) then !L is overwritten by the User specified depth of damage (if it is more than L) L = rf endif !commented out Ajay Oct 2013 !write(99,*) "lambda(:,1)", lambda(:,1) !write(99,*) "avg_lambda(:,1)",avg_lambda(:,1) !write(99,*) "L",L !write(99,*) !----------------------------------------------------------------------------------------- ! Calculating fracture length in each layer ! The fracture length depends on the tip pressure which should be less than ! the fracturing pressure. The fracturing pressure is determined by the minimum ! horizontal stress and one another term as given by equation (3.29) in UTWID user manual. !----------------------------------------------------------------------------------------- Do layer=1,ltnum if (t==tt1) then Wi(layer)=Wi(layer)+ql(layer)*tt1 ! layer rate*dt in a layer->cumulative layer injected volume cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*tt1*c0 ! Cum vol of solids injected in a layer cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr) ! Cum vol of oil injected in a layer cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected in a layer cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1)! Cum vol of oil injected in a layer else Wi(layer)=Wi(layer)+ql(layer)*dt ! Cumulative rate*dt in a layer cum_parr(layer)=cum_parr(layer)+max(0.0,ql(layer))*dt*c0 ! Cum vol of solids injected in a layer cum_oill(layer)=cum_oill(layer)+max(0.0,ql(layer))*dt*c0_oil*(1-coal_fr) ! Cum vol of oil injected in a layer cum_parr_lambda(layer)=cum_parr_lambda(layer)+max(0.0,ql(layer))*tt1*c0*lambda(layer,1) ! Cum vol of solids injected in a layer cum_oill_lambda(layer)=cum_oill_lambda(layer)+max(0.0,ql(layer))*tt1*c0_oil*(1-coal_fr)*lambda_oil(layer,1)! Cum vol of oil injected in a layer end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vda(layer,i)**(np-1) !Code added for Chevron Tahiti IS001 A10/A20 changing min horizontal stress (near wellbore up to 2 ft 0.85 psi/ft) and beyond 0.786 psi/ft) ! if (lf(layer)>=2.0/3.2808) then ! if (layer==1) then ! Sigmamin(layer) = 18380*6895 !Updip IS001 A10 Sigma hmin for Chevron Tahiti Feb 2012 ! else if (layer==2) then ! Sigmamin(layer) = 18420*6895 !Updip IS001 A20 Sigma hmin for Chevron Tahiti Feb 2012 ! else if (layer==3) then ! Sigmamin(layer) = 19182*6895 !Downdip IS001 A10 Sigma hmin for Chevron Tahiti Feb 2012 ! else if (layer==4) then ! Sigmamin(layer) = 19221*6895 !Downdip IS001 A20 Sigma hmin for Chevron Tahiti Feb 2012 ! end if ! end if Call PGFellipse2(wt,realct,perf_ck(layer),skin0(layer)-skin_frac(layer),np,kp,npt,kpt,be,lw(layer),ecc(layer),layer,ltnum,dip(layer),frac_grad(layer),stress_change_pore_pressure(layer),& max(0.0,Wi(layer)),max(0.0,Cum_parr(layer)),max(0.0,Cum_oill(layer)),max(0.0,Cum_parr_lambda(layer)),max(0.0,Cum_oill_lambda(layer)),Ns,dx,avg_lambda(layer,:),avg_lambda_oil(layer,:),lambdahist(layer,:),lambda_oilhist(layer,:),pm(layer),pcr(layer),ql(layer),& qlhist(layer,:),dt,counter,trans(layer),c0,c0hist,c0_oil,c0_oilhist,coal_fr,coal_frhist,dg(layer),dp,doil,kmh(layer),& df(layer),t,pc,kc,U,n(layer),Y(layer),Tw(layer),Tr(layer),& Swi(layer),Sor(layer),rhol,rhoo(layer),rhog(layer),Chw(layer),Cho(layer),Chg(layer),B(layer),ds,rp,re,rw,tst(layer),& pres_ini+excess_res_pr_ini(layer),pres+excess_res_pr(layer),kro(layer),krw(layer),mor(layer),mwi(layer),mu,sigmamin(layer),ck_dipping,cgr(layer),ctot(layer),lfrw(layer),avgwfp(layer),& fp_por(layer),lfold(layer),lfhist(layer,:),fracture_closure,& ! Up to here all are input variables lf(layer),cum_parr_lf(layer),cum_oill_lf(layer),maj_axis_w(layer),min_axis_w(layer),maj_axis_p(layer),& min_axis_p(layer),maj_axis_t(layer),& min_axis_t(layer),maj_axis_D(layer),min_axis_D(layer),dst(layer),dsp(layer),Sminh(layer),Ptip(layer),& Pfrac(layer),Piwf(layer),delp1(layer),delp2(layer),delp3(layer),delp4(layer),delptrans(layer),delpint(layer),& delpcc(layer),& delpud(layer),delps_ini(layer),delpf(layer),wf(layer),delpp(layer),res1(layer),res2(layer),res3(layer),res4(layer),& rint(layer),rcc(layer),rud(layer),rskin(layer),resf(layer),resp(layer),tt(layer),hc(layer),k(layer,:)) Lfold(layer)=lf(layer) !setting the old fracture length equal to the newly calculated fracture length End Do ! End of layer loop !------------------------------------------------------------------------------------------------- ! New resistivities calculated based on the new fracture lengths, fronts and cakes !------------------------------------------------------------------------------------------------- !commented out Rl_vert Ajay Oct 2013 !Call calc_Rl_vert ! Calculates new vertical flow resistance for all the unperforated layers using new fracture lengths Rtot=0 Do layer=1,ltnum Rl(layer)=Res1(layer)+Res2(layer)+Res3(layer)+Res4(layer)+max((Rint(layer)-Rud(layer)),0.0)+Rcc(layer)+Rskin(layer)+Resf(layer)+Resp(layer)!+Rl_vert(layer) commented out Ajay Oct 2013 Rtot=Rtot+1/Rl(layer) End Do Rtot=1/Rtot !----------------------------------------------------------------------------------------------- ! Calculate the bottom hole pressure at the end of this time step with the old value of flow rate in each layer. ! Do layer=1,ltnum ! Piwf(layer)=pres+Rl(layer)*ql(layer) ! end do !----------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------- ! New flow rates in the layers are calculated based on the new fracture length and new resistance in the layer ! for this time step !--------------------------------------------------------------------------------------------------------------------- counter=counter+1 excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC !ql(layer) = q*Rtot/Rl(layer) !ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) qlhist(layer,counter)=max(0.0,ql(layer)) ! Storing the current flow rate !qlhist(layer,counter)=ql(layer) ! Storing the current flow rate lfhist(layer,counter)=lf(layer) ! Storing the current frac length vda(layer,:) = max(0.0,ql(layer))/Aface(layer) End Do !----------------------------------------------------------------------------------------------- ! Calculate the bottom hole pressure at the end of this time step with the new value of flow rate in each layer. Do layer=1,ltnum Piwf(layer)=(pres+excess_res_pr(layer))+Rl(layer)*ql(layer) end do !----------------------------------------------------------------------------------------------- Piwfdd=0 sumofBHPaveraginglayers = 0 Do layer=1,ltnum if (perf_ck(layer) == 1) then sumofBHPaveraginglayers = sumofBHPaveraginglayers + 1 Piwfdd=piwf(layer)+Piwfdd end if End Do Piwfdd=Piwfdd/sumofBHPaveraginglayers !calculating the average injection pressure in the layers !----------------------------------------------------------------------------------------------- avg_pres=0 do i = 1,ltnum avg_pres = avg_pres+(pres+excess_res_pr(i)) end do avg_pres=avg_pres/ltnum !----------------------------------------------------------------------------------------------- ! Calculating the well skin using skin in each layer due to additional pressure drops ! The pressure drops are delpint, delpcc, delpf and the initial delpskin_ini is also added !----------------------------------------------------------------------------------------------- !write(99,*) do layer = 1, ltnum delpstot=delps_ini(layer)+(delpint(layer)-delpud(layer))+delpcc(layer)+delpf(layer) if (max(0.0,ql(layer))==0) then skin(layer)=log(2*rw/lf(layer)) else skin(layer)=delpstot/max(0.0,ql(layer))*(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)+log(2*rw/lf(layer)) end if end do dummy1=0 do layer = 1, ltnum !dummy1=dummy1+(kmh(layer)*krw(layer)*tst(layer)/kp)*(piwfdd-(pres+excess_res_pr(layer)))/(log(re/rw)+skin(layer)) dummy1=dummy1+(kmh(layer)*krw(layer)*tst(layer)/kp)/(log(re/rw)+skin(layer)) end do !skintot=kh_mu*(Piwfdd-avg_pres)/dummy1-log(re/rw) skintot=kh_mu/dummy1-log(re/rw) !write(99,*) !write(99,*) 'At time t = ',t/86400,' skin is = ',skintot !----------------------------------------------------------------------------------------------- !Writing to The Output Files !----------------------------------------------------------------------------------------------- 100 FORMAT (500E13.5) 110 FORMAT (500F14.4) ! Writing delp in the layers with time do i = 1, ltnum ! if (fileopencounter == 0) then ! end if Write(170+i,110) t/86400, delp1(i)*0.0001450377, delp2(i)*0.0001450377, delp3(i)*0.0001450377, delp4(i)*0.0001450377, delptrans(i)*0.0001450377, (delpint(i)-delpud(i))*0.0001450377, delpcc(i)*0.0001450377, delpud(i)*0.0001450377, delps_ini(i)*0.0001450377, delpf(i)*0.0001450377, delpp(i)*0.0001450377, Ptip(i)*0.0001450377, Pfrac(i)*0.0001450377, Sminh(i)*0.0001450377, sigmamin(i)*0.0001450377, dst(i)*0.0001450377, dsp(i)*0.0001450377 !Write(170+i,110) t/86400, res1(i)*0.0001450377, res2(i)*0.0001450377, res3(i)*0.0001450377, res4(i)*0.0001450377,(rint(i)-rud(i))*0.0001450377,rcc(i)*0.0001450377,resf(i)*10e-10, resp(i)*0.0001450377 end do !Writing layer no, transition time, filtration coefficient and specific deposit do i = 1, ltnum Write(39+i,110) t/86400,tt(i)/86400,avg_lambda(i,1),avg_lambda_oil(i,1) end do Write (871,110) t/86400,maj_axis_t*3.28 !writing the major axes of the thermal fronts in ft ! open (unit=872, NAME="min_axis_thermal.tmp", Action='Write') Write (872,110) t/86400,min_axis_t*3.28 !writing the minor axes of the thermal fronts in ft ! open (unit=873, NAME="maj_axis_polymer.tmp", Action='Write') ! Write (873,110) t/86400,maj_axis_p*3.28 ! open (unit=874, NAME="min_axis_polymer.tmp", Action='Write') ! Write (874,110) t/86400,min_axis_p*3.28 ! open (unit=875, NAME="maj_axis_Darcy.tmp", Action='Write') ! Write (875,110) t/86400,maj_axis_D*3.28 ! open (unit=876, NAME="min_axis_Darcy.tmp", Action='Write') ! Write (876,110) t/86400,min_axis_D*3.28 Write (9,110) t/86400, maj_axis_w*3.28 !writing the major axes of the waterflood fronts in ft ! open (unit=10, NAME="min_axis_waterflood.tmp", Action='Write') Write (10,110) t/86400, min_axis_w*3.28 !writing the minor axes of the waterflood fronts in ft if (ck_dipping==1) then if (q0>1/543439.6331) then Write(17,110) t/86400, q0/2*543439.6331/((piwfdd-avg_pres)/6894.76) !qold*543439.6331/((piwfdd-pres)/6894.76) ! writing well injectivity bpd/psi else Write(17,110) t/86400, 0 end if else if (q0>1/543439.6331) then Write(17,110) t/86400, q0*543439.6331/((piwfdd-avg_pres)/6894.76) !qold*543439.6331/((piwfdd-pres)/6894.76) ! writing well injectivity bpd/psi else Write(17,110) t/86400, 0 end if endif qold=q0 Write(129,110) t/86400, Piwfdd*0.0001450377 !writing bottom hole pressure in psi Write (16,110) t/86400, Pfrac*0.0001450377 ! writing current min horizontal stress (psi) Write (18,110) t/86400, Ptip*0.0001450377 ! writing pressure at the fracture tip (psi) If (out_pp==1) Then Do j=1,ltnum Write(21,110) t/86400, k(j,:)*1e15 ! Permeability in md End Do endif Write(21,*) do j=1,ltnum kavg(j)=0 ksum=0 do i = 1,Ns ksum=ksum+L/Ns/k(j,i) end do kavg(j)=L/ksum end do ! open (Unit=192, NAME="kdamage_for_GEM.tmp", Action='Write') ! Write(192,110) t/86400, kavg(:)*1e15 ! writing avg damage zone perm in md ! open (Unit=193, NAME="Ldamage_for_GEM.tmp", Action='Write') ! Write(193,110) t/86400, L*1000.0 ! writing damage zone depth in mm ! open (Unit=194, NAME="kcake_for_GEM.tmp", Action='Write') ! Write(194,110) t/86400, kc ! writing cake perm in md ! open (Unit=195, NAME="Lcake_for_GEM.tmp", Action='Write') ! Write(195,110) t/86400, hc*1000.0 ! writing external cake thickess in mm Write(196,110) t/86400, wf*1000.0 ! writing maximum width of the fracture in mm Write(8,110) t/86400, skintot ! writing skin Write(11,110) t/86400, lf*3.28 ! time in days and fracture length in ft if (ck_dipping==1) then Write(187,110) t/86400, ql/2*543439.6331 ! writing flow rate in each layer (bpd) else Write(187,110) t/86400, ql*543439.6331 ! writing flow rate in each layer (bpd) endif if (q0/=0) then ! total well injection rate not equal to 0 Write(188,110) t/86400, ql/q0 ! writing fraction of total flow rate in each layer else ! total well injection rate = 0 qltemp=1 Write(188,110) t/86400, qltemp ! writing fraction of total flow rate=0 for all the layers end if Write(189,110) t/86400, piwf*.000145 ! writing layer bottom hole pressure in psi Write(190,110) t/86400, cum_parr ! Cumulative particles injected Write(191,110) t/86400, hc*1000 ! writing external cake thickess in mm Write(192,110) t/86400, skin ! writing layer skin !if (Bhpconverge <10) then ! Bhpconverge = Bhpconverge + 1 ! goto 108 !end if !Bhpconverge = 1 fileopencounter = 1 End Do !end of frac calculations time loop !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Time loop Ends !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ End Subroutine calc_V_frac !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! End of Subroutine !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! Added by Ajay on Dec 13 2006 ! Starting point: Made a copy of Sub Calc_fracpac ! Changes are based on Fracpac Flow.doc !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Subroutine calc_V_fracpack() real(8), External :: PermDecl ! The filtration coefficient is calculated at 2 places in the pgm: ! One at the starting to calculate the initial filtration coefficient ! Second inside the injection time loop ! Always check for these places for accurate filtration coefficient values character(240) :: layer_names, segment_names, dummy_name !Added since flood calculations are done inside with frac length=Lfp which earlier was calculated outside the Sub real(8) :: & Vcool, & ! Cumulative Cooled zone Volume Vcw, & ! Cumulative Waterflood zone Volume rc, & ! Radius of cooled zone rz, & ! Radius of Waterflood zone dTemp, & ! DeltT dppr, & ! dp for poroelastic stress avg_res_pr_change,& ! Change in average reservoir pressure F1, & ! thermal ellipse geometric properties P&G 1985 F2, & ! for waterflood ellipse aa, & ! major axis of an imaginary ellipse far field boundary bb, & ! minor axis of an imaginary ellipse far field boundary acool, & ! major axis of cool ellipse bcool, & ! minor axis of cool ellipse ainj, & ! major axis of injection front ellipse binj, & ! minor axis of injection front ellipse acw, & ! major axis of connate water ellipse bcw, & ! minor axis of connate water ellipse TERM2A, & ! for Eqn 5A in P&G 1985 TERM2B, & ! for Eqn 5A in P&G 1985 TERM2C, & ! for Eqn 5A in P&G 1985 TERM2, & ! for Eqn 5A in P&G 1985 Ji ! real(8) :: & skin_frac, & ! skin rwp, & ! equivalent radius of damaged well in frac inj calculations alphfrc, & ! injectivity of a plugged fracture Piwfdd,& idealdp, & !ideal dp (with out skin or fracture from darcy law) idealdp_prats, & !ideal dp of an infinitely conductive fracture with Prats solution realdp, & !ideal dp (with out skin or fracture from darcy law) dp_fronts(ltnum), & !dp due to the fronts loopy Integer :: i,j,k,k1,points_counter, counter = 1 ! Counters Integer :: layer, ii, present_stage, Nc(ltnum), ptip_flag real(8)::dummy !reads first column as injection days from Bonga input file real(8)::initial_dp !initial deltaP taking into account initial skin in frac case real(8):: pi=3.14159 real(8):: initial_injectivity, injectivity_1_hour, injectivity_1_day !injectivites real(8):: sig_kh real(8)::tt1 real(8) ::dumpar1,dumpar2,dumpar3,dumpar4,dumpar5,dumpar6,dumpar7,dumpar8,dumpar9,dumpar10,dumpar11,dumpar12 real(8)::dummparr1,dummparr2,dummparr3 ! Added by Ajay on Dec 13 2006 real(8)::Resis,hcgrav(ltnum,Ns),Rcgrav(ltnum,Ns),hccore(ltnum,Ns+1),Rccore(ltnum,Ns+1), pfplow, pfphigh real(8)::delpfplinear(ltnum,Ns),delpfpo(ltnum,Ns+1) ! Added by Ajay on Feb 19 2007 real(8):: dpnet(ltnum,0:Ns), dwfp(ltnum,0:Ns), bfp(ltnum), wfpini(ltnum,0:Ns), kggGravel(ltnum,1:Ns), kchannel(ltnum,1:Ns+1), wc(ltnum,0:Ns),wc_prev(ltnum,0:Ns),kggnew(ltnum,Ns) real(8),Dimension(:,:) :: pfp(ltnum,0:Ns+1), pfpnew(ltnum,0:Ns+1), pfpstar(ltnum, 0:Ns+1), ttg(ltnum,Ns+1), wfpnew(ltnum,0:Ns) ! Added by Ajay on Apr 12 2007 real(8)::temp,dpctip,pfpnext,kggeff,dpc,dx,fp_avg_por(ltnum,Ns),rrfgnew(ltnum,Ns),afracnew(ltnum,Ns) real(8)::RrfgD(ltnum,Ns),RrfgND(ltnum,Ns),RrfgnewD(ltnum,Ns),RrfgnewND(ltnum,Ns) real(8)::pre_sigmafp_in_solid, pre_sigmafp_in_oil, delta_sigmagf, delta_sigmagf_oil,dummy1,dummy2 real(8)::Eff_M,sum,pdss !transient multirate injection well pressure calculation real(8)::Rideal, RLideal(ltnum) !Ideal flow resistances (well, layer) real(8)::Res_perm(1:Ns+1) !Sum of reservoir perm perpendicular to a frac-pack segment real(8)::dh(ltnum) !difference in depth between the top layer and the respective layer real(8)::excess_res_pr(ltnum) !excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_res_pr_ini(ltnum) !excess pore pressure in a layer (compared to the hydrostatic in the well) real(8)::excess_q !excess q (flow rate) from the over-pressured layers real(8)::avg_pres real(8)::a_prats !Prats "a" integer::flag,a_range_flag !flag = 1 if a_prats>10, otherwise = 0, a_range_flag is for distributing skin of the well to its layers real(8)::kh_mu,lf0(ltnum), amin,amax,a,sum_excess_res_pr,tolerance,fn,fn1,fn2,delpstot,skin_frac_pack(ltnum),skin_frac_delp(ltnum) real(8)::skin0(ltnum),skin(ltnum),resf_ini(ltnum),delpfp_ellipse(ltnum) real(8)::Rcore0_forskin(ltnum,1:Ns+1),Rfracpack0_forskin(ltnum),Rwell0_forskin(ltnum),Rfp_ellipse0(ltnum),riwm_forskin(ltnum) real(8)::Rrf_forskin(ltnum,1:Ns+1),Rcore_forskin(ltnum,1:Ns+1),Rfracpack(ltnum),Rwell(ltnum),Rfp_ellipse(ltnum),skintot real(8)::cg(ltnum,0:Ns), cg_oil(ltnum,0:Ns) real::pd,td ! made real from real(8) on June 30 2012 ! ----- Jongsoo 201309: Start ----- Real::E1 ! ----- Jongsoo 201309: End ----- !----------------------------------------------------------------------------------------------- ! The following code was added on Oct 10 2010 for adding headers to the output files ! Making a string that has layer names in it layer_names = " Time(days) " do i = 1, ltnum dummy_name=trim(lname(i)) layer_names=trim(layer_names)//" "//trim(dummy_name) end do segment_names = " Segment No. " do i = 1, ltnum dummy_name=trim(lname(i)) segment_names=trim(segment_names)//" "//trim(dummy_name) end do 60 FORMAT(A125) 70 FORMAT(A100) 80 FORMAT(A95) 90 Format(A200) !May 2013 tst_sum=0 do i = 1, ltnum tst_sum=tst_sum+tst(i) end do !----------------------------------------------------------------------------------------------- do layer = 1, ltnum !----------------------------------------------------------------------------------------------- ! Output files numbers ! Maximum number of layers considered is 100 for setting the numbers below. !----------------------------------------------------------------------------------------------- ! lambdafp: 1 - 100 ! lambdafpo: 101 - 200 ! lambdawm: 201 - 300 ! kfp: 301 - 400 ! kfpo: 401 - 500 ! kwm: 501 - 600 ! hfp: 601 - 700 ! hfpo: 701 - 800 ! hwm: 801 - 900 ! Rfp: 901 - 1000 ! Rfpo: 1001 - 1100 ! Rwm: 1101 - 1200 ! R: 1201 - 1300 ! delp: 1301 - 1400 ! wfp: 1401 - 1500 ! pfp: 1501 - 1600 ! pnet: 1601 - 1700 ! qfp: 1701 - 1800 ! qfpo: 1801 - 1900 open (Unit=1+layer, NAME="Lambdafp "//trim(lname(layer))//".tmp", Action='Write') Write(1+layer,60) "This file outputs the filtration coefficient of the frac-pack segments in the layer by the file name" Write(1+layer,*) "Time(days) Filtration_coefficient(1/m) of the segments from 1st to Nth" open (Unit=50+layer, NAME="Damaged Porosity "//trim(lname(layer))//".tmp", Action='Write') Write(50+layer,60) "This file outputs the damaged porosity of the frac-pack segments in the layer by the file name" Write(50+layer,*) "Time(days) Filtration_coefficient(1/m) of the segments from 1st to Nth" ! open (Unit=100+layer, NAME="Lambdafpo "//trim(lname(layer))//".tmp", Action='Write') ! Write(100+layer,60) "This file outputs the filtration coeff.of the reservoir segments perp. to the frac-pack in the layer by the file name" ! Write(100+layer,*) "Time(days) Filtration_coefficient(1/m) of the segments from 1st to Nth" ! open (Unit=200+layer, NAME="Lambdawm "//trim(lname(layer))//".tmp", Action='Write') ! Write(200+layer,60) "This file outputs the filtration coefficient of the reservoir around the well in the layer by the file name" ! Write(200+layer,*) "Time(days) Filtration_coefficient(1/m) of the segments from 1st to Nth" open (Unit=250+layer, NAME="Particle Conc "//trim(lname(layer))//".tmp", Action='Write') Write(250+layer,60) "This file outputs the solids concentration in the frac-pack segments in the layer by the file name" Write(250+layer,*) "Time(days) TSS(mg/l) of the segments from 1st to Nth" ! open (Unit=300+layer, NAME="kfpnew "//trim(lname(layer))//".tmp", Action='Write') !open (Unit=310+layer, NAME="kfpnew "//trim(lname(layer))//".tmp", Action='Write') !Write(310+layer,80) "This file outputs the permeability of the frac-pack in the layer by the file name" !Write(310+layer,*) "Time(days) Permeability (Darcy) of each segment from 1st to Nth" !open (Unit=400+layer, NAME="kfpo "//trim(lname(layer))//".tmp", Action='Write') !Write(400+layer,60) "This file outputs the permeability of the reservoir perp. to the frac-pack in the layer by the file name" !Write(400+layer,80) "Time(days) Permeability (md) of each segment of the reservoir from 1st to Nth" !open (Unit=500+layer, NAME="kwm "//trim(lname(layer))//".tmp", Action='Write') !Write(500+layer,60) "This file outputs the permeability of the reservoir around the well in the layer by the file name" !Write(500+layer,80) "Time(days) Permeability (md) of each segment of the reservoir from 1st to Nth" !open (Unit=600+layer, NAME="hfp "//trim(lname(layer))//".tmp", Action='Write') !Write(600+layer,80) "This file outputs the cake thickness in and along the frac-pack in the layer by the file name" !Write(600+layer,80) "Time(days) Cake thickness (mm) in each segment of and along the frac-pack from 1st to Nth" !open (Unit=700+layer, NAME="hfpo "//trim(lname(layer))//".tmp", Action='Write') !Write(700+layer,70) "This file outputs the cake thickness in and perp. to the frac-pack in the layer by the file name" !Write(700+layer,70) "Time(days) Cake thickness (mm) in each segment of and perp. to the frac-pack from 1st to Nth" !open (Unit=800+layer, NAME="hwm "//trim(lname(layer))//".tmp", Action='Write') !Write(800+layer,80) "This file outputs the cake thickness in the well in the layer by the file name" !Write(800+layer,*) "Time(days) Cake thickness (mm) in the well" ! open (Unit=900+layer, NAME="Rfp "//trim(lname(layer))//".tmp", Action='Write') ! open (Unit=1000+layer, NAME="Rfpo "//trim(lname(layer))//".tmp", Action='Write') ! open (Unit=1100+layer, NAME="Rwm "//trim(lname(layer))//".tmp", Action='Write') ! open (Unit=1200+layer, NAME="R "//trim(lname(layer))//".tmp", Action='Write') open (Unit=1300+layer, NAME="delp "//trim(lname(layer))//".tmp", Action='Write') Write(1300+layer,60) "This file outputs the pressure drops in the various regions of the reservoir, thermal stress & pore pr. stress" Write(1300+layer,90)"Time(days) delp1(psi) delp2(psi) delp4(psi) delptrans(psi) delp_fp(psi) delps(psi) delpp(psi) Ptip(layer) Pfrac(layer) Sminh(layer) sigmamin(layer) dst(psi) dsp(psi)" !open (Unit=1400+layer, NAME="wfp "//trim(lname(layer))//".tmp", Action='Write') !Write(1400+layer,80) "This file outputs the width of the frac pack in the layer by the file name" !Write(1400+layer,*) "Time(days) Width of the frac-pack (mm) from 1st to the Nth segment" !open (Unit=1500+layer, NAME="pfp "//trim(lname(layer))//".tmp", Action='Write') !Write(1500+layer,80) "This file outputs the pressure in the frac pack in the layer by the file name" !Write(1500+layer,*) "Time(days) Pressure in the frac-pack (psi) from 1st to the Nth segment" ! open (Unit=1600+layer, NAME="pnet "//trim(lname(layer))//".tmp", Action='Write') !open (Unit=1700+layer, NAME="qfp "//trim(lname(layer))//".tmp", Action='Write') !Write(1700+layer,80) "This file outputs the flow rate in and along the frac pack in the layer by the file name" !Write(1700+layer,80) "Time(days) Flow rate in and along the frac-pack (bpd) from 1st to the Nth segment" !open (Unit=1800+layer, NAME="qfpo "//trim(lname(layer))//".tmp", Action='Write') !Write(1800+layer,80) "This file outputs the flow rate perpendicular to the frac pack in the layer by the file name" !Write(1800+layer,80) "Time(days) Flow rate perpendicular to the frac-pack (bpd) from 1st to the Nth segment" end do !---------------------------------------------------------------------------------------------------------- ! open (unit=5000, NAME="SweptVol_wf&tf.tmp", Action='Write') open (unit=5001, NAME="maj_axis_thermal.tmp", Action='Write') Write(5001,80) "This file outputs the major axis of the thermal front (ft) in all the layers" Write(5001,90) layer_names ! open (unit=5002, NAME="min_axis_thermal.tmp", Action='Write') ! Write(5002,80) "This file outputs the minor axis of the thermal front (ft) in all the layers" ! Write(5002,90) layer_names open (unit=5003, NAME="maj_axis_waterflood.tmp", Action='Write') Write(5003,80) "This file outputs the major axis of the waterflood front (ft) in all the layers" Write(5003,90) layer_names ! open (unit=5004, NAME="min_axis_waterflood.tmp", Action='Write') ! Write(5004,80) "This file outputs the minor axis of the waterflood front (ft) in all the layers" ! Write(5004,90) layer_names open (unit=5005, NAME="channel_length.tmp", Action='Write') Write(5005,80) "This file outputs the channel length in the frac pack in all the layers" Write(5005,90) layer_names open (Unit=5006, NAME="well_injectivity.tmp", Action='Write') Write(5006,*) "This file outputs the injectivity of the well" Write(5006,*) "Time(days) Well Injectivity (bpd/psi)" ! open (Unit=5007, NAME="layer_bhp.tmp", Action='Write') open (Unit=5008, NAME="Ptip.tmp", Action='Write') Write(5008,80) "This file outputs the pressure at the tip of the frac pack (psi) for all the layers" Write(5008,90) layer_names open (unit=5009, NAME="pfrac.tmp", Action='Write') Write(5009,80) "This file outputs the frac pack propagation pressure (psi) for all the layers" Write(5009,90) layer_names ! open (Unit=5010, NAME="ttwm.tmp", Action='Write') ! Write(5010,80) "This file outputs the transition/build up time for the cake in the well for all the layers" ! Write(5010,90) layer_names ! open (Unit=5011, NAME="ttfp.tmp", Action='Write') ! Write(5011,80) "This file outputs the transition time (days) for the cake in the frac pack for all the layers" ! Write(5011,70) "Time(days) Transition time for the cake build up in the frac-pack from 1st to the Nth segment" ! open (Unit=5012, NAME="ttfpo.tmp", Action='Write') ! Write(5012,80) "This file outputs the transition time (days) for the cake perp. to frac pack for all the layers" ! Write(5012,70) "Time(days) Transition time for the cake build up perp. to the frac-pack from 1st to the Nth segment" open (Unit=5013, NAME="frac_length.tmp", Action='Write') Write(5013,80) "This file outputs the frac pack length (ft) in all the layers" Write(5013,90) layer_names open (Unit=5014, NAME="fraction_flowrate.tmp", Action='Write') Write(5014,80) "This file outputs the fraction of flow rate injected in all the layers" Write(5014,90) layer_names open (Unit=5015, NAME="Average_BHP.tmp", Action='Write') Write(5015,80) "This file outputs the BHP (psi) at the mid depth of the top layer of the well" Write(5015,*) " Time(days) BHP_at_the_mid_depth_of_the_top_layer(psi)" open (Unit=5016, NAME="frac_perm.tmp", Action='Write') ! writing permeability profiles Write(5016,80) "This file outputs the frac pack permeability (Darcy) for all the segments" Write(5016,70) "Time(days) Layer 1 Seg 1...Nth Seg Newline Layer 2 Seg 1...Nth Seg Newline..Layer N, Seg 1..Nth Seg Next Para Repeats for each time step" open (Unit=5017, NAME="well_skin.tmp", Action='Write') Write(5017,*) "This file outputs the skin of the well as injection continues" Write(5017,*) "Time(days) Skin(Dimensionless)" open (Unit=5018, NAME="pfp.tmp", Action='Write') ! writing pressure profile in the frac-pack for all layers Write(5018,80) "This file outputs the pressure (psi) in the frac pack for all the segments in all layers" Write(5018,*) " Time(days) Pressure in the frac-pack (psi) from 1st to the Nth segment" open (Unit=5019, NAME="wfp.tmp", Action='Write') ! writing width profile in the frac-pack for all layers Write(5019,80) "This file outputs the frac pack width (mm) for all the segments in all layers" Write(5019,*) "Time(days) Width of the frac-pack (mm) from 1st to the Nth segment" open (Unit=5020, NAME="kfp.tmp", Action='Write') ! writing perm profile in the frac-pack for all layers Write(5020,80) "This file outputs the frac pack permeability (Darcy) for all the segments in all layers" Write(5020,80) "Time(days) Permeability (Darcy) of the frac-pack from 1st to the Nth segment" open (Unit=5021, NAME="qfp.tmp", Action='Write') ! writing flowrate profile in the frac-pack for all layers Write(5021,80) "This file outputs the flow rate (bpd) in the frac pack for all the segments in all layers" Write(5021,80) "Time(days) Flow rate in the frac-pack (bpd) from 1st to the Nth segment" open (Unit=5022, NAME="qfpo.tmp", Action='Write') ! writing leak-off profile from the frac-pack in all layers Write(5022,70) "This file outputs the flow rate (bpd) perp. to frac pack for all the segments in all layers" Write(5022,70) "Time(days) Flow rate perpendicular to the frac-pack (bpd) from 1st to the Nth segment" open (Unit=5023, NAME="hfpo.tmp", Action='Write') ! writing ext. filter cake at the frac-pack face in all layers Write(5023,80) "This file outputs the cake thickness (mm) perp. to frac pack for all the layers" Write(5023,70) "Time(days) Cake thickness (mm) at the face of the frac-pack from 1st to the Nth segment" ! open (Unit=5024, NAME="wc.tmp", Action='Write') ! writing width of the channel in all layers ! open (Unit=5025, NAME="kchannel.tmp", Action='Write') ! writing width of the channel in all layers open (Unit=5026, NAME="layer_skin.tmp", Action='Write') ! writing width of the channel in all layers Write(5026,*) "This file outputs the skin (Dimensionless) of each layer" Write(5026,90) layer_names open (Unit=6001, NAME="wfp_endtime.tmp", Action='Write') Write(6001,80) "This file outputs the frac pack width (mm) at the last time step for all the layers" Write(6001,90) segment_names open (Unit=6002, NAME="kfp_endtime.tmp", Action='Write') Write(6002,80) "This file outputs the frac pack permeability (Darcy) at the last time step for all the layers" Write(6002,90) segment_names open (Unit=6003, NAME="pfp_endtime.tmp", Action='Write') Write(6003,80) "This file outputs the pressure (psi) in the frac pack at the last time step for all the layers" Write(6003,90) segment_names open (Unit=6004, NAME="qfp_endtime.tmp", Action='Write') Write(6004,80) "This file outputs the flow rate (bpd) in the frac pack at the last time step for all the layers" Write(6004,90) segment_names open (Unit=6005, NAME="qfpo_endtime.tmp", Action='Write') Write(6005,60) "This file outputs the flow rate (bpd) perp. to the well & frac pack at the last time step for all the layers" Write(6005,90) segment_names open (Unit=6006, NAME="wfp_starttime.tmp", Action='Write') Write(6006,80) "This file outputs the frac pack width (mm) at the last time step for all the layers" Write(6006,90) segment_names open (Unit=10000, NAME="pnet_starttime.tmp", Action='Write') Write(10000,80) "This file outputs the net pressure (psi) in the frac pack at the start time in all the layers" Write(10000,90) segment_names open (Unit=10001, NAME="pfp_starttime.tmp", Action='Write') Write(10001,80) "This file outputs the pressure (psi) in the frac pack at the start time in all the layers" Write(10001,90) segment_names open (Unit=10002, NAME="qfp_starttime.tmp", Action='Write') Write(10002,80) "This file outputs the flow rate (bpd) in the frac pack at the start time in all the layers" Write(10002,90) segment_names open (Unit=10003, NAME="qfpo_starttime.tmp", Action='Write') Write(10003,80) "This file outputs the flow rate (bpd) perp. to the well & frac pack at the start time in all the layers" Write(10003,90) segment_names !------------------------------------------------------------------------------------------------------------------------------ !Reading shear thinning polymer parameters n and k at injection temp and reservoir temp kp=kp_in(1) np=np_in(1) kpt=kpt_in(1) npt=npt_in(1) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif if (hist_inj_rates == 1) then !Reading historical_q.txt file with injection rates and/or average reservoir pressures OPEN(Unit=63, NAME="historical_q.txt", ACTION = 'Read') Read(63,*, end = 600) dummy_name !changed variable from dummy to dummy_name Ajay Oct 2013 Read(63,*, end = 600) dummy_name !changed variable from dummy to dummy_name Ajay Oct 2013 do i = 1, int(t_max/dtday) if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then Read(63,*, end = 600) dummy_time, q1(i), pres_multiple(:,i) !reading rate in bpd and reservoir pr. in psi pres_multiple(:,i)=pres_multiple(:,i)*6894.76 !converts from psi to pascals for SI else Read(63,*, end = 600) dummy_time, q1(i), pres_1(i) !reading rate in bpd and reservoir pr. in psi pres_1(i)=pres_1(i)*6894.76 !converts from psi to pascals for SI end if else Read(63,*, end = 600) dummy_time, q1(i) !reading in bpd end if q1(i) = max(0.1/543439.6331, q1(i)/543439.6331) !converts from bpd in m3/s for SI with min. rate of 0.1 bpd end do 600 Close(63) end if do layer=1,ltnum dy(layer) = lfp(layer)/dble(Ns) end do do layer = 1, ltnum do i = 0, Ns-1 wfpini(layer,i)=(4/pi*avgwfp(layer))/lfp(layer)*sqrt(lfp(layer)**2-(i*dy(layer))**2) ! Initial width profile of the frac-pack, meters end do wfpini(layer,Ns)=wfpini(layer,Ns-1) end do trans(:)=1 maj_axis_t=lfp min_axis_t=lfp maj_axis_w=lfp min_axis_w=lfp wfp(:,:) = wfpini(:,:) Nc(:) = 0 ! Channel length wc(:,0:Ns) = 0 ! Channel width is zero wc_prev(:,0:Ns) = 0 ! Channel width is zero kchannel(:,1:Ns+1) = 0 ! Channel permeability is zero dwfp(:,:) = 0 ! Pressure difference between two fracpack segments with channel pfpstar(:,:)=0 !--------------------------------------------------------------------------------------------- !initializations !--------------------------------------------------------------------------------------------- !Calculating the apparent well bore radius for perforated completion rw = rp*lp*ds Lf=2*rw !Initialization of Lf dnpv = 1 Wi=0 hcwm = 0 if (ck_dipping==1) then q0=2*flow_rate(1) if (hist_inj_rates == 1) then q0=2*q1(1) !for Bonga history matching; & for Petrobras-GUA-024A history matching, for reading injection rates from file if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres_ini=pres_multiple(1,1) !for Chevron Tahiti Project 2012 simulations, for reading reservoir pressure for top layer with time from file else pres_ini=pres_1(1) !for Bonga history matching, for reading reservoir pressure with time from file end if end if end if else q0=flow_rate(1) if (hist_inj_rates == 1) then q0=q1(1) !for Bonga history matching; & for Petrobras-GUA-024A history matching, for reading injection rates from file if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres_ini=pres_multiple(1,1) !for Chevron Tahiti Project 2012 simulations, for reading reservoir pressure for top layer with time from file else pres_ini=pres_1(1) !for Bonga history matching, for reading reservoir pressure with time from file end if end if end if end if q=q0 !added on March 28 2013 whie working on Anadarko Heidelberg Frac Pack Injection c0=p_conc(1) rhop=den_p(1) rhol=den_f(1) dp=p_dia(1) c0_oil=conc_oil(1) doil=oil_dia(1) rhooil=den_oil(1) coal_fr=coal(1) kc=cake_perm(1) pc=cake_por(1) !------------------------------------------------------------------------------------------------------------------------------ !Reading initial pore pressure in the layers and which remains constant at the drainage boundary of these layers. !------------------------------------------------------------------------------------------------------------------------------ do i = 1,ltnum dh(i)=((topl(i)+bottoml(i))/2-(topl(1)+bottoml(1))/2) end do if (hist_avg_res_prs == 1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,1) pres_ini=pres_multiple(1,1) !Chevron Tahiti Project 2012, reservoir pressures read from the file res_pr(1)=pres_multiple(1,1) else pres=pres_1(1) pres_ini=pres_1(1) res_pr(1)=pres_1(1) end if do i = 2,ltnum if (pres_multiple_flag==1) then res_pr(i)=pres_multiple(i,1) !Added in Jan 27 2012 else res_pr(i)=res_pr(1)+den_f(1)*g*dh(i) end if end do else pres_ini = res_pr(1) pres = res_pr(1) end if !flow_rate(1)=0 !added on Nov 24 2010 for getting cross flow rate write(99,*) write(99,*) 'Reservoir pressure in top layer at time 0 =', pres_ini/6894.76,'psi' write(99,*) do i = 1,ltnum excess_res_pr(i)=(res_pr(i)-res_pr(1))-den_f(1)*g*dh(i) end do !------------------------------------------------------------------------------------------------- !Making the oil phase viscosity and relative permeability equal to the aquifer water viscosity and relative permeability !------------------------------------------------------------------------------------------------- Do layer=1,ltnum if (swi(layer)==1) then mor(layer)=mwi(layer) kro(layer)=krw(layer) endif end do !------------------------------------------------------------------------------------------------- ! Calculate the ideal flow resistance in a radial injector without any skin or fracture (Rideal) !------------------------------------------------------------------------------------------------- Rideal=0 Do layer=1,ltnum RLideal(layer) = mor(layer)*log(re/rw)/(2*pi*kmh(layer)*kro(layer)*tst(layer)) ! Ideal resistance in a radial injector Rideal=Rideal+1/RLideal(layer) End Do Rideal=1/Rideal idealdp=rideal*q !------------------------------------------------------------------------------------------------------------------------------ !Prats idealdp for an infinitly conductive fracture !------------------------------------------------------------------------------------------------------------------------------ Rtot=0 Do layer=1,ltnum Rl(layer)=mor(layer)*log(2*re/lfp(layer))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) Rtot=Rtot+1/RL(layer) end do Rtot=1/Rtot idealdp_prats = rtot*q !--------------------------------------------------------------------------------------------------------------------------------- ! Calculating kh/mu for skin calculations ! Note kh_mu should be used only for skin calculations and not very flow resistance, flow distribution or pressure calculations !--------------------------------------------------------------------------------------------------------------------------------- kh_mu=0 do i = 1,ltnum kh_mu = kh_mu + kmh(i)*krw(i)*tst(i)/kp end do !-------------------------------------------------------------------------------------------------- ! Calculating frac-pack segment length, constant pressure ellipse's minor axis (perp. to frac-pack) !-------------------------------------------------------------------------------------------------- flag=0 do layer=1,ltnum dy(layer) = lfp(layer)/dble(Ns) a_prats = 3.14159*kmh(layer)*(krw(layer)+kro(layer))/2*lfp(layer)/2/fpk(layer)/wfp(layer,0) if (a_prats>10) then flag = 1 end if end do Do layer=1,ltnum Do i = 1, Ns ! Segment lengths in the frac-pack; currently all equal dyg(layer,i) = (i-1)*dy(layer) End Do EndDo Do i=1,ltnum bfp(i) = frac_bfp(kmh(i),(krw(i)+kro(i))/2,lfp(i),fpk(i),wfp(i,0)) Aface(i)=4*tst(i)*Lf(i) !Area of face perpendicular to equivalent well fracture Acore(i,:)=4*tst(i)*dy(i) !Area of face perpendicular to a frac-pack segment Afrac(i,1:Ns)=2*wfp(i,1:Ns)*tst(i) !Area of frac-pack opening do j = 1, Ns Afrac(i,j)=2*(wfp(i,j-1)+wfp(i,j))/2*tst(i) end do Do ii = 1, Ns Lcore(i,ii)=bfp(i)*(1-(ii*1.0/(Ns+1))**2)**0.5 End do Acore(i,Ns+1)=Afrac(i,Ns) Lcore(i,Ns+1)=Lcore(i,Ns)/10 Write(*,*) 'Minor axis of frac-pack in layer ',i,bfp(i),'m' Write(99,*) 'Minor axis of frac-pack in layer ',i,bfp(i),'m' Enddo !------------------------------------------------------------------------------------------------------------------------------ !Approximate initial flow distribution in and around the frac-pack without the skin distributed between the layers !------------------------------------------------------------------------------------------------------------------------------ !qfp = 0.0 !Initial flow rate in the frac-pack assumed is zero for non-Darcy flow resistance Rtot=0 Do layer=1,ltnum Rl(layer)=mor(layer)*log(2*re/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) Rtot=Rtot+1/RL(layer) end do Rtot=1/Rtot !Initial approximate total resistivity of the injector assuming infinite conductivity frac-pack !------------------------------------------------------------------------------------------------------------------------------ excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = Rtot/RL(layer)*q !USE THIS FOR WHEN LAYER PRESSURES ARE HYDROSTATIC (THIS SHOULD BE A SPECIAL CASE OF THE ABOVE) !ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) End Do !------------------------------------------------------------------------------------------------------- Do layer=1,ltnum !ql(layer) = q*Rtot/Rl(layer) qfpo(layer,:)=ql(layer)/(Ns+1) !Initial approximate flow rate perpendicular to the fracpack (assuming uniform leak-off) qfp(layer,0)=ql(layer)-qfpo(layer,0) !Initial approximate flow rate entering into the fracpack Do i=1,Ns qfp(layer,i) = qfp(layer,i-1) - qfpo(layer,i) !Note qfp(layer,Ns) will need to become equal to zero End do qfp(layer,Ns)=qfp(layer,Ns-1) end do Write(99,*) Write(99,*) 'In. flow rate distribution w/o frac pr. drop =',ql*543439.6331, 'bpd' Write(99,*) Write(*,*) Write(*,*) 'In. flow rate distribution w/o frac pr. drop =',ql*543439.6331, 'bpd' Write(*,*) !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- !Specify initial skin either by knowing frac skin and adjusting the skin with frac lengths so that it is 0 or whatever it should be !keep it default that is what is calculated by the program (would be negative if fracs are there and would be 0 if fracs are not there) !skin_ini=0 !-6.25 !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------- write(99,*)'The initial well skin = ',skin_ini delps_ini=q/2/pi/kh_mu*skin_ini !changed q0 to q on March 28 2013 realdp = idealdp+delps_ini(1) !This should be the initial pressure drop between the reservoir and the well !Write(99,*) !Write(99,*) 'In. pres. drop due to in. skin =',delps_ini/6894.76, 'psi' !Write(99,*) !Write(*,*) !Write(*,*) 'In. pres. drop due to in. skin =',delps_ini/6894.76, 'psi' !Write(*,*) !Write(99,*) !Write(99,*) 'In. total pres. drop =',realdp/6894.76, 'psi' !Write(99,*) !Write(*,*) !Write(*,*) 'In. total pres. drop =',realdp/6894.76, 'psi' !Write(*,*) !------------------------------------------------------------------------------------------------------------------- ! Accurate estimation of initial flow resistances in the frac-pack and perpendicular to the frac-pack up to the ! constant pressure ellipse boundary ! Accurate initial flow distribution in and around the frac-pack is calculated iteratively ! This is because Non-Darcy flow resistance component and shear rate viscosity depends on the flow rate !------------------------------------------------------------------------------------------------------------------- !NonDarcyLoop: Do k = 1, 5 RL0tot=0 Rcgrav=0 Do layer=1,ltnum Rcore(layer,Ns+1)=mor(layer)*Lcore(layer,Ns+1)/(kmh(layer)*kro(layer))/Acore(layer,Ns+1) Rcore0_forskin(layer,Ns+1)=kp*Lcore(layer,Ns+1)/(kmh(layer)*krw(layer))/Acore(layer,Ns+1) !Rcore(layer,Ns+1)=mor(layer)*log(Lcore(layer,Ns+1)/(wfp(layer,Ns)/2))/2/pi/(kmh(layer)*kro(layer))/tst(layer) !Rcore(layer,Ns+1)=mor(layer)*log(2)/2/pi/(kmh(layer)*kro(layer))/tst(layer) !Rcore(layer,Ns+1)=0 Rfracpack0(layer)=Rcore(layer,Ns+1) Rfracpack0_forskin(layer)=Rcore0_forskin(layer,Ns+1) Do i=Ns,1,-1 Rcore(layer,i)=mor(layer)*Lcore(layer,i)/(kmh(layer)*kro(layer))/Acore(layer,i) Rcore0_forskin(layer,i)=kp*Lcore(layer,i)/(kmh(layer)*krw(layer))/Acore(layer,i) ! Shear rate parameters, np, kp is used to calculate Hp for flow of polymer in the fracpack Hp = kp*((1+3*np)/np)**(np-1)*(8.0*fpk(layer)*krw(layer)*fpp(layer))**((1.0-np)/2.0) !mu is calculated based on n and k for the shear thinning polymer !mu=Hp*((qfp(layer,i-1)+qfp(layer,i))/2/Afrac(layer,i))**(np-1) mu=Hp*(qfp(layer,i)/Afrac(layer,i))**(np-1) !Rrfg(layer,i)=mu*dy(layer)/fpk(layer)/Afrac(layer,i)+(qfp(layer,i-1)+qfp(layer,i))/2*NDC(fpd(layer),fpk(layer))*rhol*dy(layer)/(Afrac(layer,i)**2) Rrfg(layer,i)=mu*dy(layer)/fpk(layer)/Afrac(layer,i)!+qfp(layer,i)*NDC(fpd(layer),fpk(layer))*rhol*dy(layer)/(Afrac(layer,i)**2) Rfracpack0(layer)=1/(Rfracpack0(layer)+Rrfg(layer,i))+1/Rcore(layer,i) Rfracpack0_forskin(layer)=1/(Rfracpack0_forskin(layer)+Rrfg(layer,i))+1/Rcore0_forskin(layer,i) Rfracpack0(layer)=1/Rfracpack0(layer) Rfracpack0_forskin(layer)=1/Rfracpack0_forskin(layer) End do if (flag == 1) then !a_prats>10 use radial model for flow from well to the inner ellipse Rwell(layer)=mor(layer)*log((lfp(layer)+bfp(layer))/lf(layer))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 Rwell0_forskin(layer)=kp*log((lfp(layer)+bfp(layer))/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Rwell(layer)=mor(layer)*bfp(layer)/(kmh(layer)*kro(layer))/Aface(layer) !commented out on oct 13 for a>10 Rwell0_forskin(layer)=kp*bfp(layer)/(kmh(layer)*krw(layer))/Aface(layer) !commented out on oct 13 for a>10 end if Rfp_ellipse(layer)=1/Rfracpack0(layer)+1/Rwell(layer) Rfp_ellipse0(layer)=1/Rfracpack0_forskin(layer)+1/Rwell0_forskin(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) Rfp_ellipse0(layer)=1/Rfp_ellipse0(layer) RL0(layer)=Rfp_ellipse(layer) delpfp_ellipse(layer)=ql(layer)*RL0(layer) RL0tot=RL0tot+1/RL0(layer) End Do RL0tot=1/RL0tot !Initial total resistivity of the injector upto the frac-pack Rtot=0 Do layer=1,ltnum Rl(layer)=Rl0(layer)+mor(layer)*log(2*re/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) Rtot=Rtot+1/RL(layer) Rcc=0.0000 hc=0 !Lfold(layer)=rw*2 End Do Rtot=1/Rtot !Initial total SS resistivity of the injector with frac-pack up to the drainage radius !*************************************************************************************************************************************** ! Find initial skin distribution between the layers !*************************************************************************************************************************************** Do layer=1,ltnum !frac pack code needs to be here skin_frac_delp(layer)=(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)*Rfp_ellipse(layer) skin_frac_pack(layer)=log(rw)-log(lfp(layer)+bfp(layer)/2)+skin_frac_delp(layer)!+(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp)*Rl_vert(layer) !commented out Ajay Oct 2013 End Do if (ltnum > 1) then !Initial wellbore pressure if injection water was the flowing phase in the reservoir, it won't be this actually !piwfdd = q * (Log(re / rw) + skin_ini) / kh_mu + (pres_ini + 1.0 / 3.0 * sum_excess_res_pr) amin = 0.0001 amax = 1 a_range_flag = 0 tolerance = 0.000000000000001 ! (1E-15) loop: Do while (a_range_flag == 0) amin=amin/10.0 amax = amax * 10.0 !fn1 = -kh_mu * (piwfdd - (pres_ini + 1.0 / 3.0 * sum_excess_res_pr)) / (Log(re / rw) + skin_ini) !fn2 = -kh_mu * (piwfdd - (pres_ini + 1.0 / 3.0 * sum_excess_res_pr)) / (Log(re / rw) + skin_ini) fn1 = -kh_mu / (Log(re / rw) + skin_ini) fn2 = -kh_mu / (Log(re / rw) + skin_ini) Do i=1,ltnum !fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp * (piwfdd - (pres_ini + excess_res_pr(i))) / (Log(re / rw) + amin + skin_frac_pack(i)) !fn2 = fn2 + kmh(i) * krw(i) * tst(i) / kp * (piwfdd - (pres_ini + excess_res_pr(i))) / (Log(re / rw) + amax + skin_frac_pack(i)) fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + amin + skin_frac_pack(i)) fn2 = fn2 + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + amax + skin_frac_pack(i)) end do If (fn1 >= 0 .And. fn2 <= 0) Then a_range_flag = 1 End If If (fn1 <= 0 .And. fn2 >= 0) Then a_range_flag = 1 End If If (abs(fn1) <= tolerance) Then a = amin go to 10 ! a value has been found therefore no need to compute a End If If (abs(fn2) <= tolerance) Then a = amax go to 10 ! a value has been found therefore no need to compute a End If end do loop !Now that amin and amax have been determined (a_range_flag == 1) we find a where by fn < tolerance fn = 0 loop_1: Do j=1,100 a = 0.5 * (amin + amax) !fn = -kh_mu * (piwfdd - (pres_ini + 1.0 / 3.0 * sum_excess_res_pr)) / (Log(re / rw) + skin_ini) !fn1 = -kh_mu * (piwfdd - (pres_ini + 1.0 / 3.0 * sum_excess_res_pr)) / (Log(re / rw) + skin_ini) fn = -kh_mu / (Log(re / rw) + skin_ini) fn1 = -kh_mu / (Log(re / rw) + skin_ini) Do i = 1,ltnum !fn = fn + kmh(i) * krw(i) * tst(i) / kp * (piwfdd - (pres_ini + excess_res_pr(i))) / (Log(re / rw) + a + skin_frac_pack(i)) !fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp * (piwfdd - (pres_ini + excess_res_pr(i))) / (Log(re / rw) + amin + skin_frac_pack(i)) fn = fn + kmh(i) * krw(i) * tst(i) / kp / (Log(re / rw) + a + skin_frac_pack(i)) fn1 = fn1 + kmh(i) * krw(i) * tst(i) / kp /(Log(re / rw) + amin + skin_frac_pack(i)) end do If (Abs(fn) < tolerance) Then Exit loop_1 End If If (Sign(1.0,fn) == Sign(1.0,fn1)) Then amin = a ElseIf (Sign(1.0,fn) /= Sign(1.0,fn1)) Then amax = a ElseIf (fn == 0) Then Exit loop_1 End If end do loop_1 else a = skin_ini - skin_frac_pack(1) end if 10 Do i = 1,ltnum skin0(i)=skin_frac_pack(i)+a ! when initial total well skin is distributed between the layers skin0(i)=skin_frac_pack(i) ! 2013 March done at the time of Anadarko K-2 field phase II FP study. skin0(i)=skin_frac_pack(i)+skin_ini ! 2013 April layer skin = Equal Initial skin distributed - Frac Skin end do !*************************************************************************************************************************************** Write(99,*) Write(*,*) do layer = 1,ltnum Write(99,*) 'In layer',layer Write(99,*) 'The a value for skin = ',a write(99,*) 'The skin due to pr. drop in frac = ',skin_frac_delp(layer) write(99,*) 'The skin due to frac w/o well skin = ', skin_frac_pack(layer) write(99,*) 'The final initial skin due to frac and well = ', skin0(layer) Write(99,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' Write(*,*) 'In layer',layer Write(*,*) 'The a value for skin = ',a write(*,*) 'The skin due to pr. drop in frac = ',skin_frac_delp(layer) write(*,*) 'The skin due to frac w/o well skin = ', skin_frac_pack(layer) write(*,*) 'The final initial skin due to frac and well = ', skin0(layer) Write(*,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' end do Rl0tot=0 Do layer=1,ltnum RL0(layer) = (log(re/rw)+skin0(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/mor(layer)) Rl0tot=Rl0tot+1/RL0(layer) End Do Rl0tot=1/Rl0tot excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl0(layer) end do Do layer=1,ltnum ql(layer) = Rl0tot/RL0(layer)*(q+excess_q-excess_res_pr(layer)/Rl0tot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = Rl0tot/RL0(layer)*q !USE THIS FOR WHEN LAYER PRESSURES ARE HYDROSTATIC (THIS SHOULD BE A SPECIAL CASE OF THE ABOVE) ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0 bpd in case there is crossflow (from reservoir to the well) End Do Write(99,*) Write(*,*) do layer = 1,ltnum Write(99,*) 'In layer',layer Write(99,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' Write(*,*) 'In layer',layer Write(*,*) 'The flow rate =',ql(layer)*543439.6331, 'bpd' end do !----------------------------------------------------------------------------------------------------------------------- ! Initial flow rate distribution inside and perpendicular to the fracture !----------------------------------------------------------------------------------------------------------------------- Do layer=1,ltnum !ql(layer) = q*Rtot/Rl(layer) qfpo(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rwell(layer) vdwm(layer,:)=qfpo(layer,0)/Aface(layer) !Darcy velocity in the matrix perp. to well equivalent fracture ! Darcy velocity in matrix perpendicular to the frac-pack ! Since Acore(layer,:) = Acore(layer,1) and the flow rate is equally distributed ! we get equal flowrate going out from the frac-pack into the matrix qfp(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rfracpack0(layer) vdfpi(layer,0)=qfp(layer,0)/Afrac(layer,1) ! Calculating flow rate in a frac-pack segment based on flow resistance of the fracpack ! ahead and the flow resistance of the matrix perpendicular to the segment Do i=1,Ns Resis = Rcore(layer,Ns+1) Do j = Ns, i, -1 !Resis = 1 / (Resis + Rrfg(layer,j) + Rcgrav(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / (Resis + Rrfg(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / Resis End do qfpo(layer,i)=qfp(layer,i-1)*Resis/Rcore(layer,i) qfp(layer,i) = qfp(layer,i-1) - qfpo(layer,i) End do ! The flow rate at the tip is same in the direction of frac-pack and perp to the frac-pack qfpo(layer,Ns+1)=qfp(layer,Ns) qfp(layer,Ns+1)=qfp(layer,Ns) vdfpi(layer,1:Ns)=qfp(layer,1:Ns)/Afrac(layer,1:Ns) vdfpo(layer,1:Ns+1)=qfpo(layer,1:Ns+1)/Acore(layer,1:Ns+1) !--------------------------------------------------------------------------------------------- ! Initial pressure distribution in the fracture !--------------------------------------------------------------------------------------------- pfp(layer,Ns+1)=ql(layer)*mor(layer)*log(2*re/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*kro(layer)*tst(layer))+(pres_ini+excess_res_pr(layer)) pfp(layer,Ns)=qfpo(layer,Ns+1)*Rcore(layer,Ns+1)+pfp(layer,Ns+1) Do i=Ns,1,-1 !pfp(layer,i)=pfp(layer,i+1)+(qfp(layer,i)+qfp(layer,i+1))/2*Rrfg(layer,i+1) pfp(layer,i-1)=pfp(layer,i)+qfp(layer,i)*Rrfg(layer,i) End do End Do !-------------------------------------------------------------------------------------------- dummy=0 do i = 1,ltnum dummy = dummy + kmh(i)*kro(i)*tst(i)/mor(i) !dummy = dummy + kmh(i)*krw(i)*tst(i)/mwi(i) end do !-------------------------------------------------------------------------------------------- ! Initial delta p calculations !-------------------------------------------------------------------------------------------- Write(*,*) 'Initial reservoir pressure = ',pres_ini/6894.76 Write(99,*) 'Initial reservoir pressure = ',pres_ini/6894.76 ! Ideal pressure drop for radial flow with no frac-pack calculated using Darcy's law Write(99,*) Write(99,*) 'Pressure drop with no frac-pack = ', idealdp/6894.76 Write(*,*) 'Pressure drop with no frac-pack = ', idealdp/6894.76 ! Ideal pressure drop with frac-pack calculated using Prat's solution Write(99,*) Write(99,*) 'Pressure drop with oo conductivity frac (Prat"s model)= ', idealdp_prats/6894.76 Write(*,*) 'Pressure drop with oo conductivity frac (Prat"s model)= ', idealdp_prats/6894.76 Write(99,*) Write(99,*) 'TPD with fracpack of finite conductivity (Res model)= ', rtot*q/6894.76 Write(*,*) 'TPD with fracpack of finite conductivity (Res model)= ', rtot*q/6894.76 ! Pressure drop up from the frac-pack start to frac pack tip Do i = 1, ltnum Write(99,*) Write(99,*) 'Pressure drop upto fracpack tip = ', pfp(i,0)/6894.76-pfp(i,Ns)/6894.76 Write(*,*) 'Pressure drop upto fracpack tip= ', pfp(i,0)/6894.76-pfp(i,Ns)/6894.76 ! Pressure drop up from the frac-pack start to frac pack ellipse Write(99,*) 'Pressure drop upto fracpack ellipse = ', pfp(i,0)/6894.76-pfp(i,Ns+1)/6894.76, rcore(i,1)*qfpo(i,1)/6894.76 Write(*,*) 'Pressure drop upto fracpack ellipse= ', pfp(i,0)/6894.76-pfp(i,Ns+1)/6894.76, rcore(i,1)*qfpo(i,1)/6894.76 end do ! The frac-packs are considered to have 0 skin !-------------------------------------------------------------------------------------------- !open (Unit=124000, NAME="q&pfracpack.tmp", Action='Write') !Write(124000,100) qfp*543439.6331 ! Initial flow distribution in the frac-pack, bpd !Write(124000,100) pfp/6894.76 ! Initial pressure distribution in the frac-pack, psi !Write(124000,100) !Write(124000,100) 0,rw,dyg(1,:)+rw,dyg(1,Ns)+rw+Lcore(1,Ns),110.0,130.0,170.0,200.0,re ! Distance of frac-pack segments, tip, ellipse and re from well-bore !Write(124000,100) qfp(1,0)*543439.6331,qfp(1,:)*543439.6331 ! flow in layer 1 frac-pack in bpd !Write(124000,100) qfp(2,0)*543439.6331,qfp(2,:)*543439.6331 ! flow in layer 2 frac-pack in bpd !Write(124000,100) vdwm(1,1)*Aface(1)*543439.6331,qfpo(1,:)*543439.6331 ! flow rate perp to frac-pack in layer 1 !Write(124000,100) vdwm(2,1)*Aface(2)*543439.6331,qfpo(2,:)*543439.6331 ! flow rate perp to frac-pack in layer 2 !Write(124000,100) vdwm(1,1),vdfpo(1,:) ! flow vel. perp to frac-pack in layer 1 !Write(124000,100) vdwm(2,1),vdfpo(2,:) ! flow vel. perp to frac-pack in layer 2 !Write(124000,100) pfp(1,0)/6894.76,pfp(1,:)/6894.76,pres_ini/6894.76+ql(1)*mor(1)*log(2*re/(110+98))/(2*pi*kmh(1)*kro(1)*tst(1))/6894.76,pres_ini/6894.76+ql(1)*mor(1)*log(2*re/(130+125))/(2*pi*kmh(1)*kro(1)*tst(1))/6894.76,pres_ini/6894.76+ql(1)*mor(1)*log(2*re/(170+160))/(2*pi*kmh(1)*kro(1)*tst(1))/6894.76,pres_ini/6894.76+ql(1)*mor(1)*log(2*re/(200+190))/(2*pi*kmh(1)*kro(1)*tst(1))/6894.76,pres_ini/6894.76 !Write(124000,100) pfp(2,0)/6894.76,pfp(2,:)/6894.76,pres_ini/6894.76+ql(2)*mor(2)*log(2*re/(110+98))/(2*pi*kmh(2)*kro(2)*tst(2))/6894.76,pres_ini/6894.76+ql(2)*mor(2)*log(2*re/(130+125))/(2*pi*kmh(2)*kro(2)*tst(2))/6894.76,pres_ini/6894.76+ql(2)*mor(2)*log(2*re/(170+160))/(2*pi*kmh(2)*kro(2)*tst(2))/6894.76,pres_ini/6894.76+ql(2)*mor(2)*log(2*re/(200+190))/(2*pi*kmh(2)*kro(2)*tst(2))/6894.76,pres_ini/6894.76 Write(*,*) '' Write(*,*) 'Initial well pressure in layer 1 = ',(realdp+pres_ini)/6894.76 Write(*,*) 'Initial fracpack start pressure in layer 1 = ',pfp(1,0)/6894.76 Write(*,*) 'Initial tip pressure in layer 1 = ',pfp(1,Ns)/6894.76 Write(*,*) 'Initial ellipse pressure in layer 1 = ',pfp(1,Ns+1)/6894.76 Write(99,*) '' Write(99,*) 'Initial well pressure in layer 1 = ',(realdp+pres_ini)/6894.76 Write(99,*) 'Initial fracpack start pressure in layer 1 = ',pfp(1,0)/6894.76 Write(99,*) 'Initial tip pressure in layer 1 = ',pfp(1,Ns)/6894.76 Write(99,*) 'Initial ellipse pressure in layer 1 = ',pfp(1,Ns+1)/6894.76 !End do NonDarcyLoop close(124000) !--------------------------------------------------------------------------------------------- ! Initialization of transition time, segment lengths, constant pressure ellipse axes and areas !--------------------------------------------------------------------------------------------- Call Inittt ! Initialize the check for transition time Call Initttfp ! Initialize the check for transition time Call Initttg !----------------------------------------------------------------------------------------------- ! Initialize Filtration coefficient and sigma !----------------------------------------------------------------------------------------------- ! Filtration coefficient ! A fudge factor of 0.1 as a multiplication factor needs to be put in for unfavorable surface forces ! We have removed the 0.1 multiplication factor to match Bonga Well-2 bottom hole pressure history Do j=1,Ltnum If (fcae(j)==1) Then Do i=1,Ns !filtration coefficient in the matrix perpendicular to the equivalent fracture for the well ! Shear rate parameters, np, kp is used to calculate Hp Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*krw(j)*pm(j)*(1-sor(j)))**((1.0-np)/2.0) mu=Hp*vdwm(j,i)**(1-1) lambda0wm(j,i)=lambda0c(dp,dg(j),rhop,rhol,mu,vdwm(j,i),pm(j)) if (lambda0wm(j,i)==0) then lambda0wm(j,i)=0.1 endif !filtration coefficient in the matrix perpendicular to the frac-pack mu=Hp*vdfpo(j,i)**(np-1) lambda0(j,i)=lambda0c(dp,dg(j),rhop,rhol,mu,vdfpo(j,i),pm(j)) !filtration coefficient in the frac-pack is equal to gravel-pack fc Hp = kp*((1+3*np)/np)**(np-1)*(8.0*fpk(j)*krw(j)*fpp(j))**((1.0-np)/2.0) !mu=Hp*((vdfpi(j,i-1)+vdfpi(j,i))/2)**(np-1) mu=Hp*(vdfpi(j,i))**(np-1) !lambda0g(j,i)=lambda0c(dp,fpd(j),rhop,rhol,mu,(vdfpi(j,i-1)+vdfpi(j,i))/2,fpp(j)) lambda0g(j,i)=lambda0c(dp,fpd(j),rhop,rhol,mu,vdfpi(j,i),fpp(j)) !commented out Ajay Oct 2013 !commented out Ajay Oct 2013 !if (c0_oil>0) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(j)*krw(j)*pm(j)*(1-sor(j)))**((1.0-np)/2.0) mu=Hp*vdwm(j,i)**(np-1) lambda0wm_oil(j,i)=lambda0c(doil,dg(j),rhop,rhol,mu,vdwm(j,i),pm(j)) if (lambda0wm_oil(j,i)==0) then lambda0wm_oil(j,i)=0.1 endif mu=Hp*vdfpo(j,i)**(np-1) lambda0_oil(j,i)=lambda0c(doil,dg(j),rhooil,rhol,mu,vdfpo(j,i),pm(j)) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*fpk(j)*krw(j)*fpp(j))**((1.0-np)/2.0) !mu=Hp*((vdfpi(j,i-1)+vdfpi(j,i))/2)**(np-1) !lambda0g_oil(j,i)=lambda0c(doil,fpd(j),rhooil,rhol,mu,(vdfpi(j,i-1)+vdfpi(j,i))/2,fpp(j)) mu=Hp*(vdfpi(j,i))**(np-1) lambda0g_oil(j,i)=lambda0c(doil,fpd(j),rhooil,rhol,mu,vdfpi(j,i),fpp(j)) !end if End Do Else lambda0(j,:)=fc(j) lambda0_oil(j,:)=fco(j) lambda0wm(j,:)=fc(j) lambda0wm_oil(j,:)=fco(j) lambda0g(j,:)=fcg(j) lambda0g_oil(j,:)=fcgo(j) End If End Do lambda(:,:)=lambda0(:,:) ! Set filtr. coeff. equla to init. lambda_oil(:,:)=lambda0_oil(:,:) lambdawm(:,:)=lambda0wm(:,:) ! Set filtr. coeff. equla to init. lambdawm_oil(:,:)=lambda0wm_oil(:,:) lambdag(:,:)= lambda0g(:,:) ! Set filtr. coeff. equla to init. lambdag_oil(:,:)= lambda0g_oil(:,:) ttwm(:) = Dble(-1.0) ! tt for matrix adjoining the equivalent wellbore fracture ttg(:,:) = Dble(-1.0) ! frac-pack tt; needs to be checked with sigmaf in the first time step ttf(:,:) = Dble(-1.0) ! matrix tt; needs to be checked with sigmafp_perp_solid in the first time step sigmawm = Dble(0.0) ! deposition of solids in matrix perpendicular to the equivalent fracture for the well sigmawm_oil = Dble(0.0) ! deposition in oil in ditto sigmafp_in_solid = Dble(0.0) ! deposition in frac-pack sigmafp_in_oil=Dble(0.0) sigmafp_perp_solid = Dble(0.0) ! deposition in matrix perpendicular to the frac-pack sigmafp_perp_oil = Dble(0.0) hcgrav = 0 ! external filter cake thickness outside the gravels in the frac-pack hcwm = 0 ! external filter cake thickness outside the eq. fracture for the wellbore hccore = 0 ! external filter cake thickness outside the matrix of the frac-pack face lambda00(:) = lambda0(:,1) ! This value is written out as the lambda of the layer lambda00_oil(:) = lambda0_oil(:,1) ! This value is written out as the lambda of the layer !------------------------------------------------------------------------------------------------------- ! Calculating the length of damage perp. to the frac-pack based on the initial filtration coefficient ! Calculating segment lengths, constant pressure ellipse axes and areas !------------------------------------------------------------------------------------------------------- L = 0.01 ! 1 cm same as 0.01 m is the minimum length of damage as the default value L = 0.1 ! 10 cm = 0.1 m is the length of damage increased for BHP Shenzi case 23, 24, 25, 26 do i = 1, ltnum if (log(100000.0)/lambda(i,1) > L) then !The conc of particles reduces by 100000 times at this distance L = log(100000.0)/lambda(i,1) end if end do if (L>1000) then !Max L is 1000 meters L = 1000 endif dx = L/dble(Ns) ! Slice width of the core for internal perm reduction, m Do i = 1,Ns ! Build r-vector r(i) = (i-1)*dx End Do !------------------------------------------------------------------------------------------------------------------------ ! Outputing p, pnet, qfp, qfpo in and perp to the frac-pack segments for all the layers !------------------------------------------------------------------------------------------------------------------------ do i = 0, Ns dpnet(:,i)=wfp(:,i)*Y(:)/(2.0*(1-n(:)*n(:))*tst(:)) dpnet(:,i)=wfp(:,i)*Y(:)/(2.0*(1-n(:)*n(:))*tst_sum) ! updated for Anadarko Heidelberg May 2013 !Write(10000,100) (rw+i*dy(:))*3.28, dpnet(:,i)/6894.76 ! writing pnet(psi) in the fracpack ith segment of each layer at end time Write(10000,100) i*1.0, dpnet(:,i)/6894.76 ! writing pnet(psi) in the fracpack ith segment of each layer at end time end do close(10000) do i = 0, Ns+1 !Write(10001,100) (rw+i*dy)*3.28, pfp(:,i)/6894.76 ! writing p (psi) in the fracpack ith segment of each layer at end time !April 2013 !Write(10001,100) i*1.0, pfp(:,i)/6894.76 ! writing p (psi) in the fracpack ith segment of each layer at end time !Write(10002,100) (rw+i*dy)*3.28, qfp(:,i)*543439.6331 ! writing q (bpd) in the fracpack ith segment of each layer at end time Write(10002,100) i*1.0, qfp(:,i)*543439.6331 ! writing q (bpd) in the fracpack ith segment of each layer at end time !Write(10003,100) (rw+i*dy)*3.28, qfpo(:,i)*543439.6331 ! writing q (bpd) perp to the fracpack ith segment of each layer at end time Write(10003,100) i*1.0, qfpo(:,i)*543439.6331 ! writing q (bpd) perp to the fracpack ith segment of each layer at end time end do close(10001) close(10002) close(10003) If (out_pp==1) Then Do j=1,ltnum kgf(j,1,:)=kmh(j) !Write(5016,100) t/86400, kgf(j,1,:)*1.01325e15 ! Permeability in md Write(5016,100) t/86400, kgf(j,1,:)*1e15 ! Permeability in md End Do endif Write(5016,*) !Write(5017,100) t/86400, skin ! writing skin Do j=1,ltnum !April 2013 !Write(5018,100) t/86400, pfp(j,:)/6894.76 ! Pressure in psi !Write(5018,100) t/86400, (fpp(j)-(sigmafp_in_solid(j,:) + sigmafp_in_oil(j,:))) ! Porosity of the frac pack fp_avg_por(j,:)=fpp(j) Write(5018,100) t/86400, fp_avg_por(j,:) ! Initial Porosity of the frac pack End Do Write(5018,*) Do j=1,ltnum Write(5019,100) t/86400, wfp(j,:)*1000 ! width in mm End Do Write(5019,*) Do j=1,ltnum kgg(j,1:Ns)=fpk(j) Write(5020,100) t/86400, kgg(j,1:Ns)*1.0E+12 ! Perm in Darcy End Do Write(5020,*) Do j=1,ltnum Write(5021,100) t/86400, qfp(j,:)*543439.6331 ! Flowrate in bpd End Do Write(5021,*) Do j=1,ltnum Write(5022,100) t/86400, qfpo(j,:)*543439.6331 ! Flowrate in bpd End Do Write(5022,*) Do j=1,ltnum Write(5023,100) t/86400, hcwm(j)*1000, hccore(j,:)*1000 ! filter cake at the well and the fracpack face in mm End Do Write(5023,*) !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Initializations before starting the injection time loop !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ do i=1,ltnum do j=1,Ns+1 kgf(i,j,:)=kmh(i) end do kggGravel(i,:)=fpk(i) kwm(i,:)=kmh(i) end do Rfracpack = Rfracpack0 ! this is added on nov 22 2010 for being able to run q = 0 ptip_flag = 0 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !Time loop Begins !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ tt1=dt Do t=tt1,t_max*86400,dt !PGF fracpack calculations time loop begins If (ptip_flag == 1) then go to 10000 end if !C1: Acidizing Dates = 12/5/2004 4/11/2006 5/8/2006 9/27/2007 ; Days: 689 1181 1715 !commented out Ajay Oct 2013 !if (t/86400>871) then ! Write(*,*) 'Time is = ',t/86400 !endif qold=q OPEN(Unit=40, NAME="fracres.tmp", ACTION = 'Write') 400 FORMAT(I4,500E13.5) Write(40,*) points_counter Do j=1,ltnum Write(40,400) j,tt(j),lambda00(j),lambda(j,1),sigma(j,1) points_counter = points_counter + 1 End Do Close(40) !--------------------------------------------------------------------- ! Setting the injection stage according to the current injection time !--------------------------------------------------------------------- !Injection parameter based on the next injection stage. Stage: do i=1,nstage if (t>startt(i)*86400 .AND. t<=endd(i)*86400 .AND. i>present_stage) Then q=flow_rate(i) if (ck_dipping==1) then q=2*q end if rhop=den_p(i) rhol=den_f(i) rhooil=den_oil(i) kp=kp_in(i) np=np_in(i) kpt=kpt_in(i) npt=npt_in(i) !changed the value of npt and np when equal to 1 Ajay Oct 2013 if (npt==1) then npt=1+1e-7 endif if (np==1) then np=1+1e-7 endif c0=p_conc(i) dp=p_dia(i) c0_oil=conc_oil(i) doil=oil_dia(i) coal_fr=coal(i) kc=cake_perm(i) pc=cake_por(i) present_stage=i exit stage endif end do stage ! The code below should be active only when reading the injection rates from an input file ! Petrobras-Guando-ARIN3-GUA-096.tmp , GUA-024A-q.txt have injection rate profile ! Nexen-C1.tmp have injection rate and reservoir pressure profile ! Bigfoot-SW23.tmp next injection rate if (hist_inj_rates == 1) then if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then pres=pres_multiple(1,counter) ! if boundary pr. is also read from file Chevron Tahiti 2012 else pres=pres_1(counter) ! if boundary pr. is also read from file end if end if q=q1(counter) ! Note the first time step t=tt1, the counter is 1 and the rate is the same as before (just a repeat) if (ck_dipping==1) then q=2*q end if end if ! The above code should be active only when reading the injection rates from an input file !---------------------------- Calculating the flow rate distribution in a layer for the new time step if (q == 0 ) then Do layer=1,ltnum ql(layer) = 0.0 qfp(layer,:) = 0.0 qfpo(layer,:) = 0.0 vdfpi(layer,:) = 0.0 vdfpo(layer,:) = 0.0 End Do else excess_q=0 Do layer=1,ltnum excess_q = excess_q + excess_res_pr(layer)/rl(layer) end do Do layer=1,ltnum ql(layer) = Rtot/RL(layer)*(q+excess_q-excess_res_pr(layer)/Rtot) !USE THIS FOR CROSS FLOW WHEN LAYER PRESSURES AREN'T HYDROSTATIC ql(layer) = Rtot/RL(layer)*q !USE THIS FOR WHEN LAYER PRESSURES ARE HYDROSTATIC (THIS SHOULD BE A SPECIAL CASE OF THE ABOVE) ql(layer) = max(0.0, ql(layer)) !Converts minimum rate to 0.1 bpd in case there is crossflow (from reservoir to the well) End Do Do layer=1,ltnum !ql(layer) = q*Rtot/Rl(layer) qfpo(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rwell(layer) ! flow rate perp to the equivalent well fracture qfp(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rfracpack(layer) ! flow rate into the frac-pack Do i=1,Ns Resis = Rcore(layer,Ns+1) Do j = Ns, i, -1 !Resis = 1 / (Resis + Rrfg(layer,j) + Rcgrav(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / (Resis + Rrfg(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / Resis End do qfpo(layer,i)=qfp(layer,i-1)*Resis/Rcore(layer,i) qfp(layer,i) = qfp(layer,i-1) - qfpo(layer,i) vdfpo(layer,i)=qfpo(layer,i)/Acore(layer,i) vdfpi(layer,i)=qfp(layer,i)/Afrac(layer,i) End do ! The flow rate at the tip is same in the direction of frac-pack and perp to the frac-pack qfpo(layer,Ns+1)=qfp(layer,Ns) qfp(layer,Ns+1)=qfp(layer,Ns) vdfpo(layer,Ns+1)=qfpo(layer,Ns+1)/Acore(layer,Ns+1) End Do end if !------------------------- End of calculating the new flow rate distribution in a layer for the time step Do layer =1, ltnum Wi(layer)=Wi(layer)+ql(layer)*dt ! Cumulative inj volume = rate*time End Do Do layer=1,ltnum !---------------------------------------------------- ! Thermal flood zone ellipse geometrical calculations ! Vcw is the volume of water-flooded zone ! Vcool is the volume of cooled zone !---------------------------------------------------- dTemp = Tw(layer)-Tr(layer) ! is independent of time but is a layer property: hence dTemp should be an array if (Swi(layer)<1) then Vcw = Wi(layer)/(pm(layer)*(1-Sor(layer)-Swi(layer))) if (dtemp ==0) then Vcool=Vcw else Vcool = (rhol*Chw(layer)*Wi(layer))/(rhog(layer)*Chg(layer)*(1-pm(layer))+rhol*Chw(layer)*pm(layer)*(1-Sor(layer))+rhoo(layer)*Cho(layer)*pm(layer)*Sor(layer)) !vol of cooled zone end if else Vcw=Wi(layer)/pm(layer) if (dtemp ==0) then Vcool=Vcw else Vcool = (rhol*Chw(layer)*Wi(layer))/(rhog(layer)*Chg(layer)*(1-pm(layer))+rhol*Chw(layer)*pm(layer)) end if end if rc = sqrt(Vcool/(pi*tst(layer))) ! radius of a cylindrically growing cooled zone rz = sqrt(Vcw/(pi*tst(layer))) ! radius of a cylindrically growing water flooded zone !Cooled zone ellipse calculations based on confocal ellipses (infinite fracture conductivity) F1 = (2*Vcool)/(pi*Lfp(layer)*Lfp(layer)*tst(layer)) + 0.5* sqrt((4*Vcool/(pi*Lfp(layer)*Lfp(layer)*tst(layer)))**2+4) !F1 in eqn B-2 P&G1985 acool = Lfp(layer)*(sqrt(F1)+1/sqrt(F1))/2 !major axis of thermal ellipse bcool = Lfp(layer)*(sqrt(F1)-1/sqrt(F1))/2 !minor axis of thermal ellipse !Water-flood zone ellipse calculations based on confocal ellipse (infinite frature conductivity) F2 = (2*Vcw)/(pi*Lfp(layer)*Lfp(layer)*tst(layer)) + 0.5* sqrt((4*Vcw/(pi*Lfp(layer)*Lfp(layer)*tst(layer)))**2+4) !F2 in eqn B-6 P&G1985 acw = Lfp(layer)*(sqrt(F2)+1/sqrt(F2))/2 !major axis of waterflood ellipse bcw = Lfp(layer)*(sqrt(F2)-1/sqrt(F2))/2 !minor axis of waterflood ellipse !Velocity thru perforations vp is relevant ony for the perforated well If (ds>0) Then !Perforation shot density vp = ql(layer)/((pi*rp*rp)*tst(layer)*ds) !velocity through perforations Else vp = 0 End If If ( (bcw>=bfp(layer)) .AND. (bcool>=bfp(layer)) ) then delp1(layer) = ql(layer)*mor(layer)*log((2*re)/(acw+bcw))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) ! pressure difference bet re and water-flood zone Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) !delp2(layer) = ql(layer)*mwi(layer)*log((acw+bcw)/(acool+bcool))/(2*pi*kmh(layer)*Krw(layer)*tst(layer)) ! pressure increase bet waterflood and thermal fronts delp2(layer)=(ql(layer)/2/pi/tst(layer))**npt*Hp/kmh(layer)/krw(layer)*((acw+bcw)**(1-npt)-(acool+bcool)**(1-npt))/(1-npt) !pr. dif bet wf and tf if ( (acw+bcw)>=2*re ) then delp1(layer)=0 !delp2(layer) = ql(layer)*mwi(layer)*log((2*re)/(acool+bcool))/(2*pi*kmh(layer)*Krw(layer)*tst(layer)) ! pressure increase bet waterflood and thermal fronts delp2(layer)=(ql(layer)/2/pi/tst(layer))**npt*Hp/kmh(layer)/krw(layer)*((2*re)**(1-npt)-(acool+bcool)**(1-npt))/(1-npt) !pr. dif bet wf and tf endif Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) !delp4(layer) = ql(layer)*mu*log((acool+bcool)/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*Krw(layer)*tst(layer)) ! pressure increase bet thermal front and fracture delp4(layer)=(ql(layer)/2/pi/tst(layer))**np*Hp/kmh(layer)/krw(layer)*((acool+bcool)**(1-np)-(lfp(layer)+bfp(layer))**(1-np))/(1-np) !pr. dif bet tf and fp ellipse if ( (acool+bcool)>=2*re ) then delp2(layer)=0 end if else if ( (bcw>=bfp(layer)) .AND. (bcool=2*re ) then delp1(layer)=0 !delp2(layer) = ql(layer)*mwi(layer)*log((2*re)/(acool+bcool))/(2*pi*kmh(layer)*Krw(layer)*tst(layer)) ! pressure increase bet waterflood and thermal fronts delp2(layer)=(ql(layer)/2/pi/tst(layer))**npt*Hp/kmh(layer)/krw(layer)*((2*re)**(1-npt)-(acool+bcool)**(1-npt))/(1-npt) !pr. dif bet wf and tf endif !delp2(layer) = ql(layer)*mwi(layer)*log((acw+bcw)/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*Krw(layer)*tst(layer)) ! pressure increase bet waterflood and thermal fronts if ( (acool+bcool)>=2*re ) then delp2(layer)=0 endif delp4(layer) = 0 else delp1(layer) = ql(layer)*mor(layer)*log((2*re)/(acw+bfp(layer)))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) ! pressure difference bet re and water-flood zone !delp1(layer) = ql(layer)*mor(layer)*log((2*re)/(lfp(layer)+bfp(layer)))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) ! pressure difference bet re and water-flood zone if ( (acw+bfp(layer))>=2*re ) then delp1(layer)=0 endif delp2(layer) = 0 delp4(layer) = 0 end if !delpf(layer) = 0.42045*sqrt(sqrt((ql(layer)*mu*Lfp*Y(layer)**3/(((1-n(layer)**2)**3)*(tst(layer)**4))))) delpp(layer) = 0.8338*(rhol*(vp)*(vp)) if (ql(layer) == 0) then res1(layer)=rl0(layer) res2(layer)=0 res4(layer)=0 resp(layer)=0 else Res1(layer) = delp1(layer)/ql(layer) Res2(layer) = delp2(layer)/ql(layer) Res4(layer) = delp4(layer)/ql(layer) Resp(layer) = delpp(layer)/ql(layer) end if !---------------------------------------------------------------------------------------------------------- ! Calculating the updated minimum horizontal stress due to thermal and pore pressure stress !---------------------------------------------------------------------------------------------------------- !calculation of TERM2 in eqn. (3) P&G 1985 TERM2A = (bcool/acool)/(1+(bcool/acool)) TERM2B = 1/(1+(bcool/acool)) TERM2C = 1+0.5*(1.45*(tst(layer)/(2*bcool))**0.9 + 0.35*(tst(layer)/(2*bcool))**2)*(1+(bcool/acool)**0.774) TERM2 = (1/(1-n(layer)))*(TERM2A + TERM2B/TERM2C) dppr = delp1(layer)+delp2(layer)+delp4(layer) if (hist_avg_res_prs==1) then if (pres_multiple_flag==1) then avg_res_pr_change = (pres+excess_res_pr(layer))-pres_multiple(1,1) else avg_res_pr_change = (pres+excess_res_pr(layer))-pres_1(1) end if else avg_res_pr_change = 0 end if Ji = ((1-2*n(layer))/Y(layer))-Cgr(layer)/3 !August 2013 dsp(layer) = Y(layer)*Ji*TERM2*dppr + stress_change_pore_pressure(layer)*avg_res_pr_change ! Pore pressure change due to injection the presence of fracture !added on April 6 2013 !dsp = 0.67*dppr ! Anadarko Heidelberg 2013 and K-2 Field Phase II April 2013 !dsp = stress_change_pore_pressure(layer)*(dppr+avg_res_pr_change) ! Added July August 2013 dst(layer) = Y(layer)*B(layer)*dTemp*TERM2 ! Thermal stress change due to injection in the presence of fracture Sminh(layer) = Sigmamin(layer) + dst(layer) + dsp(layer) ! Current min horizontal stress !------------------------------------------------------------------------------------------------------------- ! Updating the filtration coefficient in and perp. to frac-pack based on the new flow distribution ! Not Updating the filtration coefficient in and perp. to frac-pack based changed on Dec 3 2010 !------------------------------------------------------------------------------------------------------------- Do j = 1, Ns Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kwm(layer,j)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,j)**(np-1) lambdawm(layer,j)=lambda0c(dp,dg(layer),rhop,rhol,mu,vdwm(layer,j),pm(layer)) if (lambdawm(layer,j)==0) then lambdawm(layer,j)=0.1 endif !filtration coefficient in the matrix perpendicular to the frac-pack Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kgf(layer,j,1)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdfpo(layer,j)**(np-1) lambda(layer,j)=lambda0c(dp,dg(layer),rhop,rhol,mu,vdfpo(layer,j),pm(layer)) !filtration coefficient in the frac-pack is equal to gravel-pack fc Hp = kp*((1+3*np)/np)**(np-1)*(8.0*fpk(layer)*krw(layer)*fpp(layer))**((1.0-np)/2.0) mu=Hp*(vdfpi(layer,j))**(np-1) lambdag(layer,j)=lambda0c(dp,fpd(layer),rhop,rhol,mu,vdfpi(layer,j),fpp(layer)) !commented out Ajay Oct 2013 !if (c0_oil>0) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kwm(layer,j)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,j)**(np-1) lambdawm_oil(layer,j)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vdwm(layer,j),pm(layer)) if (lambdawm_oil(layer,j)==0) then lambdawm_oil(layer,j)=0.1 endif mu=Hp*vdfpo(layer,j)**(np-1) lambda_oil(layer,j)=lambda0c(doil,dg(layer),rhooil,rhol,mu,vdfpo(layer,j),pm(layer)) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*fpk(layer)*krw(layer)*fpp(layer))**((1.0-np)/2.0) mu=Hp*(vdfpi(layer,j))**(np-1) lambdag_oil(layer,j)=lambdac(doil,fpd(layer),rhooil,rhol,mu,vdfpi(layer,j),fpp(layer)) !end if end do !Write(99,*) 'New gravel filt coef at the fracpack start = ', lambdag(1,1), ' 1/m' if (Nc(layer) (fpp(layer) - pcr(layer)) ) then ttg(layer,i) = t sigmafp_in_solid(layer,i)=sigmafp_in_solid(layer,i)*(fpp(layer) - pcr(layer))/(sigmafp_in_solid(layer,i) + sigmafp_in_oil(layer,i)) sigmafp_in_oil(layer,i)=sigmafp_in_oil(layer,i)*(fpp(layer) - pcr(layer))/(sigmafp_in_solid(layer,i) + sigmafp_in_oil(layer,i)) kggGravel(layer,i) = fpk(layer)*PermDecl(sigmafp_in_solid(layer,i)+sigmafp_in_oil(layer,i),fpp(layer),fpd(layer),dp,dfg) Write(99,*) 'The frac-pack is plugged internally in layer ',layer,'in segment ',i, 'at t =',t/86400,'days' !----------------------------------------------------------------------------------------- !commented out Jan 29 2011 ! is improved as the segments in front would have a different sigma especially if sigma at the channel tip is too high !delta_sigmagf = sigmafp_in_solid(layer,i) - pre_sigmafp_in_solid !delta_sigmagf_oil = sigmafp_in_oil(layer,i) - pre_sigmafp_in_oil !do ii = Nc(layer)+2,Ns ! sigmafp_in_solid(layer,ii)=sigmafp_in_solid(layer,ii) + delta_sigmagf*exp(-lambdag(layer,ii)*(i-(Nc(layer)+1))*dy(layer)) ! sigmafp_in_oil(layer,ii)=sigmafp_in_oil(layer,ii) + delta_sigmagf_oil*exp(-lambdag_oil(layer,ii)*(i-(Nc(layer)+1))*dy(layer)) ! kggGravel(layer,ii) = fpk(layer)*PermDecl(sigmafp_in_solid(layer,ii)+sigmafp_in_oil(layer,ii),fpp(layer),fpd(layer),dp,dfg) !end do !------------------------------------------------------------------------------------------ exit damage_fp end if kggGravel(layer,i) = fpk(layer)*PermDecl(sigmafp_in_solid(layer,i)+sigmafp_in_oil(layer,i),fpp(layer),fpd(layer),dp,dfg) else hcgrav(layer,i) = hcgrav(layer,i)+(c0+c0_oil*(1-coal_fr))*qfp(layer,i)/Afrac(layer,i)*dt/(1-pc)/1-fpp(layer) !Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) !mu=Hp*((vdfpi(layer,i-1)+vdfpi(layer,i))/2)**(np-1) !Rcgrav(layer,i) = mu*hcgrav(layer,i)/kc/Afrac(layer,i) exit damage_fp End if End do damage_fp ! !------------------------------------------------------------------------------------------------------------- ! Calculating resistance for flow perpendicular to frac-pack (both int and ext) upto the ellipse boundary !------------------------------------------------------------------------------------------------------------- Do j=1,Ns+1 Rrf(layer,j)=0 delpfpo(layer,j)=0 if (ttf(layer,j)(pm(layer)-pcr(layer)) ) then sigmafp_perp_solid(layer,j,i)=sigmafp_perp_solid(layer,j,i)*(pm(layer)-pcr(layer))/(sigmafp_perp_solid(layer,j,i)+sigmafp_perp_oil(layer,j,i)) sigmafp_perp_oil(layer,j,i)=sigmafp_perp_oil(layer,j,i)*(pm(layer)-pcr(layer))/(sigmafp_perp_solid(layer,j,i)+sigmafp_perp_oil(layer,j,i)) !Write(99,*) 'The matrix adjacent to frac-pack is plugged in layer ',layer,'in segment ',j,'at t =',t/86400,'days' ttf(layer,j) = t ! if the critical porosity is reached in a segment other than the first seg then filtration should contine in the segments in which critical por is not reached. end if kgf(layer,j,i) = kmh(layer)*PermDecl(sigmafp_perp_solid(layer,j,i)+sigmafp_perp_oil(layer,j,i),pm(layer),dg(layer),dp,df(layer)) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kgf(layer,j,i)*krw(layer)*(pm(layer)-(sigmafp_perp_solid(layer,j,i)+sigmafp_perp_oil(layer,j,i)))*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdfpo(layer,j)**(np-1) Rrfd(layer,j) = Rrfd(layer,j)+mu*dx/Acore(layer,j)/krw(layer)*(1/kgf(layer,j,i)-1/kmh(layer)) End Do Else ! no more internal filtration in the matrix adjacent to segmented frac-pack; only external cake would form in j segment now if (wfpini(layer,j-1)>2*hccore(layer,j)) then !hccore(layer,j) = hccore(layer,j)+(c0+c0_oil*(1-coal_fr))*vdfpo(layer,j)*dt/(1-pc)/fpp(layer) if (j==Ns+1) then hccore(layer,j) = hccore(layer,j)+(cg(layer,Ns)+cg_oil(layer,Ns)*(1-coal_fr))*vdfpo(layer,j)*dt/(1-pc)/fpp(layer) else hccore(layer,j) = hccore(layer,j)+(cg(layer,j)+cg_oil(layer,j)*(1-coal_fr))*(vdfpo(layer,j)+vdfpo(layer,j+1))/2*dt/(1-pc)/fpp(layer) endif else if (j==Ns+1) then hccore(layer,j) = hccore(layer,j)+(cg(layer,Ns)+cg_oil(layer,Ns)*(1-coal_fr))*vdfpo(layer,j)*dt/(1-pc) else hccore(layer,j) = hccore(layer,j)+(cg(layer,j)+cg_oil(layer,j)*(1-coal_fr))*(vdfpo(layer,j)+vdfpo(layer,j+1))/2*dt/(1-pc) endif !Write(99,*) 'Thickness of ext cake',hccore(layer,j)*1000,' mm in the',j,'segment is more than 1/2 width of fp', wfp(layer,j-1)/2*1000,' mm' !ttg(layer,j-1)=t end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) mu=Hp*vdfpo(layer,j)**(np-1) Rccore(layer,j) = mu*hccore(layer,j)/kc/Acore(layer,j) End if if (bcool>bfp(layer)) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdfpo(layer,j)**(np-1) Rrf(layer,j)=Rrfd(layer,j)+mu*(Lcore(layer,j))/Acore(layer,j)/(kmh(layer)*krw(layer)) else if ( (bcool<=bfp(layer)) .AND. (bcw>bfp(layer)) ) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdfpo(layer,j)**(np-1) Rrf(layer,j)=Rrfd(layer,j)+mu*(bcool*(1-(j*dy(layer))**2/((Ns+1)*dy(layer))**2)**0.5)/Acore(layer,j)/(kmh(layer)*krw(layer)) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) mu=Hp*vdfpo(layer,j)**(npt-1) Rrf(layer,j)=Rrf(layer,j)+mu*(Lcore(layer,j)-bcool*(1-(j*dy(layer))**2/((Ns+1)*dy(layer))**2)**0.5)/Acore(layer,j)/(kmh(layer)*krw(layer)) else if ( (bcool(pm(layer)-pcr(layer))) then sigmawm(layer,i)=sigmawm(layer,i)*(pm(layer)-pcr(layer))/(sigmawm(layer,i)+sigmawm_oil(layer,i)) sigmawm_oil(layer,i)=sigmawm_oil(layer,i)*(pm(layer)-pcr(layer))/(sigmawm(layer,i)+sigmawm_oil(layer,i)) ttwm(layer) = t ! needs to be improved by making sigmawm = sigmastar (pm(layer)-pcr(layer)) !Write(99,*) 'The matrix adjacent to well is plugged in layer ',layer,'at t =',t/86400,'days' end if kwm(layer,i) = kmh(layer)*PermDecl(sigmawm(layer,i)+sigmawm_oil(layer,i),pm(layer),dg(layer),dp,df(layer)) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kwm(layer,i)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,1)**(np-1) Riwmd(layer) = Riwmd(layer)+mu*dx/Aface(layer)/krw(layer)*(1/kwm(layer,i)-1/kmh(layer)) End Do Else ! no more internal filtration in the matrix adjacent to the well and frac-pack; only external cake would form in j segment now hcwm(layer) = hcwm(layer)+(c0+c0_oil*(1-coal_fr))*ql(layer)*Rfp_ellipse(layer)/Rwell(layer)/Aface(layer)*dt/(1-pc) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) mu=Hp*vdwm(layer,1)**(np-1) Rcwm(layer) = mu*hcwm(layer)/kc/Afrac(layer,1) if (hcwm(layer)>wfp(layer,0)/2) then !Write(99,*) 'Thickness of external cake in wellbore equivalent fracture has become more than width of frac-pack' Endif Endif !------------------------------------------------------------------------------------------------------------------- !Skin calculation !------------------------------------------------------------------------------------------------------------------- Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,1)**(np-1) if (flag == 1) then !a_prats>10 use radial model for flow from well to the inner ellipse riwm_forskin(layer)=riwmd(layer)+mu*log((lfp(layer)+bfp(layer))/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else riwm_forskin(layer)=Riwmd(layer)+mu*bfp(layer)/Aface(layer)/(kmh(layer)*krw(layer)) !commented out on oct 13 2010 for testing a>10 end if !-------------------------------------------------------------------------------------------------------------------- if (bcool>bfp(layer)) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,1)**(np-1) if (flag == 1) then !a_prats>10 use radial model for flow from well to the inner ellipse riwm(layer)=riwmd(layer)+mu*log((lfp(layer)+bfp(layer))/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Riwm(layer)=Riwmd(layer)+mu*bfp(layer)/Aface(layer)/(kmh(layer)*krw(layer)) !commented out on oct 13 2010 for testing a>10 end if else if ( (bcool<=bfp(layer)) .AND. (bcw>bfp(layer)) ) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-np)/2.0) mu=Hp*vdwm(layer,1)**(np-1) if (flag == 1) then !a>10 use radial model for flow from well to the inner ellipse riwm(layer)=riwmd(layer)+mu*log((acool+bcool)/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Riwm(layer)=Riwmd(layer)+mu*bcool/Aface(layer)/(kmh(layer)*krw(layer)) !commented out on oct 13 2010 for testing a>10 end if Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) mu=Hp*vdwm(layer,1)**(npt-1) if (flag == 1) then !a>10 use radial model for flow from well to the inner ellipse riwm(layer)=riwm(layer)+mu*log((lfp(layer)+bfp(layer))/(acool+bcool))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Riwm(layer)=Riwm(layer)+mu*(bfp(layer)-bcool)/Aface(layer)/(kmh(layer)*krw(layer)) !commented out oct 123 2010 for testing a>10 end if else if ( (bcool10 use radial model for flow from well to the inner ellipse riwm(layer)=riwmd(layer)+mu*log((acool+bcool)/lf(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Riwm(layer)=Riwmd(layer)+mu*bcool/Aface(layer)/(kmh(layer)*krw(layer)) !commented out on oct 13 2010 for testing a>10 end if Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh(layer)*krw(layer)*pm(layer)*(1-sor(layer)))**((1.0-npt)/2.0) mu=Hp*vdwm(layer,1)**(npt-1) !injected polymer viscosity at reservoir temperature if (flag == 1) then !a>10 use radial model for flow from well to the inner ellipse riwm(layer)=riwm(layer)+mu*log((acw+bcw)/(acool+bcool))/(2*pi*kmh(layer)*krw(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 riwm(layer)=riwm(layer)+mor(layer)*log((lfp(layer)+bfp(layer))/(acw+bcw))/(2*pi*kmh(layer)*kro(layer)*tst(layer)) !added on Oct 13 2010 for testing frac pack results for Prats a>10 else Riwm(layer)=Riwm(layer)+mu*(bcw-bcool)/Aface(layer)/(kmh(layer)*krw(layer)) !commented out on oct 13 2010 for testing a>10 Riwm(layer)=Riwm(layer)+mor(layer)*(bfp(layer)-bcw)/Aface(layer)/(kmh(layer)*kro(layer)) !commented out on oct 13 2010 for testing a>10 end if end if Rwell(layer)=Rcwm(layer)+Riwm(layer) !------------------------------------------------------------------------------------------------------------------- !Skin calculation !------------------------------------------------------------------------------------------------------------------- Rwell(layer)=rcwm(layer)+riwm_forskin(layer) !------------------------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------------------------------------------------- ! Calculation of Resistance for flow in the frac-pack with damaged gravel perm, any filter cake formed inside the gravels at the ! face of the frac-pack and any channel inside the gravels. ! The permeability of a fracpack segment (kgg) is averaged to include any filter cake formed at the faces of the fracpack and any channel !--------------------------------------------------------------------------------------------------------------------------------------------- do i = 1, Ns !if filter cake thickness becomes more than the existing width of the fracpack with or without channel if (2*hccore(layer,i)>=wfp(layer,i-1)) then !the fracpack segment needs to widen up more !Write(99,*) 'The',i,'segment in layer ',layer,' is filled with cake' !Write(*,*) 'The',i,'segment in layer ',layer,' is filled with cake' wc(layer,i-1)=0 !the existing channel is filled by filter cake !kchannel(layer,i)=kc !the channel perm is equal to the filter cake perm wfp(layer,i-1)=2*hccore(layer,i) !the fracpack width is updated fp_avg_por(layer,i)=pc*(fpp(layer)-(sigmafp_in_solid(layer,i) + sigmafp_in_oil(layer,i))) kgg(layer,i)=kc kggnew(layer,i)=kc elseif ((2*hccore(layer,i)>wfpini(layer,i-1)) .AND. (2*hccore(layer,i) (maj_axis_w(layer)+min_axis_w(layer))) then Eff_M = Eff_M + mor(layer)/kmh(layer)/kro(layer)*log(2*re/(maj_axis_w(layer)+min_axis_w(layer))) Eff_M = Eff_M/log(2*re/lfp(layer)) else Eff_M = Eff_M/log((maj_axis_w(layer)+min_axis_w(layer))/lfp(layer)) endif Eff_M = 1/Eff_M if (ql(layer)==0) then pdss=0 else pdss=1/141.2*dp_fronts(layer)/6894.76*(tst(layer)*3.2808)*(Eff_M*(1e+15/1000))/(ql(layer)*543439.6331) endif sum=0 Do i=1,counter !Multi injection rates td=0.0002637*Eff_M*(1e+15/1000)*((t-(i-1)*dt)/3600)/pm(layer)/(ctot(layer)*6894.76)/(Lfp(layer)*3.2808)**2 ! ----- Jongsoo 201309: Start ----- !pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))-0.067*Ei(-0.018/td)-0.433*Ei(-0.75/td) if (.018/td < 60 .AND. 0.75/td < 60) then pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))+0.067*E1(0.018/td)+0.433*E1(0.75/td) else if (.018/td < 60) then pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))+0.067*E1(0.018/td) else pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td))) ! For .018/td > 60, E1(.018/td) ~ 0 end if ! ----- Jongsoo 201309: End ----- if (i==1) then if (pd > pdss) then trans(layer)=0 !transient is over !go to 1000 ! end of transient if then else Exit else trans(layer)=1 end if sum = sum+qlhist(layer,i)*543439.6331*min(pd,pdss) else sum = sum+(qlhist(layer,i)-qlhist(layer,i-1))*543439.6331*min(pd,pdss) endif end do delptrans(layer)=sum*141.2/(Eff_M*(1e+15/1000))/(tst(layer)*3.2808)*6894.76 !from psi to pascals else 1000 delptrans(layer)=dp_fronts(layer) end if do k = 1,3 !loop for convergence of flow rate and new width of the frac pack (changing flow resistance) !------------------------------------------------------------------------------------------------------------- ! Calculation of Total Resistance (Rfp_ellipse) from the well to the equipressure ellipse after damage !------------------------------------------------------------------------------------------------------------- if (q==0) then Rfp_ellipse(layer)=1/Rwell(layer)+1/Rfracpack0(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) else Resis=Rcore(layer,Ns+1) Do i=Ns,1,-1 Resis=1/(Resis+Rrfg(layer,i))+1/Rcore(layer,i) Resis=1/Resis Enddo Rfracpack(layer)=Resis Rfp_ellipse(layer)=1/Rwell(layer)+1/Rfracpack(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) end if delpfp_ellipse(layer) = ql(layer)*Rfp_ellipse(layer) !********************************************************************************************************************* !rskin is the flow resistance due to initial skin + additional skin due to permeability damage of foramtion, frac-pack and cake build up rskin(layer)=(skin0(layer)-skin_frac_pack(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp) !rskin(layer)=-skin_frac_pack(layer)/(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp) if (trans(layer)==0) then !transient is over Rl(layer) = Res1(layer) + Res2(layer) + Res4(layer) + Rfp_ellipse(layer) + Resp(layer) + rskin(layer) else Rl(layer) = delptrans(layer)/ql(layer) + Rfp_ellipse(layer) + Resp(layer) + rskin(layer) end if !Piwf(layer) = Pres + delp1(layer) + delp2(layer) + delp4(layer) + delpfp_ellipse(layer) + delpp(layer) !BHP in the wellbore Piwf(layer) = (Pres+excess_res_pr(layer)) + delptrans(layer) + delpfp_ellipse(layer) + delpp(layer) + rskin(layer)*ql(layer) !Dec 5 2008 !Rl(layer)=(Piwf(layer)-Pres)/ql(layer) !Write(99,*) 'The BHP without pkw loop in layer ',layer,' = ',piwf(layer)/6894.76 P1(layer) = Piwf(layer) - delpp(layer) -rskin(layer)*ql(layer) !LHS of eqn.12 P&G1985 pfp(layer,Ns+1) = P1(layer) - delpfp_ellipse(layer) pfp(layer,Ns)=qfpo(layer,Ns+1)*Rcore(layer,Ns+1)+pfp(layer,Ns+1) Ptip(layer)=pfp(layer,Ns) !----------------------------------------------------------------------------------------------------------------------- ! Calculating the new flow rate distribution in and around the frac-pack ! It is calculated based on flow resistance of the fracpack without width correction based on the pressures calculated ! ahead and the flow resistance of the matrix perpendicular to the segment up to the ! constant pressure ellipse boundary ! Rcore is the resistance perpendicular to the frac-pack segment ! Resis is the equivalent flow resistance ahead of the frac-pack segment !----------------------------------------------------------------------------------------------------------------------- if (q/=0) then !The following alg. was commented out before March 29 2013 qfpo(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rwell(layer) ! flow rate perp to the equivalent well fracture qfp(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rfracpack(layer) ! flow rate into the frac-pack Do i=1,Ns Resis = Rcore(layer,Ns+1) Do j = Ns, i, -1 Resis = 1 / (Resis + Rrfg(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / Resis End do qfpo(layer,i)=qfp(layer,i-1)*Resis/Rcore(layer,i) qfp(layer,i) = qfp(layer,i-1) - qfpo(layer,i) vdfpo(layer,i)=qfpo(layer,i)/Acore(layer,i) vdfpi(layer,i)=qfp(layer,i)/Afrac(layer,i) End do ! The flow rate at the tip is same in the direction of frac-pack and perp to the frac-pack qfpo(layer,Ns+1)=qfp(layer,Ns) qfp(layer,Ns+1)=qfp(layer,Ns) vdfpo(layer,Ns+1)=qfpo(layer,Ns+1)/Acore(layer,Ns+1) end if !end do ! End of convergence for RrfgND term as it was flow rate dependent !Calculated Rrfg with previous widths of the fracpack !---------------------------------------------------------------------------------------------------------- !Going to calculate the pressure in the fracpack with previous width of the fracpack !---------------------------------------------------------------------------------------------------------- Do i=Ns,1,-1 pfp(layer,i-1)=pfp(layer,i)+qfp(layer,i)*Rrfg(layer,i) End do !------------------------------------------------------------------------------------------------------------------------------------------ ! Checking for pressures in the frac-pack if they are greater than the net pressures ! If yes then the frac-pack will widen and satisfy the width pressure relation and also satisfy the flow equation by adjusting the kgg ! If no then the frac-pack width remains equal to the initial width ! If the filter cake thickness is more than the wini but the flowing pressure is less than the net pressure then the frac-pack will ! just widen up but need not satisfy the width pressure relation but satisfy only the flow equation. ! Calculation of converged w, k and P in the frac-pack segments with new kggGravel and hccore ! Calculation of channel length in the frac-pack up to which the widening/channeling has reached. !------------------------------------------------------------------------------------------------------------------------------------------ Nc(layer)=0 wc(layer,:)=0 !Added on Jan 29 2011 kchannel(layer,:)=0 !Added on Jan 29 2011 !wfp(layer,:)=wfpini(layer,:)!Added on Jan 29 2011 do i = Ns-1, 0, -1 if (2*hccore(layer,i+1) > wfpini(layer,i)) then pfpstar(layer,i)= Sminh(layer)+2*hccore(layer,i+1)*Y(layer)/(2.0*(1-n(layer)*n(layer))*tst(layer)) pfpstar(layer,i)= Sminh(layer)+2*hccore(layer,i+1)*Y(layer)/(2.0*(1-n(layer)*n(layer))*tst_sum) !May 2013 Heidelberg else pfpstar(layer,i)= Sminh(layer)+wfpini(layer,i)*Y(layer)/(2.0*(1-n(layer)*n(layer))*tst(layer)) pfpstar(layer,i)= Sminh(layer)+wfpini(layer,i)*Y(layer)/(2.0*(1-n(layer)*n(layer))*tst_sum) !May 2013 Heidelberg endif !Added on May 2013 since the pressure required to open the frac pack is just sigmain + any extra width !pfpstar(layer,i)= Sminh(layer)+wc_prev(layer,i)*Y(layer)/(2.0*(1-n(layer)*n(layer))*tst(layer)) if ( pfp(layer,i) > pfpstar(layer,i) ) then !Frac-pack segment needs to widen up !Write(*,*) !Write(*,*) "t =",t/86400,'days' !Write(99,*) "t =",t/86400,'days' !Write(*,*)'The pres in',i+1,'seg is > p* by',(pfp(layer,i)-pfpstar(layer,i))/6894.76,'psi' !Write(99,*)'The pres in',i+1,'seg is > p* by',(pfp(layer,i)-pfpstar(layer,i))/6894.76,'psi' if (Nc(layer) < i+1) then Nc(layer) = i+1 end if pfplow = pfpstar(layer,i) !+0.001*6894.76 pfphigh = pfpstar(layer,i) +100.0*6894.76 !this is assumed to be the highest that pfp could go pfp(layer,i)=pfplow !first guess for consistent pressure, width and perm for the segment pkeffw_loop: do j = 1, 50 !Write(*,*) "Iteration no. = ",j !Write(99,*) "Iteration no. = ",j !Write(*,*) "Pfp Guess =",pfp(layer,i)/6894.76,'psi' !Write(99,*) "Pfp Guess =",pfp(layer,i)/6894.76,'psi' wfpnew(layer,i)=2*(pfp(layer,i)-Sminh(layer))*(1-n(layer)*n(layer))*tst(layer)/Y(layer) wfpnew(layer,i)=2*(pfp(layer,i)-Sminh(layer))*(1-n(layer)*n(layer))*tst_sum/Y(layer) !May 2013 Heidelberg !write(*,*) !write(99,*) !write(*,*) 'wfpnew for layer',layer, 'segment no',i,wfpnew(layer,i)*1E3, 'mm' !write(99,*) 'wfpnew for layer',layer, 'segment no',i,wfpnew(layer,i)*1E3,'mm' if (2*hccore(layer,i+1)>wfpini(layer,i)) then wfp(layer,i)=2*hccore(layer,i+1) !width without channel wc(layer,i)=wfpnew(layer,i)-2*hccore(layer,i+1) else wfp(layer,i)=wfpini(layer,i) !width without channel wc(layer,i)=wfpnew(layer,i)-wfpini(layer,i) endif !write(*,*) !write(99,*) !write(*,*) 'wc for layer',layer, 'segment no',i,wc(layer,i)*1E3, 'mm' !write(99,*) 'wc for layer',layer, 'segment no',i,wc(layer,i)*1E3,'mm' !dummy1=wc(layer,i) !wc(layer,i)=wfpnew(layer,i)-wfp(layer,i) !if (dummy1 /= wc(layer,i)) then ! Write(99,*) dummy1, wc(layer,i) !endif kchannel(layer,i+1) = wc(layer,i)**2/12 kggnew(layer,i+1)=(kgg(layer,i+1)*wfp(layer,i)+kchannel(layer,i+1)*wc(layer,i))/wfpnew(layer,i) !write(*,*) !write(99,*) !write(*,*) 'kggnew for layer',layer, 'segment no',i+1,kggnew(layer,i+1)*1E15 !write(99,*) 'kggnew for layer',layer, 'segment no',i+1,kggnew(layer,i+1)*1E15 Afracnew(layer,i+1)=2*(wfpnew(layer,i)+wfpnew(layer,i+1))/2*tst(layer) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kggnew(layer,i+1)*krw(layer)*fp_avg_por(layer,i+1))**((1.0-np)/2.0) mu=Hp*(qfp(layer,i+1)/Afracnew(layer,i+1))**(np-1) RrfgnewD(layer,i+1) = mu*dy(layer)/Afracnew(layer,i+1)/kggnew(layer,i+1) RrfgnewND(layer,i+1)=0 !qfp(layer,i+1)*NDC(fpd(layer),kggnew(layer,i+1))*rhol*dy(layer)/(Afracnew(layer,i+1)**2) Rrfgnew(layer,i+1)=rrfgnewD(layer,i+1)+rrfgnewND(layer,i+1) pfpnew(layer,i)=pfp(layer,i+1)+Rrfgnew(layer,i+1)*qfp(layer,i+1) !pfpnew(layer,i)=pfp(layer,i+1)+mu*qfp(layer,i+1)*dy(layer)/kggnew(layer,i+1)/2/wfpnew(layer,i)/tst(layer)+(qfp(layer,i+1)**2)*NDC(fpd(layer),kggnew(layer,i+1))*rhol*dy(layer)/(Afrac(layer,i+1)**2) ! Pressure iteration values output !Write(*,*) "Pfp Calculated =",pfpnew(layer,i)/6894.76,'psi' !Write(99,*) "Pfp Calculated =",pfpnew(layer,i)/6894.76,'psi' !Write(*,*) "Pfp Error =",(pfpnew(layer,i)-pfp(layer,i))/6894.76,'psi' !Write(99,*) "Pfp Error =",(pfpnew(layer,i)-pfp(layer,i))/6894.76,'psi' if (abs(pfpnew(layer,i)-pfp(layer,i))/6894.76 <0.1) then !Write(*,*) 'Successful PKW convergence within 0.1 psi' !Write(99,*) 'Successful PKW convergence within 0.1 psi' exit pkeffw_loop end if !if (pfpnew(layer,i) < pfphigh) then !pfphigh was the highest, therefore reducing pfphigh to pfpnew ! pfphigh = pfpnew(layer,i) ! Write(*,*) "pfphigh reduced to pfpnew" ! Write(99,*) "pfphigh reduced to pfpnew" !end if !if (pfpnew(layer,i) < pfplow) then ! pfphigh = pfp(layer,i) ! Write(*,*) "How can pfpnew be lower than pfplow" ! Write(99,*) "How can pfpnew be lower than pfplow" ! Write(*,*) "pfphigh changed to pfp" ! Write(99,*) "pfphigh changed to pfp" !end if if (pfpnew(layer,i)>pfp(layer,i)) then pfplow = pfp(layer,i) !Write(*,*) "pfplow increased to pfp" !Write(99,*) "pfplow increased to pfp" else pfphigh = pfp(layer,i) !Write(*,*) "pfphigh reduced to pfp" !Write(99,*) "pfphigh reduced to pfp" end if pfp(layer,i) = (pfplow+pfphigh)/2 !write(*,*) !Write(*,*) "Pfp low =",pfplow/6894.76,'psi' !Write(*,*) "Pfp =",pfp(layer,i)/6894.76,'psi' !Write(*,*) "Pfp high =",pfphigh/6894.76,'psi' !write(99,*) !Write(99,*) "Pfp low =",pfplow/6894.76,'psi' !Write(99,*) "Pfp =",pfp(layer,i)/6894.76,'psi' !Write(99,*) "Pfp high =",pfphigh/6894.76,'psi' if (j==50) then !Write(99,*) 'The last iteration',j,'reached in PKW loop' Write(99,*) "Time(days)",t/86400, "Seg",i,"Error",(pfpnew(layer,i)-pfp(layer,i))/6894.76,'psi' !Write(*,*) 'The last iteration',j,'reached in PKW loop' Write(*,*) "Time(days)",t/86400,"Seg",i,"Error",(pfpnew(layer,i)-pfp(layer,i))/6894.76,'psi' !Stop end if end do pkeffw_loop wfp(layer,i)=wfpnew(layer,i) Afrac(layer,i+1)=Afracnew(layer,i+1) !kgg(layer,i+1)=kggnew(layer,i+1) rrfg(layer,i+1)=rrfgnew(layer,i+1) rrfgD(layer,i+1)=rrfgnewD(layer,i+1) rrfgND(layer,i+1)=rrfgnewND(layer,i+1) end if end do !pressure and width calculation loop wc_prev(layer,:)=wc(layer,:) !------------------------------------------------------------------------------------------------------------------------------------------------ ! Calculation of Total Resistance (Rfp_ellipse) from the well to the equipressure ellipse after new width and frac pack resistace !------------------------------------------------------------------------------------------------------------------------------------------------ if (q==0) then Rfp_ellipse(layer)=1/Rwell(layer)+1/Rfracpack0(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) else Resis=Rcore(layer,Ns+1) Do i=Ns,1,-1 Resis=1/(Resis+Rrfg(layer,i))+1/Rcore(layer,i) Resis=1/Resis Enddo Rfracpack(layer)=Resis Rfp_ellipse(layer)=1/Rwell(layer)+1/Rfracpack(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) end if delpfp_ellipse(layer) = ql(layer)*Rfp_ellipse(layer) !------------------------------------------------------ !Added on Jan 29 2011 delpfp_ellipse(layer) = pfp(layer,0)-pfp(layer,Ns+1) !This would over write the previous delpfp_ellipse calculation !------------------------------------------------------ !------------------------------------------------------------------------------------------------------------- ! Calculation of flow resistance (Rfp_ellipse) from the well to the equipressure ellipse with flowing ! phase as injection water at injection water temperature all up to the equipressure ellipse ! Therefore the change should only be due to the permeability and width change of the frac pack ! and the permeability change perpendicular to the frac pack (all this means skin) !------------------------------------------------------------------------------------------------------------- if (q==0) then Rfp_ellipse(layer)=1/Rwell0_forskin(layer)+1/Rfracpack0_forskin(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) else Resis=Rcore_forskin(layer,Ns+1) Do i=Ns,1,-1 Resis=1/(Resis+Rrfg(layer,i))+1/Rcore_forskin(layer,i) Resis=1/Resis Enddo Rfracpack(layer)=Resis Rfp_ellipse(layer)=1/Rwell(layer)+1/Rfracpack(layer) Rfp_ellipse(layer)=1/Rfp_ellipse(layer) end if !********************************************************************************************************************* !Calculating skin with time !********************************************************************************************************************* !skin0 is the initial well skin !skin_frac_pack is the skin due to ideal frac pack !Rfp_ellipse is due to real(8) frac pack !skin(layer) is hypothetical, i mean it shouldn't be used in calculating the actual pressure drops. skin(layer)=skin0(layer)+(Rfp_ellipse(layer)-Rfp_ellipse0(layer))*2*pi*kmh(layer)*krw(layer)*tst(layer)/kp !********************************************************************************************************************* !rskin is the flow resistance due to initial skin rskin(layer)=(skin0(layer)-skin_frac_pack(layer))/(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp) !rskin(layer)=-skin_frac_pack(layer)/(2*pi*kmh(layer)*krw(layer)*tst(layer)/kp) if (trans(layer)==0) then !transient is over Rl(layer) = Res1(layer) + Res2(layer) + Res4(layer) + Rfp_ellipse(layer) + Resp(layer) + rskin(layer) else Rl(layer) = delptrans(layer)/ql(layer) + Rfp_ellipse(layer) + Resp(layer) + rskin(layer) end if Piwf(layer)=(Pres+excess_res_pr(layer))+delptrans(layer)+delpfp_ellipse(layer)+delpp(layer) +rskin(layer)*ql(layer) ! Dec 5 2008 !Write(99,*) 'The BHP with widening in layer ',layer,' = ',piwf(layer)/6894.76 !Write(*,*) 't=',t/86400,' BHP in',layer,' = ',piwf(layer)/6894.76 P1(layer) = Piwf(layer) - delpp(layer) - rskin(layer)*ql(layer) !LHS of eqn.12 P&G1985 pfp(layer,Ns+1) = P1(layer) - delpfp_ellipse(layer) pfp(layer,Ns)=qfpo(layer,Ns+1)*Rcore(layer,Ns+1)+pfp(layer,Ns+1) Ptip(layer)=pfp(layer,Ns) !----------------------------------------------------------------------------------------------------------------------- ! Calculating the new flow rate distribution in and around the frac-pack after new width calculation !----------------------------------------------------------------------------------------------------------------------- if (q/=0) then qfpo(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rwell(layer) ! flow rate perp to the equivalent well fracture qfp(layer,0)=ql(layer)*Rfp_ellipse(layer)/Rfracpack(layer) ! flow rate into the frac-pack Do i=1,Ns Resis = Rcore(layer,Ns+1) Do j = Ns, i, -1 Resis = 1 / (Resis + Rrfg(layer,j)) + 1 / Rcore(layer,j) Resis = 1 / Resis End do qfpo(layer,i)=qfp(layer,i-1)*Resis/Rcore(layer,i) qfp(layer,i) = qfp(layer,i-1) - qfpo(layer,i) vdfpo(layer,i)=qfpo(layer,i)/Acore(layer,i) vdfpi(layer,i)=qfp(layer,i)/Afrac(layer,i) End do ! The flow rate at the tip is same in the direction of frac-pack and perp to the frac-pack qfpo(layer,Ns+1)=qfp(layer,Ns) qfp(layer,Ns+1)=qfp(layer,Ns) vdfpo(layer,Ns+1)=qfpo(layer,Ns+1)/Acore(layer,Ns+1) end if !Going to calculate the pressure in the fracpack with new width of the fracpack !---------------------------------------------------------------------------------------------------------- Do i=Ns,1,-1 pfp(layer,i-1)=pfp(layer,i)+qfp(layer,i)*Rrfg(layer,i) End do !Write(*,*) 'The BHP with pres width check in layer',layer,'=',pfp(layer,0)/6894.76 !Write(99,*) 'The BHP with pres width check in layer',layer,'=',pfp(layer,0)/6894.76 end do ! q convergence in the frac-pack along with pkw loop march 29 2013 !---------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------- ! end do ! q convergence in the frac-pack along with pkw loop for Non-Darcy flow !---------------------------------------------------------------------------------------------------------- !Write(99,*) 'Time = ', t/86400 !Write(99,*) 'Total fracpack delp in layer ', layer, ' = ', (pfp(layer,0)-pfp(layer,Ns+1))/6894.76 !Write(99,*) !Write(99,*) 'Nc ', layer, ' = ', Nc(layer) ! ---------------------------------------------------------------------------------------------------------- ! Fracture propagation pressure ! ---------------------------------------------------------------------------------------------------------- RHS(layer)= Sminh(layer) + sqrt((pi*U*Y(layer))/(2*(1-n(layer)*n(layer))*tst(layer)/2)) 120 Format (500E13.5) !if ( (Ptip(layer)>RHS(layer)) .OR. (Nc(layer)==Ns+1) ) then if (Ptip(layer)>RHS(layer)) then Write(99,*) 'T=', t/86400 !Write(99,*) 'Layer No.=', layer Write(99,*) ' Pressure at the fracpack tip is larger than Frac prop pressure' Write(99,*) 'Ptip:',Ptip(layer)/6894, '> FP:',RHS(layer)/6894 ptip_flag = 1 else !Write(99,*) 'T=', t/86400 !Write(99,*) 'Layer No.=', layer !Write(99,*) 'Ptip:',Ptip(layer)/6894, '< FP:',RHS(layer)/6894 End if Sig_min_cur(layer)=Sminh(layer) maj_axis_t(layer)=acool min_axis_t(layer)=bcool maj_axis_w(layer)=acw min_axis_w(layer)=bcw !----------------------------------------------------------------------------------------------- ! Writing layer segment variables to The Output Files !----------------------------------------------------------------------------------------------- ! Output files numbers ! Maximum number of layers considered is 100 for setting the numbers below. !----------------------------------------------------------------------------------------------- ! lambdafp: 1 - 100 ! lambdafpo: 101 - 200 ! lambdawm: 201 - 300 ! kfp: 301 - 400 ! kfpo: 401 - 500 ! kwm: 501 - 600 ! hfp: 601 - 700 ! hfpo: 701 - 800 ! hwm: 801 - 900 ! Rfp: 901 - 1000 ! Rfpo: 1001 - 1100 ! Rwm: 1101 - 1200 ! R: 1201 - 1300 ! delp: 1301 - 1400 ! wfp: 1401 - 1500 ! pfp: 1501 - 1600 ! pnet: 1601 - 1700 ! qfp: 1701 - 1800 ! qfpo: 1801 - 1900 Write (1+layer,110) t/86400, lambdag(layer,:) Write (50+layer,110) t/86400, (fpp(layer)-(sigmafp_in_solid(layer,:) + sigmafp_in_oil(layer,:))) ! Write (100+layer,110) t/86400, lambda(layer,:) ! Write (200+layer,110) t/86400, lambdawm(layer,:) Write (250+layer,110) t/86400, cg(layer,:)*1e6 Write (250+layer,110) ! Write (300+layer,100) t/86400, kggnew(layer,:)*10.0**12 ! Darcy ! Write (310+layer,110) t/86400, kggnew(layer,:)*10.0**12 ! Darcy Do j = 1, Ns+1 res_perm(j)=0 do k = 1, Ns res_perm(j)=res_perm(j)+dx/(kgf(layer,j,k)*10.0**15) end do end do ! Write (400+layer,100) t/86400, Ns*dx/res_perm(:) ! md ! Write (500+layer,110) t/86400, kwm(layer,:)*10.0**15 ! md ! Write (600+layer,100) t/86400, hcgrav(layer,:)*1000 ! mm ! Write (700+layer,100) t/86400, hccore(layer,:)*1000 ! mm ! Write (800+layer,100) t/86400, hcwm(layer)*1000 ! mm ! Write (900+layer,100) t/86400, Rrfg(layer,:) ! Write (1000+layer,100) t/86400, Rcore(layer,:) ! Write (1100+layer,100) t/86400, Rcwm(layer),Riwm(layer) ! Write (1200+layer,100) t/86400, Res1(layer),Res2(layer),Res4(layer),Rfp_ellipse(layer),RL0(layer),Resp(layer) ! Write (1300+layer,100) t/86400, delptrans(layer)/6894.76,delp1(layer)/6894.76,delp2(layer)/6894.76,delp4(layer)/6894.76,delpfp_ellipse(layer)/6894.76,rskin(layer)*ql(layer)/6894.76,dst(layer)/6894.76,dsp(layer)/6894.76 Write (1300+layer,100) t/86400, delp1(layer)*0.0001450377, delp2(layer)*0.0001450377, delp4(layer)*0.0001450377, delptrans(layer)*0.0001450377, delpfp_ellipse(layer)*0.0001450377, rskin(layer)*ql(layer)*0.0001450377,delpp(layer)*0.0001450377, Ptip(layer)*0.0001450377, rhs(layer)*0.0001450377, Sminh(layer)*0.0001450377, sigmamin(layer)*0.0001450377, dst(layer)*0.0001450377, dsp(layer)*0.0001450377 ! Write (1400+layer,100) t/86400, wfp(layer,:)*1000 ! writing width of the frac-pack based on P1-sigmamin (mm) ! Write (1500+layer,100) t/86400, pfp(layer,:)/6894.76 ! writing pressures in the frac-pack (psi) ! Write (1600+layer,100) t/86400, pfpstar(layer,:)/6894.76 ! writing critical pressures for widening in the frac-pack (psi) ! Write (1700+layer,100) t/86400, qfp(layer,:)*543439.6331 ! writing flow rate in the frac-pack (bpd) ! Write (1800+layer,100) t/86400, qfpo(layer,:)*543439.6331 ! writing flow rate perp to the frac-pack (bpd) ! End of layer loop end do !---------------------------------------------------------------------------------------------------------- ! Calculating average BHP for all the layers ! Actually all the layers should have equal BHP ! However numerics and non-linear relationship bet q and delp in the fracture causes them to be unequal Piwfdd=0 Do layer=1,ltnum Piwfdd=piwf(layer)+Piwfdd End Do Piwfdd=Piwfdd/ltnum ! Added by Ajay on Aug 26 2009 for skin calculation before the next injection rate !----------------------------------------------------------------------------------------------- avg_pres=0 do i = 1,ltnum avg_pres = avg_pres+pres+excess_res_pr(i) end do avg_pres=avg_pres/ltnum ! !---------------------------------------------------------------------------------------------------------- dummy1=0 do layer = 1, ltnum !dummy1=dummy1+(kmh(layer)*krw(layer)*tst(layer)/kp)*(piwfdd-(pres+excess_res_pr(layer)))/(log(re/rw)+skin(layer)) dummy1=dummy1+(kmh(layer)*krw(layer)*tst(layer)/kp)/(log(re/rw)+skin(layer)) end do !skintot=kh_mu*(Piwfdd-avg_pres)/dummy1-log(re/rw) skintot=kh_mu/dummy1-log(re/rw) !---------------------------------------------------------------------------------------------------------- Rtot=0 Do layer=1,ltnum Rtot=Rtot+1/Rl(layer) Do i = 1, Ns Afrac(layer,i)=2*(wfp(layer,i-1)+wfp(layer,i))/2*tst(layer) End do End Do Rtot=1/Rtot !---------------------------------------------------------------------------------------------------------- ! Next injection rate for the next time step (only until the last time step) !---------------------------------------------------------------------------------------------------------- if (t/86400layer) then !the perforated layer is below the unperforated layer Do i = layer, layers Rl_vert_layer_layers = Rl_vert_layer_layers + h(i)/2/kmv(i)/Avert end do else !the perforated layer is above the unperforated layer Do i = layers, layer Rl_vert_layer_layers = Rl_vert_layer_layers + h(i)/2/kmv(i)/Avert End do Endif sumRl_vert_layer_layers = sumRl_vert_layer_layers + 1/Rl_vert_layer_layers Endif End do if (sumRl_vert_layer_layers /= 0) then Rl_vert(layer)=1/sumRl_vert_layer_layers end if end if End do End Subroutine calc_Rl_Vert !----------------------------------------------------------------------------------------------------------- ! Function NDC ! Calculates the Non Darcy Coefficient for flow in the frac-pack, NDC = 1.01325*10^8*b*Kfp^(-a) ! Where Kfp is in Darcy and NDC in 1/meters ! Reference: Cooke,C.Y.Jr., SPE-AIME 1973, Conductivity of Fracture Proppants in Multiple Layers, Pg. 1106 !----------------------------------------------------------------------------------------------------------- real(8) Function NDC(dg, kfp) real(8) :: a, b ! The coefficients in the equation: NDC = b*k^(-a) real(8) :: dg, kfp ! The coefficients in the equation: NDC = b*k^(-a) If (dg<=251E-6) then ! Estimated a and b from their trend a = 1.70 b = 1.00 Write(*,*) 'The diameter of gravels is too small, less than 251 microns' Write(99,*) 'The diameter of gravels is too small, less than 251 microns' else If ( (dg>251E-6) .AND. (dg<=422E-6) ) then a = 1.60 b = 1.10 else If ( (dg>422E-6) .AND. (dg<=853E-6) ) then a = 1.54 b = 2.65 else If ( (dg>853E-6) .AND. (dg<=1680E-6) ) then a = 1.34 b = 2.63 else If ( (dg>1680E-6) .AND. (dg<=2440E-6) ) then a = 1.24 b = 3.32 else If (dg>2440E-6) then ! Estimated a and b from their trend Write(*,*) 'The diameter of gravels is too big, more than 2.44 mm' Write(99,*) 'The diameter of gravels is too big, more than 2.44 mm' a = 1.14 b = 3.63 end if NDC = 1.01325E8*b*(kfp*1E12)**(-a) End Function NDC !------------------------------------------------------------------------------------ ! Function Frac_bfp ! Calculates the Minor Axis of the constant pressure boundary ellipse (bfp) ! around the frac-pack with the major axis equal to the length of the frac-pack (lfp) !------------------------------------------------------------------------------------ real(8) Function Frac_bfp(kmh,kr,lfp,gpk,wfp) real(8) :: a !SPE 1575-G by Prats (Effect of Vertical Fractures on Reservoir Behavior) real(8) :: kmh,kr,gpk,wfp,lfp a = 3.14159*(kmh*kr)*lfp/2/gpk/wfp Write(*,*) 'a = ',a Write(99,*) Write(99,*) 'a = ',a If (a<=0.1) then Frac_bfp = lfp*(1.35*a) else If ( (a>0.1) .AND. (a<=1) ) then Frac_bfp = lfp*(0.35*a+0.1) else if ( (a>1) .AND. (a<=10) ) then Frac_bfp = lfp*(0.05*a+0.4) else if ( (a>10) .AND. (a<=100) ) then Frac_bfp = lfp*(0.0009*a+.8911) else if (a>100) then Frac_bfp = lfp*0.99 Write(*,*) 'a has become larger than 100 reduce a and then run the program' Write(99,*) 'a has become larger than 100; reduce a and then run the program' !STOP end if End Function Frac_bfp End Module widcalc !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! End of the main module Widcalc !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !5/27/98 This is Ellipse code Perkins & Gonzalez running fine with iteration loop on Lf, !also has time loop in the main program. t is the only variable that is commonly defined !in a module statement. !------------------------------------------------------------ ! CalcPGF1 ! ! This model implements the semi-analytical method of Perkins and Gonzalez, Feb 1985, SPEJ ! Fracture growth and face plugging are modeled by Prasad Saripalli May 1998 ! For use by WID 3.1 to do calculations of growing fractures ! ! Modified by Ajay Suri Nov 2006 for UTWID 7.0 !-------------------------------------------------------------- ! PGFellipse2 assumes: ! 1. A fracture length between old fracture length and a max frac len (re) ! 2. Calculates the major and minor axes of waterflood front and thermal front for the assumed lf ! 3. Delp's and corresponding resistivities for the assumed lf ! Using the above information and function fast it calculates a converged fracture length and corresponding outputs ! Global variables used: ! 1. Wi Volume of water injected into the layer upto time t ! 2. Cum_parr Volume of solid particles injected into the layer upto time t ! 3. Cum_oill Volume of oil particles injected into the layer upto time t ! 4. Aface Area of the fracture face perpendicular to flow ! 5. Ns Number of segments of the internal damage zone ! 6. dx Segment length of the internal damage zone ! 7. lambda0 Filtration coefficient for solids in the damage zone ! 8. lambda0_oil Filtration coefficient for oil particles in the damage zone ! 9. pm Initial porosity of the damage zone ! 10. pcr Critical porosity for the layer into consideration ! 11. ql Flow rate into the layer ! 12. c0 Volume concentration of the solids in the injected water ! 13. dg Formation grain diameter for the layer into consideration ! 14. dp Solids diameter in the injected water ! 15. doil Oil particle diameter in the injected water ! 16. kmh Horizontal permeability of the layer ! 17. df Damage factor ! 18. t Total injection time elapsed ! 19. pc External cake porosity ! 20. kc External cake permeability ! 21. U Specific surface energy ! 22. n Poisson's ratio ! 23. Y Young's modulus ! 24. Tw Injected water temperature ! 25. Tr Initial reservoir temperature ! 26. Swi Initial water saturation ! 27. Sor Residual oil saturation ! 28. rhol Density of injected liquid/water ! 29. rhoo Density of oil ! 30. rhog Density of formation grains ! 31. Chw Specific heat of water ! 32. Cho Specific heat of oil ! 33. Chg Specific heat of grains ! 34. B Linear coefficient of thermal expansion of the formation ! 35. ds Perforation shot density ! 36. rp Perforation radius ! 37. re Drainage / Far field constant pressure boundary radius from well ! 38. rw Well radius ! 39. h Height/thickness of layer ! 40. pres_ini Initial reservoir pressure in a layer ! 40. pres Current reservoir pressure in a layer ! 41. kro Relative permeability to oil at Swi ! 42. Krw Relative permeability to water at Sor ! 43. mor Viscosity of oil in the reservoir ! 44. mwi Viscosity of water in the reservoir ! 45. mu Viscosity of water injected ! 46. Sigmamin Initial minimum horizontal stress ! 47. Ck_dipping Flag/Check for if the layer is dipping ! 48. Cgr Compressibility of mineral grains ! 49. ctot Total Compressibility ! 50. lfold Fracture length in the previous time step ! Global variables updated: ! 1. lf Length of fracture in the current time step ! 2. maj_axis_w Major axis of the waterflood front ! 3. min_axis_w Minor axis of the waterflood front ! 4. maj_axis_t Major axis of the thermal front ! 5. min_axis_t Minor axis of the thermal front ! 6. dst Thermal stress because of cooling ! 7. dsp Pore pressure stress because of increase in reservoir pressure ! 8. Sminh Minimum horizontal stress ! 9. Ptip Pressure at the fracture tip ! 10. Pfrac Pressure required to induce fracture ! 11. Piwf Pressure in the wellbore ! 12. delp1 Pressure diff bet re and waterflood front ! 13. delp2 Pressure diff bet waterflood front and the injection front ! 14. delp3 Pressure diff bet cool front and the injection front ! 14. delp4 Pressure diff bet fracture and the cool front ! 15. delpint Pressure diff across internal filter cake ! 16. delpcc Pressure diff across external filter cake ! 17. delpud Pressure diff across undamaged zone ! 18. delps_ini Pressure diff across skin (other than internal and external filter cake) ! 19. delpf Pressure diff between av. pressure in the fracture and the perf tip ! 20 wf Maximum width of the fracture ! 21. delpp Pressure drop in the perfs ! 22. Res1 Resistivity for delp1 zone ! 23. Res2 Resistivity for delp2 ! 24. Res3 Resistivity for delp3 ! 24. Res4 Resistivity for delp4 ! 25. Rint Resistivity of internal filter cake ! 26. Rcc Resistivity of external filter cake ! 27. Rud Resistivity of undamaged zone ! 28. Rskin Resistivity of skin ! 29. Resf Resistivity for delpf ! 30. Resp Resistivity for delpp ! 31. tt Transition time (time at which external filter cake starts to form) ! 32. hc External filter cake thickness ! 33. k Permeability of the internal damage zone ! 34. delptrans Transient Pressure diff bet well and boundary !--------------------------------------------------------------------------------------------------------- Subroutine PGFellipse2(wt,realct,perf,skin_initial,np,kp,npt,kpt,be,lw,ecc,layer,ltnum,dip,frac_grad,stress_change_pore_pressure,Wi,Cum_parr,Cum_oill,& Cum_parr_lambda,Cum_oill_lambda,Ns,dx,lambda0,lambda0_oil,lambdahist,lambda_oilhist,pm,pcr,ql,qlhist,dt,counter,trans,c0,c0hist,c0_oil,c0_oilhist,coal_fr,coal_frhist,dg,dp,doil,& kmh,df,t,pc,kc,U,n,Y,Tw,Tr,Swi,Sor,rhol,rhoo,rhog,Chw,Cho,Chg,B,ds,rp,re,rw,tst,pres_ini,pres,kro,krw,& mor,mwi,mu,sigmamin,ck_dipping,cgr,ctot,lfrw,avgwfp,fp_por,lfold,lfhist,fracture_closure,& ! Up to here all are input parameters lf,cum_parr_lf,cum_oill_lf,& ! From here all are output parameters including lf maj_axis_w,min_axis_w,maj_axis_p,min_axis_p,maj_axis_t,min_axis_t,maj_axis_D,min_axis_D,dst,dsp,Sminh,Ptip,Pfrac,& Piwf,delp1,delp2,delp3,delp4,delptrans,delpint,delpcc,& delpud,delps_ini,delpf,wf,delpp,res1,res2,res3,res4,rint,rcc,rud,rskin,resf,resp,tt,hc,k) !These are calculated in sub fast !use widcalc Implicit none External find_cumulative ! calculates the cumulative solids and oil in an assumed frac length at time t real(8), External :: fast !=(ptip-pfrac)/(ptip+pfrac) Integer, Intent(in) :: wt,realct,perf,layer,ltnum,Ns,counter,fracture_closure !added layer on April 2012 Integer, Intent(inout) :: trans real(8), Intent(in) :: skin_initial,np,kp,npt,kpt,be,lw,ecc,dip,frac_grad,stress_change_pore_pressure,Wi,Cum_parr,Cum_oill,Cum_parr_lambda,Cum_oill_lambda,dx,pm,pcr,ql,dt,c0,c0_oil,& coal_fr,dg,dp,doil,kmh,df,t,pc,kc,U,n,Y,Tw,Tr,Swi,Sor,rhol,rhoo,rhog,Chw,Cho,Chg,B,ds,rp,re,& kro,krw,mor,mwi,mu,tst,rw,pres_ini,pres,sigmamin,ck_dipping,cgr,ctot,lfrw,avgwfp,fp_por,lfold real(8), Dimension(counter), Intent(in) :: lambdahist,lambda_oilhist,qlhist,lfhist,c0hist,c0_oilhist,coal_frhist real(8), Dimension(Ns), Intent(in) :: lambda0,lambda0_oil real(8), Intent(out) :: lf,cum_parr_lf,cum_oill_lf,maj_axis_w,min_axis_w,maj_axis_p,min_axis_p,maj_axis_t,min_axis_t,maj_axis_D,min_axis_D,& dst,dsp,Sminh,Ptip,Pfrac,Piwf,delp1,delp2,delp3,delp4,delptrans,& delpint,delpcc,delpud,delps_ini,delpf,wf,delpp,res1,res2,res3,res4,rint,rcc,rud,rskin,resf,resp,tt,hc,k !Local variables real(8) :: lf1,lf2,lf3,fn1,fn2,fn3 !real(8), dimension(:) allocatable :: lf1,lf2,lf3,fn1,fn2,fn3 !real, dimension(:,:), allocatable :: fn1(*) Integer :: i real(8) :: Tol,frac_convergence_err real(8) :: cum_parr_lambda_lf,cum_oill_lambda_lf !Most likely the new fracture length is between lfold and re and therefore secant iteration is used to find new Lf !between lfold and re first. Tol=1E-5 Lf1 = lfold cum_parr_lf=cum_parr !Transfered here on June 27 2012 cum_oill_lf=cum_oill !Transfered here on June 27 2012 cum_parr_lambda_lf=cum_parr_lambda !May 2013 cum_oill_lambda_lf=cum_oill_lambda !May 2013 if (Lf1 .LT. maxval(lfhist,Dim=1)) then !Fracture Closure Code if (fracture_closure == 1) then !Find the cumulative solids filtering in through Lf10) then !if ptip at the old frac length > pfrac if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Lf2 = re elseif (wt==1) then ! Horizontal well with longitudinal fracture Lf2 = tst/2 end if ! find the ptip with lf=lf2 fn2 = fast(wt,realct,perf,skin_initial,np,kp,npt,kpt,be,lw,ecc,layer,ltnum,dip,frac_grad,stress_change_pore_pressure,Wi,Cum_parr,Cum_oill,Cum_parr_lambda,Cum_oill_lambda,Ns,dx,lambda0,lambda0_oil,& pm,pcr,ql,dt,counter,trans,qlhist,c0,dg,dp,doil,kmh,df,t,pc,kc,U,n,Y,Tw,Tr,Swi,Sor,rhol,rhoo,rhog,Chw,Cho,Chg,B,ds,rp,re,rw,lfrw,avgwfp,fp_por,tst,pres_ini,pres,& kro,krw,mor,mwi,mu,sigmamin,ck_dipping,cgr,ctot,maxval(lfhist,Dim=1),Lf2,& ! Up to here all are input parameters maj_axis_w,min_axis_w,maj_axis_p,min_axis_p,maj_axis_t,min_axis_t,maj_axis_D,min_axis_D,dst,dsp,Sminh,Ptip,& Pfrac,Piwf,delp1,delp2,delp3,delp4,delptrans,delpint,& delpcc,delpud,delps_ini,delpf,wf,delpp,res1,res2,res3,res4,rint,rcc,rud,rskin,resf,resp,tt,hc,k) if (fn2>=0) then !if Ptip >= Pfrac !Write(99,*) 'Time =', t/86400 !Write(99,*) 'The lf in layer',layer,'has reached the boundary' Lf = Lf2 !lf is equal to the boundary Return !exit the sub else !if ptip at the boundary < pfrac and from before ptip > pfrac at lfold go to 43 !find the frac length between lf1(old frac length) and lf2(boundary) endif elseif (fn1<=0) then !frac length should be less than lfold. !Write(99,*) 'Time =', t/86400 !Write(99,*) 'The lf in layer',layer,'needs to be < current lf as Ptip has become0) then !Frac len should be > Lf3 as at Lf3 the tip pressure > frac prop pressure Lf1 = Lf3 else If (fn3<0) then !Frac len < Lf3 as tip pressure < fracturing pressure Lf2 = Lf3 End If frac_convergence_err = (ptip - pfrac)/6895 End Do if (abs(Lf3-lfrw)<0.001) then !The fracture is almost closed as Ptip 730) .AND. (t/86400 <= 781) ) then !500 ppm polymer solution ! np_frac=1.0 - 0.1224 ! kp_frac=8.3568e-3/2.0 !divided by 2 for 500 ppm since the experiment was done only at 1000 ppm ! elseif (t/86400 > 781) then !1000 ppm polymer solution ! np_frac=1.0 - 0.1224 ! kp_frac=8.3568e-3 ! end if !Code added on Feb 23 2013 for OMV Polymer flow in fracture (the polymer np and kp values for fracture are different from matrix np and kp values) !Area if (ck_dipping==1) then If ((Lf-2*rw)ltnum/2) then !cum_wtr=Wi(layer)+Wi(layer-ltnum/2) !Else !cum_wtr=Wi(layer)+Wi(layer+ltnum/2) !Endif !Endif VDarcy = cum_wtr if (Swi+Sor<1) then Vcw = cum_wtr/pm/(1-Sor-Swi) Vinj = cum_wtr/pm/(1-Sor) if (dtemp ==0) then !Vcool=Vcw Vcool=Vinj else Vcool = (rhol*Chw*cum_wtr)/(rhog*Chg*(1-pm)+rhol*Chw*pm*(1-Sor)+rhoo*Cho*pm*Sor) !vol of cooled zone endif else Vcw=cum_wtr/pm Vinj = cum_wtr/pm if (dtemp ==0) then !Vcool=Vcw Vcool=Vinj else Vcool = (rhol*Chw*cum_wtr)/(rhog*Chg*(1-pm)+rhol*Chw*pm) endif end if rc = sqrt(Vcool/(pi*tst)) ! radius of a cylindrically growing cooled zone rz = sqrt(Vcw/(pi*tst)) ! radius of a cylindrically growing water flooded zone !Thermal zone ellipse calculations if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture F1 = (2*Vcool)/(pi*Lf*Lf*tst) + 0.5* sqrt((4*Vcool/(pi*Lf*Lf*tst))**2+4) !F1 in eqn B-2 P&G1985 elseif (wt == 1) then F1 = (2*Vcool)/(pi*Lf*Lf*lw) + 0.5* sqrt((4*Vcool/(pi*Lf*Lf*lw))**2+4) !F1 in eqn B-2 P&G1985 endif maj_axis_t = Lf*(sqrt(F1)+1/sqrt(F1))/2 !major axis of thermal ellipse min_axis_t = Lf*(sqrt(F1)-1/sqrt(F1))/2 !minor axis of thermal ellipse !Waterflood zone ellipse geometrical calculations, it is the displaced connate water front if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture F2 = (2*Vcw)/(pi*Lf*Lf*tst) + 0.5* sqrt((4*Vcw/(pi*Lf*Lf*tst))**2+4) !F2 in eqn B-6 P&G1985 elseif (wt == 1) then F2 = (2*Vcw)/(pi*Lf*Lf*lw) + 0.5* sqrt((4*Vcw/(pi*Lf*Lf*lw))**2+4) !F2 in eqn B-6 P&G1985 endif maj_axis_w = Lf*(sqrt(F2)+1/sqrt(F2))/2 !major axis of waterflood ellipse min_axis_w = Lf*(sqrt(F2)-1/sqrt(F2))/2 !minor axis of waterflood ellipse !Polymerflood zone ellipse geometrical calculations, it could be just the injected water if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture F3 = (2*Vinj)/(pi*Lf*Lf*tst) + 0.5* sqrt((4*Vinj/(pi*Lf*Lf*tst))**2+4) !F3 equivalent to eqn B-6 P&G1985 elseif (wt == 1) then F3 = (2*Vinj)/(pi*Lf*Lf*lw) + 0.5* sqrt((4*Vinj/(pi*Lf*Lf*lw))**2+4) !F3 equivalent to eqn B-6 P&G1985 endif maj_axis_p = Lf*(sqrt(F3)+1/sqrt(F3))/2 !major axis of polymer ellipse min_axis_p = Lf*(sqrt(F3)-1/sqrt(F3))/2 !minor axis of polymer ellipse !Darcyflood zone ellipse geometrical calculations if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture F4 = (2*VDarcy)/(pi*Lf*Lf*tst) + 0.5* sqrt((4*VDarcy/(pi*Lf*Lf*tst))**2+4) !F4 equivalent to eqn B-6 P&G1985 elseif (wt == 1) then F4 = (2*VDarcy)/(pi*Lf*Lf*lw) + 0.5* sqrt((4*VDarcy/(pi*Lf*Lf*lw))**2+4) !F4 equivalent to eqn B-6 P&G1985 endif maj_axis_D = Lf*(sqrt(F4)+1/sqrt(F4))/2 !major axis of Darcy ellipse min_axis_D = Lf*(sqrt(F4)-1/sqrt(F4))/2 !minor axis of Darcy ellipse !Velocity thru perforations vp is relevant ony for the perforated well If ( (realct==1) .OR. (realct==3) ) Then ! Perforated completion if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture vp = ql/(pi*rp*rp*tst*ds) !velocity through perforations elseif (wt == 1) then vp = ql/(pi*rp*rp*lw*ds) !velocity through perforations endif Else vp = 0 End If !Thermal and Pore pressure stress equation term calculations !calculation of TERM2 in eqn. (3) P&G 1985 TERM2A = (min_axis_t/maj_axis_t)/(1+(min_axis_t/maj_axis_t)) TERM2B = 1/(1+(min_axis_t/maj_axis_t)) TERM2C = 1+0.5*(1.45*(tst/(2*min_axis_t))**0.9 + 0.35*(tst/(2*min_axis_t))**2)*(1+(min_axis_t/maj_axis_t)**0.774) TERM2 = (1/(1-n))*(TERM2A + TERM2B/TERM2C) !For debugging and breaking the code at a particular time where it seems unreasonable !if ((t/86400) > 1143) then ! Write(*,*) 'The time is',t/86400,'days' !endif if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then ! Serial Incremental pressure changes around wellbore: LHS term Calculations if ((maj_axis_w+min_axis_w)<2*re) then delp1 = (ql*mor)*log((2*re)/(maj_axis_w+min_axis_w))/(2*pi*kmh*kro*tst) ! pressure drop bet re and the elliptical boundary of waterflood res1 = mor*log((2*re)/(maj_axis_w+min_axis_w))/(2*pi*kmh*kro*tst) ! pressure drop bet re and the elliptical boundary of waterflood delp2=(ql*mwi)*log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p))/(2*pi*kmh*Krw*tst) res2=mwi*log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p))/(2*pi*kmh*Krw*tst) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-npt)/2.0) !added in June 2012 delp3 = abs(ql)**npt*Hp/(2*pi*tst)**npt/(kmh*krw)*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) if (ql<0) then delp3=-delp3 endif if (ql==0) then res3 = kpt*log((maj_axis_p+min_axis_p)/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res3 = delp3/ql res3 = kpt*log((maj_axis_p+min_axis_p)/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow but added on July 13 2012 for debugging end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) !added in June 2012: the absolute part and the -delp part delp4 = abs(ql)**np*Hp/(2*pi*tst)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) if (ql<0) then delp4=-delp4 endif if (ql==0) then res4 = kp*log((maj_axis_t+min_axis_t)/(Lf))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res4 = delp4/ql res4 = kp*log((maj_axis_t+min_axis_t)/(Lf))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow added on July 13 2012 for debugging end if else if ( ((maj_axis_w+min_axis_w)>=2*re) .AND. ((maj_axis_p+min_axis_p)<2*re) ) then delp1 = 0 res1 = 0 delp2=(ql*mwi)*log(2*re/(maj_axis_p+min_axis_p))/(2*pi*kmh*Krw*tst) res2=mwi*log(2*re/(maj_axis_p+min_axis_p))/(2*pi*kmh*Krw*tst) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-npt)/2.0) delp3 = abs(ql)**npt*Hp/(2*pi*tst)**npt/(kmh*krw)*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) if (ql<0) then delp3=-delp3 endif if (ql==0) then res3 = kpt*log((maj_axis_p+min_axis_p)/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res3 = delp3/ql res3 = kpt*log((maj_axis_p+min_axis_p)/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow, added on July 13 2012 for debugging end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) !added in June 2012: the absolute part and the -delp part delp4 = abs(ql)**np*Hp/(2*pi*tst)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) if (ql<0) then delp4=-delp4 endif if (ql==0) then res4 = kp*log((maj_axis_t+min_axis_t)/(Lf))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res4 = delp4/ql res4 = kp*log((maj_axis_t+min_axis_t)/(Lf))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow, added on July 13 2012 for debugging end if !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The equivalent waterflood front radius has become more than re, therefore delp1 is zero' !Stop else if ( ((maj_axis_p+min_axis_p)>=2*re).AND. ((maj_axis_t+min_axis_t)<2*re) ) then delp1 = 0 res1=0 delp2 = 0 res2=0 Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-npt)/2.0) !added in June 2012: the absolute part and the -delp part delp3 = abs(ql)**npt*Hp/(2*pi*tst)**npt/(kmh*krw)*(re**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) if (ql<0) then delp3=-delp3 endif if (ql==0) then res3 = kpt*log(2*re/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res3 = delp3/ql res3 = kpt*log(2*re/(maj_axis_t+min_axis_t))/(2*pi*kmh*krw*tst) !is an approximate for polymer flow, added on July 13 2012 for debugging end if Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) !added in June 2012: the absolute part and the -delp part delp4 = abs(ql)**np*Hp/(2*pi*tst)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) if (ql<0) then delp4=-delp4 endif if (ql==0) then res4 = kp*log((maj_axis_t+min_axis_t)/Lf)/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res4 = delp4/ql res4 = kp*log((maj_axis_t+min_axis_t)/Lf)/(2*pi*kmh*krw*tst) !is an approximate for polymer flow, added on July 13 2012 for debugging end if !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The equivalent polymerfront radius has become more than re, therefore part of delp2 is zero' !Stop else if ((maj_axis_t+min_axis_t) > 2*re) then delp1 = 0 res1=0 delp2 = 0 res2=0 delp3 = 0 res3=0 ! pressure drop is zero since the thermal front has crossed re Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) !added in June 2012: the absolute part and the -delp part delp4 = abs(ql)**np*Hp/(2*pi*tst)**np/(kmh*krw)*(re**(1-np)-(Lf/2)**(1-np))/(1-np) if (ql<0) then delp4=-delp4 endif if (ql==0) then res4 = kp*log(2*re/Lf)/(2*pi*kmh*krw*tst) !is an approximate for polymer flow else res4 = delp4/ql res4 = kp*log(2*re/Lf)/(2*pi*kmh*krw*tst) !is an approximate for polymer flow, added on July 13 2012 for debugging end if !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The equivalent water-flood and thermal fronts have reached re: delp1 & delp2 are zero' end if elseif (wt == 1) then ! horizontal well with a longitudinal fracture delta=tst/2*ecc aj = (lw/2)* (0.5+Sqrt(0.25+1/(0.5*lw/re)**4))**0.5 ! Joshi (8) if ((maj_axis_w+min_axis_w)<2*tst/2) then Rv1 = mor/(2*pi*kmh*kro*lw)*be*Log(((be*tst/(be+1))**2+be**2*delta**2)/(be*tst*(maj_axis_w+min_axis_w)/2/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Rv2 = mwi/(2*pi*kmh*krw*lw)*be*Log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p)) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-npt)/2.0) Rv3 = abs(ql)**(npt-1)*Hp*be/(2*pi*lw)**npt/(kmh*krw)*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-np)/2.0) Rv4 = abs(ql)**(np-1)*Hp*be/(2*pi*lw)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/(lw/2)) ! Joshi (1,2) Rh2=0 Rh3=0 Rh4=0 else if ( ((maj_axis_w+min_axis_w)>=2*tst/2) .AND. ((maj_axis_p+min_axis_p)<2*tst/2) ) then Rv1=0 !Rv2 = mwi/(2*pi*kmh*krw*lw)*be*Log(((be*tst/(be+1))**2+be**2*delta**2)/(be*tst*(maj_axis_p+min_axis_p)/2/(be+1))) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Rv2 = mwi/(2*pi*kmh*krw*lw)*be*Log(tst/(maj_axis_p+min_axis_p)) ! Joshi (4,5, 10a) 'Modified 2->(be+1) by Economides and Mukherjee's eq. Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-npt)/2.0) Rv3 = abs(ql)**(npt-1)*Hp*be/(2*pi*lw)**npt/(kmh*krw)*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-np)/2.0) Rv4 = abs(ql)**(np-1)*Hp*be/(2*pi*lw)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) maj_axis_w=min(max(lw/2,0.5/tst*sqrt(lw*Vcw)),aj-0.0001) min_axis_w=min(0.5*sqrt(Vcw/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !min_axis_w=min(max(tst/2,0.5*sqrt(Vcw/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_w <= tst/2) then ! min_axis_w = 0 !endif !Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/(maj_axis_w+min_axis_w)) ! Modified Joshi Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/maj_axis_w) ! Modified Joshi Rh2 = mwi/(2*pi*kmh*krw*tst)*Log((maj_axis_w+min_axis_w)/(lw/2)) Rh3 = 0 Rh4 = 0 !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The water-flood front has reached the layer boundary (tst/2)' else if ( ((maj_axis_p+min_axis_p)>=2*tst/2).AND. ((maj_axis_t+min_axis_t)<2*tst/2) ) then Rv1=0 Rv2=0 Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-npt)/2.0) Rv3 = abs(ql)**(npt-1)*Hp*be/(2*pi*lw)**npt/(kmh*krw)*((tst/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-np)/2.0) Rv4 = abs(ql)**(np-1)*Hp*be/(2*pi*lw)**np/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(Lf/2)**(1-np))/(1-np) maj_axis_w=min(max(lw/2,0.5/tst*sqrt(lw*Vcw)),aj-0.0001) !min_axis_w=min(max(tst/2,0.5*sqrt(Vcw/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) min_axis_w=min(0.5*sqrt(Vcw/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_w <= tst/2) then ! min_axis_w = 0 !endif maj_axis_p=min(max(lw/2,0.5/tst*sqrt(lw*Vinj)),aj-0.0001) !min_axis_p=min(max(tst/2,0.5*sqrt(Vinj/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) min_axis_p=min(0.5*sqrt(Vinj/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_p <= tst/2) then ! min_axis_p = 0 !endif !Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/(maj_axis_w+min_axis_w)) ! Modified Joshi Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/maj_axis_w) ! Modified Joshi Rh2 = mwi/(2*pi*kmh*krw*tst)*Log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p)) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-npt)/2.0) Rh3 = abs(ql)**(npt-1)*Hp/(2*pi*tst)**npt/kmh/krw*(((maj_axis_p+min_axis_p)/2)**(1-npt)-(lw/4)**(1-npt))/(1-npt) Rh4 = 0 !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The cw & inj fronts has reached the boundary (tst/2)' else if ((maj_axis_t+min_axis_t) >= 2*tst/2) then Rv1=0 Rv2=0 Rv3=0 Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-np)/2.0) Rv4 = abs(ql)**(np-1)*Hp*be/(2*pi*lw)**np/(kmh*krw)*((tst/2)**(1-np)-(Lf/2)**(1-np))/(1-np) maj_axis_w=min(max(lw/2.0,0.5/tst*sqrt(lw*Vcw)),aj-0.0001) !min_axis_w=min(max(tst/2,0.5*sqrt(Vcw/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) min_axis_w=min(0.5*sqrt(Vcw/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_w == tst/2) then ! min_axis_w = 0 !endif maj_axis_p=min(max(lw/2,0.5/tst*sqrt(lw*Vinj)),aj-0.0001) !min_axis_p=min(max(tst/2,0.5*sqrt(Vinj/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) min_axis_p=min(0.5*sqrt(Vinj/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_p == tst/2) then ! min_axis_p = 0 !endif maj_axis_t=min(max(lw/2,0.5/tst*sqrt(lw*Vcool)),aj-0.0001) !min_axis_t=min(max(tst/2,0.5*sqrt(Vcool/lw)),Sqrt(aj**2-(lw/2)**2)-0.0001) min_axis_t=min(0.5*sqrt(Vcool/lw),Sqrt(aj**2-(lw/2)**2)-0.0001) !if (min_axis_t == tst/2) then ! min_axis_t = 0 !endif !Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/(maj_axis_w+min_axis_w)) ! Modified Joshi Rh1 = mor/(2*pi*kmh*kro*tst)*Log((aj+Sqrt(aj**2-(lw/2)**2))/maj_axis_w) ! Modified Joshi Rh2 = mwi/(2*pi*kmh*krw*tst)*Log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p)) Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-npt)/2.0) Rh3 = abs(ql)**(npt-1)*Hp/(2*pi*tst)**npt/kmh/krw*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw/be*pm*(1-sor))**((1.0-np)/2.0) Rh4 = abs(ql)**(np-1)*Hp/(2*pi*tst)**np/kmh/krw*(((maj_axis_t+min_axis_t)/2)**(1-np)-(lw/4)**(1-np))/(1-np) !Write(99,*) 'Time =',t/86400,'days' !Write(99,*) 'Subroutine fast: The cw,inj,& cool fronts all has reached the boundary (tst/2)' endif delp1=ql*(Rh1+Rv1) delp2=ql*(Rh2+Rv2) delp3=ql*(Rh3+Rv3) delp4=ql*(Rh4+Rv4) endif if ((perf==1) .OR. (wt==1)) then Call calc_RintandRcc(wt,realct,np,kp,be,lw,Cum_parr,Cum_oill,Cum_parr_lambda,Cum_oill_lambda,lfrw,fp_por,lfmax,lf,Aface,Ns,dx,pm,pcr,ql,c0,dg,dp,kmh,df,t,pc,kc,lambda0,& lambda0_oil,krw,mu,sor, & ! Up to this all are input parameters Rint,Rcc,tt,hc,k) ! These are output parameters if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Rud = mu*dx*Ns/kmh/Aface Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) Rud= abs(ql)**(np-1)*Hp*dx*Ns/Aface**np/(kmh*krw) elseif (wt==1) then !horizontal well with a longitudinal fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh/be*pm*(1-sor))**((1.0-np)/2.0) Rud= abs(ql)**(np-1)*Hp*be*dx*Ns/Aface**np/kmh endif if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture !delpf = 0.42045*(ql*mu*Lf*Y**3/(1-n**2)**3/tst**4)**0.25 ! pressure drop in the fracture where q is the total flow entering the two fracture wings Hp = kp*((1+3*np)/np)**(np-1)*(8.0*500000E-12)**((1.0-np)/2.0) !fracture perm is 500 Darcy and porosity = 1) !no leak off !delpf=(16/3/pi*(2*np+1)**np*(np+1)*abs(ql)**np*kp*lf*Y**(2*np+1)/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/tst**(3*np+1))**(1/(2*np+2)) !uniform leak-of, only a factor of (np+1) is excluded from the inner bracket !delpf_dummy=abs(ql)**np*kp*lf*Y**(2*np+1) !delpf_dummy=(16/3/pi*(2*np+1)**np*delpf_dummy/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/tst**(3*np+1))**(1/(2*np+2)) delpf_dummy=abs(ql)**np_frac*kp_frac*lf*Y**(2*np_frac+1) delpf_dummy=(16/3/pi*(2*np_frac+1)**np_frac*delpf_dummy/np_frac**np_frac/2**(2*np_frac-1)/(1-n**2)**(2*np_frac+1)/tst**(3*np_frac+1))**(1/(2*np_frac+2)) delpf=delpf_dummy !delpf=(16/3/pi*(2*np+1)**np*abs(ql)**np*kp*lf*Y**(2*np+1)/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/tst**(3*np+1))**(1/(2*np+2)) !Code added on May 2013 wf_flow=2*(1-n**2)*delpf*tst/Y wf=wf_flow+2*hc !delpf = wf*Y/2/(1-n**2)/tst if (wf*lf>avgwfp*Lfrw) then ! Fracture volume has increased from the initial frac pack volume 2013 !delpf = wf*Y/2/(1-n**2)/tst ! Pressure drop due to total width of the frac pack / fracture wf_extra = (wf*lf-avgwfp*lfrw)/lf delpf = wf_extra*Y/2/(1-n**2)/tst ! Pressure drop due to extra width of the frac pack / fracture else wf_extra = 0 end if elseif (wt == 1) then !horizontal well with a longitudinal fracture ! Shear rate parameters in the fracture, np, kp is used to calculate Hp Hp = kp*((1+3*np)/np)**(np-1)*(8.0*500E-12)**((1.0-np)/2.0) !fracture perm is 500 Darcy and porosity = 1) !no leak-off delpf=(16/3/pi*(2*np+1)**np*(np+1)*abs(ql)**np*kp*lf*Y**(2*np+1)/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/lw**(3*np+1))**(1/(2*np+2)) !uniform leak-off delpf=(16/3/pi*(2*np+1)**np*abs(ql)**np*kp*lf*Y**(2*np+1)/np**np/2**(2*np-1)/(1-n**2)**(2*np+1)/lw**(3*np+1))**(1/(2*np+2)) !Code changed and added on May 2013 wf_flow=2*(1-n**2)*delpf*lw/Y wf=wf_flow+2*hc !delpf = wf*Y/2/(1-n**2)/tst if (wf*lf>avgwfp*Lfrw) then ! Fracture volume has increased from the initial frac pack volume 2013 !delpf = wf*Y/2/(1-n**2)/tst ! Pressure drop due to total width of the frac pack / fracture wf_extra = (wf*lf-avgwfp*lfrw)/lf delpf = wf_extra*Y/2/(1-n**2)/tst ! Pressure drop due to extra width of the frac pack / fracture else wf_extra = 0 end if !if (ql < 1.0/543439.6331) then ! delpf=0 ! corrected pressure drop in the fracture !end if ! Need to include filter cake in calculating delpf to correct. endif delpp = 0.8338*(rhol*vp*vp) ! pressure drop in the perforations if (layer ==1) then !if (layer ==1 .OR. layer==8) then !Case 2 for BHP Moondyne Horizontal Injector !delpp = delpp + 0.0003*1e5*(ql*86400)**1.9995 !added on June 11 2012 for Moondyne ICD's else !delpp = delpp + 0.00007*1e5*(ql*86400)**1.995 !added on June 11 2012 for Moondyne ICD's end if if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture !delps_ini = ql*mor/(2*pi*kmh*kro*tst)*skin_initial delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf) !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.3 !April 05 2009 multiplied delps_ini by 2*rw/Lf used for Nexen C1 match !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.3 !Initial Simulations used for IS001 IS002 A10/A20, B40 on Jan 10 2012 !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.25 !used for IS001 A10/A20 on April 2012 for history matching !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.15 !used for IS001 B40 on April 2012 for history matching !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.5 !used for IS002 A10/A20 on April 2012 for history matching !delps_ini = ql*kp/(2*pi*kmh*krw*tst)*skin_initial*(2*lfrw/Lf)**0.8 !used for IS002 B40 on April 2012 for history matching elseif (wt==1) then !delps_ini = ql*mor/(2*pi*kmh*kro*lw)*be*skin_initial delps_ini = ql*kp/(2*pi*kmh*krw*lw)*be*skin_initial endif else ! non perforated layers for vertical well; wt == 0 Rint=0 Rcc=0 tt=0 hc=0 rud=0 delpud=0 wf=0 delpf=0 delpp=0 delps_ini=0 endif !if (ql>=0) then !commented out on Oct 2012 delpint = ql*Rint delpud = ql*Rud delpcc = ql*Rcc !else ! q < 0, flow from reservoir into the wellbore ! delpint=0 ! delpcc=0 ! delpud=0 ! rint=0 ! rud=0 ! rcc=0 !endif if (wt == 0) then !vertical well ! Implementing Early Pressure Transient model ! Based on single phase flow diffusivity equation for vertical well with infinitely conductive fracture (also works for radial flow). ! For two phase flow an equivalent mobility is calculated to be used in the pressure transient equation. ! For low injected mobility ratios, the model gives lower pressures than actual when compared with CMG-GEM results ! For high injected mobility ratio, it gives higher pressure than actual when compared with CMG-GEM results. ! delp1+delp2+delp3+delp4 will be used when the sum is < transient delp as the delp will be close to steady then. dp_fronts=delp1+delp2+delp3+delp4 delptrans=0 !code added on Jan 02 2013 since delptrans was not initiated to zero if (ql/=0) then !code added on June 29 2012 !commented out this check: now each time transient code is run !if (trans==1) then ! go to 1000 !------------------------------------------------------------------------------------------------------------- !Calculating the transient well pressure assuming multiple rate solution for infinitely conductivity fracture. !------------------------------------------------------------------------------------------------------------- Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-np)/2.0) if (np /= 1.0) then Eff_M_dummy1 = (abs(ql)/(2*pi*tst))**(np-1)*Hp Eff_M_dummy1 = Eff_M_dummy1/(kmh*krw)*(((maj_axis_t+min_axis_t)/2)**(1-np)-(lf/2)**(1-np))/(1-np) else Eff_M_dummy1=0 end if if (npt /= 1.0) then Hp = kpt*((1+3*npt)/npt)**(npt-1)*(8.0*kmh*krw*pm*(1-sor))**((1.0-npt)/2.0) Eff_M_dummy2 = (abs(ql)/(2*pi*tst))**(npt-1)*Hp Eff_M_dummy2 = Eff_M_dummy2 /(kmh*krw)*(((maj_axis_p+min_axis_p)/2)**(1-npt)-((maj_axis_t+min_axis_t)/2)**(1-npt))/(1-npt) else Eff_M_dummy2 = 0 end if Eff_M = Eff_M_dummy1 + Eff_M_dummy2 Eff_M = Eff_M + mwi/kmh/krw*log((maj_axis_w+min_axis_w)/(maj_axis_p+min_axis_p)) if (2*re > (maj_axis_w+min_axis_w)) then Eff_M = Eff_M + mor/kmh/kro*log(2*re/(maj_axis_w+min_axis_w)) Eff_M = Eff_M/log(2*re/lf) else Eff_M = Eff_M/log((maj_axis_w+min_axis_w)/lf) endif Eff_M = 1/Eff_M if (ql==0) then pdss=0 else pdss=1/141.2*dp_fronts/6894.76*(tst*3.2808)*(Eff_M*(1e+15/1000))/(ql*543439.6331) end if sum=0 Do i=1,counter !Multi injection rates td=0.0002637*Eff_M*(1e+15/1000)*((t-(i-1)*dt)/3600)/pm/(ctot*6894.76)/(Lf*3.2808)**2 ! ----- Jongsoo 201309: Start ----- !pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))-0.067*Ei(-0.018/td)-0.433*Ei(-0.75/td) if (.018/td < 60 .AND. 0.75/td < 60) then pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))+0.067*E1(0.018/td)+0.433*E1(0.75/td) else if (.018/td < 60) then pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td)))+0.067*E1(0.018/td) else pd=0.5*sqrt(pi*td)*(erf(0.134/sqrt(td))+erf(0.866/sqrt(td))) ! For .018/td > 60, E1(.018/td) ~ 0 end if ! ----- Jongsoo 201309: End ----- if (i==1) then if (abs(pd) > abs(pdss)) then !trans=0 !transient is over !Write(99,*) 'At t = ',t/86400,'layer=',layer,'transient is over' delptrans=dp_fronts !transferred here on June 27 2012 since transient depends on fracture length go to 1000 ! end of transient if then else else !trans=1 end if !added abs in June 2012 sum = sum+qlhist(i)*543439.6331*min(abs(pd),abs(pdss)) else !added abs in June 2012 sum = sum+(qlhist(i)-qlhist(i-1))*543439.6331*min(abs(pd),abs(pdss)) endif end do !delptrans=dp_fronts delptrans=sum*141.2/(Eff_M*(1e+15/1000))/(tst*3.2808)*6894.76 !from psi to pascals !added in June 2012 if (ql<0) then delptrans=-delptrans endif end if 1000 if ((ql/=0) .AND. (delptrans>dp_fronts)) then !this means flow rate /= 0 and steady state is reached delptrans = dp_fronts Res1 = delp1/ql Res2 = delp2/ql Res3 = delp3/ql Res4 = delp4/ql else if ((ql/=0) .AND. (delptrans=0) then Ptip = Piwf - delpp - delpf - delps_ini !Modified LHS of eqn.12 P&G1985 to include delps_ini Ptip = Piwf - delpp - delpf !LHS of eqn.12 P&G1985 'used for Nexen C1 match else Ptip = Piwf - delpp - delpf !LHS of eqn.12 P&G1985 'used for Nexen C1 match end if !-------------------------------------------- !added in June 2012 and changed the condition value on Sept 11 2012 since the resf with ql==0 condition (going to else) was getting infinity !if (ql == 0) then !use the old resistance values for the fracture and the perforations. if (abs(ql) < (1e-20/543439.6331)) then !using absolute ql value to determine resf, resp, and rskin sept 2012 resf = 1 resp = 1 Resf = delpf/(1e-20/543439.6331) !added on July 13 2012 Resp = delpp/(1e-20/543439.6331) !added on July 13 2012 rskin = kp*skin_initial/(2*pi*kmh*Krw*tst) else !added in June 2012 Resf = delpf/abs(ql) !Entire pressure drop in the fracture is added in calculating the fracture resistance Resp = delpp/ql Rskin = delps_ini/ql end if dst = Y*B*dTemp*TERM2 ! Min. horizontal stress change due to temperature change Ji = ((1-2*n)/Y)-Cgr/3 ! Linear coefficient of pore pressure expansion dsp = Y*Ji*TERM2*dppr + stress_change_pore_pressure*avg_res_pr_change ! August 2013 Min. horizontal stress change due to pore pressure change (assuming no change in porosity and k) !Making the stress change due to pore pressure change = 0.72 psi/psi ! used for Chevron Tahiti and Tombua Landana Projects Jan realdp !dsp = 0.72*dppr ! Chevron TL project, Chevron Tahiti Project 2010 and 2012, not for Chevron Rosebank Phase II project !dsp = 0.67*dppr ! Anadarko Heidelberg 2013 and K-2 Field Phase II March 2013 !dsp = stress_change_pore_pressure*(dppr+avg_res_pr_change) ! April 2013 commented out on July 26 2013 reused on August 10 for Heidelberg !commented out Ajay Oct 2013 !write(99,*) term2*(1-n), dsp/dppr if (ck_dipping==1) then if (layer>ltnum/2) then Sigmamin_dip=Sigmamin + Lf*sin(dip*pi/180)*(frac_grad-rhol*g) !downwards Else Sigmamin_dip=Sigmamin - Lf*sin(dip*pi/180)*(frac_grad-rhol*g) !upwards Endif Else Sigmamin_dip=Sigmamin Endif Sminh = Sigmamin_dip + dst + dsp ! Final min horizontal stress ! RHS term of Eqn 12 P&G 1985 ! IF ( (Lf-2*rw) < tst/2 ) THEN ! rff = Lff ! ELSE ! rff = tst/2 ! ENDIF if (wt==0) then Pfrac= Sminh + sqrt((pi*U*Y)/(2*(1-n*n)*tst/2)) elseif (wt==1) then Pfrac= Sminh + sqrt((pi*U*Y)/(2*(1-n*n)*lw/2)) endif fast = (ptip-pfrac)/(ptip+pfrac) !changed in 2012 since ptip > prac is easier to understand when this happens there is fracture growth End Function fast !------------------------------------------------------------------------------------------------------- ! Written by Ajay Suri ! Date: November 13 2006 ! Objective: Calculate the internal cake and external cake flow resistance perpendicular to the fracture ! Global variables used: ! 1. Cum_parr Volume of solid particles injected into the layer upto time t ! 2. Cum_oill Volume of oil particles injected into the layer upto time t ! 3. Aface Area of the fracture face perpendicular to flow ! 4. lfrw length of equivalent frac length for the well radius at initial time or the initial frac length ! 4. lfmax maximum length of fracture that it has been during the history of injection ! 4. lf length of fracture ! 5. Ns Number of segments of the internal damage zone ! 6. dx Segment length in the internal damage zone ! 7. lambda0(layer,:) filtration coefficient for solids in the damage zone ! 8. lambda0_oil(layer,:) filtration coefficient for oil particles in the damage zone ! 9. pm initial porosity of the damage zone ! 10. pcr critical porosity for the layer into consideration ! 11. ql flow rate into the layer ! 12. c0 volume concentration of the solids in the injected water ! 13. dg formation grain diameter for the layer into consideration ! 14. kmh horizontal permeability of the layer ! 15. df damage factor ! 16. t total injection time elapsed ! 17. pc external cake porosity ! 18. kc external cake permeability ! 19. krw Relative permeability to water ! 20. mu viscosity of injected water ! Global variables updated: ! 1. Rint(layer) Internal cake flow resistance ! 2. Rcc(layer) External cake flow resistance ! 3. tt(layer) transition time (time at which external filter cake starts to form) ! 4. hc(layer) external cake thickness ! 5. k(layer,:) Permeability of the internal damage zone !--------------------------------------------------------------------------------------------------------- SubRoutine calc_RintandRcc(wt,realct,np,kp,be,lw,Cum_parr,Cum_oill,Cum_parr_lambda,Cum_oill_lambda,lfrw,fp_por,lfmax,lf,Aface,Ns,dx,pm,pcr,ql,c0,dg,dp,kmh,df,t,pc,kc,lambda0,lambda0_oil,krw,mu,sor,Rint,Rcc,tt,hc,k) Implicit None real(8), External :: PermDecl Integer, Intent(In) :: wt,realct,Ns real(8), Intent(In) :: np,kp,be,lw,Cum_parr, Cum_oill, Cum_parr_lambda, Cum_oill_lambda, lfrw,fp_por, lfmax, lf, Aface, dx, pm, pcr, ql, c0, dg, dp, kmh, df, t, pc, kc, krw, mu, sor real(8), Dimension(Ns), Intent(In) :: lambda0, lambda0_oil real(8), Intent(out) :: Rint, Rcc, tt, hc real(8), Dimension(Ns), Intent(out) :: k !local variables Integer :: i, ii real(8) :: sigmastar, Hp,dummy real(8), Dimension(Ns) :: sigma, sigma_oil tt=-1 Rint = 0 hc=0 Rcc=0 !Note transition time changes with fracture length. !Example: tt = 10 days for no fracture; then there is a fracture growth and tt isn't reached becoz cumparticles aren't enough for the internal area. Do i=1,Ns !sigma(i)=lambda0(i)*cum_parr/Aface*exp(-lambda0(i)*(i-1)*dx) sigma(i)=cum_parr_lambda/Aface*exp(-lambda0(i)*(i-1)*dx) !sigma_oil(i)=lambda0_oil(i)*cum_oill/Aface*exp(-lambda0_oil(i)*(i-1)*dx) sigma_oil(i)=cum_oill_lambda/Aface*exp(-lambda0_oil(i)*(i-1)*dx) sigma(i)=sigma(i)+sigma_oil(i) sigmastar = pm-pcr if (sigma(1)>(sigmastar)) then sigma(1)=sigmastar !tt = sigmastar/(lambda0(1)*(cum_parr/Aface/t)+lambda0_oil(1)*(cum_oill/Aface/t)) !Updated by Ajay on Sept 29 2007 to consider both particles and oil tt = sigmastar/((cum_parr_lambda/Aface/t)+(cum_oill_lambda/Aface/t)) !Updated by Ajay on Sept 29 2007 to consider both particles and oil if (tt > t) then tt = t end if k(1) = kmh*PermDecl(sigma(1),pm,dg,dp,df) if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(1)*krw*(pm-sigma(1))*(1-Sor))**((1.0-np)/2.0) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(1)*krw*pm*(1-Sor))**((1.0-np)/2.0) !Updated on June 2012 !added in June 2012 Rint = Rint + (abs(ql))**(np-1)*Hp*dx/Aface**np/(k(1)*krw) elseif (wt == 1) then !horizontal well with a longitudinal fracture ! Shear rate parameters, np, kp is used to calculate Hp Hp = kp*((1+3*np)/np)**(np-1)*(8.0*(k(1)*krw)/be*pm)**((1.0-np)/2.0) Rint = Rint + (abs(ql))**(np-1)*Hp/(4*lf*lw)**np*dx*be/(k(1)*krw) endif do ii = 2,Ns !sigma(ii)=sigma(1)/(lambda0(1)*(cum_parr/Aface)+lambda0_oil(1)*(cum_oill/Aface))*(lambda0(1)*(cum_parr/Aface)*exp(-lambda0(ii)*(ii-1)*dx)+lambda0_oil(1)*(cum_oill/Aface)*exp(-lambda0_oil(ii)*(ii-1)*dx)) sigma(ii)=sigma(1)/((cum_parr_lambda/Aface)+(cum_oill_lambda/Aface))*((cum_parr_lambda/Aface)*exp(-lambda0(ii)*(ii-1)*dx)+(cum_oill_lambda/Aface)*exp(-lambda0_oil(ii)*(ii-1)*dx)) k(ii) = kmh*PermDecl(sigma(ii),pm,dg,dp,df) if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(ii)*krw*(pm-sigma(ii))*(1-Sor))**((1.0-np)/2.0) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(ii)*krw*pm*(1-Sor))**((1.0-np)/2.0) !updated on June 2012 Rint = Rint + (abs(ql))**(np-1)*Hp*dx/Aface**np/(k(ii)*krw) elseif (wt == 1) then Hp = kp*((1+3*np)/np)**(np-1)*(8.0*(k(ii)*krw)/be*pm)**((1.0-np)/2.0) Rint = Rint + (abs(ql))**(np-1)*Hp/(4*lf*lw)**np*dx*be/(k(ii)*krw) !June 2012 abs part endif end do hc = (cum_parr+cum_oill)*(t-tt)/t/(1-pc)/Aface !Correction made by Ajay in June 2008 dummy = 1 - lfrw/max(lfmax,lf)*(1-fp_por) hc = (cum_parr+cum_oill)*(t-tt)/t/(1-pc)/Aface/dummy !dummy is the updated gravel porosity in the frac-pack for Chevron Tahiti fracpack mimik goto 929 endif k(i) = kmh*PermDecl(sigma(i),pm,dg,dp,df) if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(i)*krw*(pm-sigma(i))*(1-Sor))**((1.0-np)/2.0) Hp = kp*((1+3*np)/np)**(np-1)*(8.0*k(i)*krw*pm*(1-Sor))**((1.0-np)/2.0) !Updated on June 2012 Rint = Rint + (abs(ql))**(np-1)*Hp*dx/Aface**np/(k(i)*krw) elseif (wt == 1) then !horizontal well with a longitudinal fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*(k(i)*krw)/be*pm)**((1.0-np)/2.0) Rint = Rint + (abs(ql))**(np-1)*Hp/(4*lf*lw)**np*dx*be/(k(i)*krw) endif end Do 929 if ( (wt == 0) .OR. ((wt == 1) .AND. ((realct == 4) .OR. (realct == 5))) ) then !vertical well or horizontal well with a transverse fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) Rcc = (abs(ql))**(np-1)*Hp*hc/Aface**np/kc elseif (wt == 1) then !horizontal well with a longitudinal fracture Hp = kp*((1+3*np)/np)**(np-1)*(8.0*kc*pc)**((1.0-np)/2.0) Rcc= (abs(ql))**(np-1)*Hp*hc/(4*lf*lw)**np/kc endif End Subroutine calc_RintandRcc !========================================================================================= ! Commentor: Ajay Suri ! Date: December 15 2008 ! Subroutine Find_Cumulative !========================================================================================= Subroutine Find_Cumulative(Lf,dt,counter,lfhist,qlhist,c0hist,c0_oilhist,coal_frhist,& ! input parameters cum_parr_lf,cum_oill_lf,cum_parr,cum_oill) ! output parameters Implicit none Integer, Intent(in) :: counter real(8), Intent(in) :: lf,dt,cum_parr,cum_oill real(8), Dimension(counter), Intent(in) :: lfhist,qlhist,c0hist,c0_oilhist,coal_frhist real(8), Intent(out) :: cum_parr_lf,cum_oill_lf !Local variables !real(8) :: min1,max1 Integer :: i,j,min1,max1 !Write(*,*) !Write(*,*) cum_parr_lf,cum_oill_lf !Write(99,*) !Write(99,*) cum_parr_lf,cum_oill_lf !Do i = 1, counter max1=maxloc(lfhist(1:counter),Dim=1) if ( lf0.05*counter) ) then !if (max1>0.05*counter) then cum_parr_lf=0 cum_oill_lf=0 min1=0 max1=0 Do while(max1 .LT. counter) max1=max1+maxloc(lfhist(max1+1:counter),Dim=1) Do j = min1+1, max1 cum_parr_lf=cum_parr_lf+qlhist(j)*dt*c0hist(j)*min(lf/lfhist(max1),1.0) !write(99,*) 'qlhist=',j,qlhist(j)*543466,'bpd' cum_oill_lf=cum_oill_lf+qlhist(j)*dt*c0_oilhist(j)*(1-coal_frhist(j))*min(lf/lfhist(max1),1.0) end do min1=max1 end do else cum_parr_lf=cum_parr cum_oill_lf=cum_oill end if !end do !Write(*,*) cum_parr_lf,cum_oill_lf !Write(99,*) cum_parr_lf,cum_oill_lf End Subroutine Find_Cumulative !========================================================================================= !========================================================================================= ! Commentor: Ajay Suri ! Date: May 2013 ! Subroutine Find_Cumulative2 !========================================================================================= Subroutine Find_Cumulative2(Lf,dt,counter,lambdahist,lambda_oilhist,lfhist,qlhist,c0hist,c0_oilhist,coal_frhist,& ! input parameters cum_parr_lambda_lf,cum_oill_lambda_lf,cum_parr_lambda,cum_oill_lambda) ! output parameters Implicit none Integer, Intent(in) :: counter real(8), Intent(in) :: lf,dt,cum_parr_lambda,cum_oill_lambda real(8), Dimension(counter), Intent(in) :: lambdahist,lambda_oilhist,lfhist,qlhist,c0hist,c0_oilhist,coal_frhist real(8), Intent(out) :: cum_parr_lambda_lf,cum_oill_lambda_lf !Local variables !real(8) :: min1,max1 Integer :: i,j,min1,max1 !Write(*,*) !Write(*,*) cum_parr_lambda_lf,cum_oill_lambda_lf !Write(99,*) !Write(99,*) cum_parr_lambda_lf,cum_oill_lambda_lf !Do i = 1, counter max1=maxloc(lfhist(1:counter),Dim=1) if ( lf0.05*counter) ) then !if (max1>0.05*counter) then cum_parr_lambda_lf=0 cum_oill_lambda_lf=0 min1=0 max1=0 Do while(max1 .LT. counter) max1=max1+maxloc(lfhist(max1+1:counter),Dim=1) Do j = min1+1, max1 cum_parr_lambda_lf=cum_parr_lambda_lf+lambdahist(j)*qlhist(j)*dt*c0hist(j)*min(lf/lfhist(max1),1.0) !write(99,*) 'qlhist=',j,qlhist(j)*543466,'bpd' cum_oill_lambda_lf=cum_oill_lambda_lf+lambda_oilhist(j)*qlhist(j)*dt*c0_oilhist(j)*(1-coal_frhist(j))*min(lf/lfhist(max1),1.0) end do min1=max1 end do else cum_parr_lambda_lf=cum_parr_lambda cum_oill_lambda_lf=cum_oill_lambda end if !end do !Write(*,*) cum_parr_lambda_lf,cum_oill_lambda_lf !Write(99,*) cum_parr_lambda_lf,cum_oill_lambda_lf End Subroutine Find_Cumulative2 !========================================================================================= !------------------------------------------------ ! Added outside module widcalc by Ajay Suri on Nov 29 2006 ! REASON: Module widcalc has variable names which are same in the outside subroutines ! PermDecl (Function) ! Calculate Permeability Decline as a function of ! deposited particles. For a description of the 3 ! mechanisms, see Pang's thesis. ! Input Variables: ! sig: Clogged concentration (fraction) ! por: Original porosity (fraction) ! dg: Grain diameter ! dp: Particle diameter ! df: Damage Factor (dim. less.) ! Result: ! PermDecl A number equal to k/k0 ! ! Originally written by Pang ! By Erik Wennberg September 1996 ! Rewritten to Fortran January 1997 !------------------------------------------------ real(8) Function PermDecl(sig,por0,dg,dp,df) Implicit None real(8) :: sig,por0,dg,dp,df real(8) :: por ! Intermediate real(8) :: kdp, kds, kdt ! Perm. reduct., porosity, surface area and tortuosity !por = por0-0.33*sig por = por0-sig kdp=(por)**3/por0**3*((1-por0)/(1-por))**2 !kds=((1+sig/(1-por0))/(1+(dg/dp)**0.1*sig/(1-por0)))**2 ! used for Nexen C1 match kds=((1+sig/(1-por0))/(1+(dg/dp)*sig/(1-por0)))**2 kdt = 1/(1+df*sig) ! Tortuosity, Eq 6.77 PermDecl = kdp*kds*kdt ! Total decline End Function !-------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------- ! Exception handler routine hand_fpe !-------------------------------------------------------------------------------------------- FUNCTION hand_fpe (signum, excnum) !MS$ATTRIBUTES C :: hand_fpe USE MSFLIB INTEGER(2) signum, excnum WRITE(*,*) 'In signal handler for SIG$FPE' WRITE(*,*) 'signum = ', signum WRITE(*,*) 'exception = ', excnum SELECT CASE(excnum) CASE(FPE$INVALID ) STOP ' Floating point exception: Invalid number' CASE( FPE$DENORMAL ) STOP ' Floating point exception: Denormalized number' CASE( FPE$ZERODIVIDE ) STOP ' Floating point exception: Zero divide' CASE( FPE$OVERFLOW ) STOP ' Floating point exception: Overflow' CASE( FPE$UNDERFLOW ) STOP ' Floating point exception: Underflow' CASE( FPE$INEXACT ) STOP ' Floating point exception: Inexact precision' CASE DEFAULT STOP ' Floating point exception: Non-IEEE type' END SELECT hand_fpe = 1 END !-------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------- !! START OF UTWID PROGRAM !!START OF UTWID PROGRAM !! START OF UTWID PROGRAM !! START OF UTWID PROGRAM !!START OF UTWID PROGRAM !! START OF UTWID PROGRAM !! START OF UTWID PROGRAM !!START OF UTWID PROGRAM !! START OF UTWID PROGRAM !-------------------------------------------------------------------------------------------- !Program UTWID ! ! USE DFPORT ! USE WidCalc ! !! SIGTEST.F90 !! Establish the name of the exception handler as the !! function to be invoked if an exception happens. !! The exception handler hand_fpe is attached below. ! ! USE MSFLIB ! INTERFACE ! FUNCTION hand_fpe (sigid, except) ! !MS$ATTRIBUTES C :: hand_fpe ! INTEGER(4) hand_fpe ! INTEGER(2) sigid, except ! END FUNCTION ! END INTERFACE ! ! INTEGER(4) iret ! real(8)::elapsed_time, begin_time,end_time ! Character(10):: startdate, starttime, enddate, endtime ! ! elapsed_time= TIMEF() ! Call CPU_TIME(begin_time) ! OPEN(Unit=99, NAME='Wid.Log', ACTION = 'Write') ! Call Date_and_Time(startdate, starttime) ! WRITE(99,*) 'Simulation start time:', startdate, starttime ! !! Function SignalQQ is called whenever there is a floating point exception !! The operating system makes this call ! iret = SIGNALQQ(SIG$FPE, hand_fpe) ! WRITE(*,*) 'Set exception handler. Return = ', iret ! ! Call mainc ! OPEN(Unit=959, NAME='Run_S.tmp', ACTION = 'Write') ! Write(959,*) "1" ! close (959) ! ! Call Date_and_Time(enddate,endtime) ! WRITE(99,*) 'Simulation end time:', enddate,endtime ! WRITE(99,*) ! Call CPU_TIME(end_time) ! WRITE(99,*) 'CPU Run time:', end_time-begin_time, 'seconds' ! elapsed_time= TIMEF() ! WRITE(99,*) 'Simulation Run time:', elapsed_time, 'seconds' ! ! Close(99) ! !End Program UTWID !-------------------------------------------------------------------------------------------- !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !! END OF PROGRAM !--------------------------------------------------------------------------------------------