SUBROUTINE LOCAL90(time2)
!,Tij,zdist,rdist,FRRij)
!use consts
use global
	implicit none  
    
      REAL(DP) :: B2(NSTLAY)
      SAVE
      integer :: gr1,gr2,clock_rate,clock_max,tstart,tend,i,it1,iz,iloc,izloc 
      integer :: it,j 
      real(DP) :: time2,temp(1,Nloc),dtr,tdem1,b1,gam,abeta,iqw,tin1,tmtot
      real(DP) :: pltot,tmrloc,plrloc,ti4
      real(DP), allocatable :: keep(:,:) 
      real(DP) :: Tij(nzloc,imaxr),zdist(nzloc),rdist(nloc),FRRij(nzloc,imaxr)
      logical :: first_run  
      
      !Tij = 0
      DO 9 I=0,NRLOC
        TUTME2(I)=0.
   9  CONTINUE
      IT1=dint(DTDEM1/DTRMAX)+1
      DTR=DTDEM1/IT1
      QDEM1=QDEM
      TDEM1=TDEM
      
!      if(.not.first_run)then
!          open(unit = 11, file = "temps_local1_o.txt",recl = 2140000)
!          open(unit = 12, file = "temps_local2_o.txt",recl = 2140000)
!          open(unit = 13, file = "temps_local5_o.txt",recl = 2140000)
!          first_run = .true.
!      endif

      IF ( (QWDEM.NE.QWDEM1).OR. &
           (ABS(RMPIPE-RMPOLD).GT.(0.01*RMPIPE)) ) THEN
!********** RECALCULATE CONVECTIVE FLUID-GROUND COUPLING COEFFICIENTS
!********** IF FLOW RATE OR BOREHOLE THERMAL RESISTANCE HAS CHANGED
        CWQW=ABS(CW*QWDEM)
        B1=1.
        IF (QWDEM.NE.0.) THEN
!-----------DP OCT 1996
            DO 400 IZ=1,NLAYST
              B2(IZ)=GFRR(2,IZ)/CWQW
  400       CONTINUE
            DO 10 ILOC=1,NLOC
              IZLOC=MOD(ILOC-1,NZLOC)+1
              IZ=ILAYST(IZLOC)
              GAM=PLSTL(ILOC)*B2(IZ)
!-------------END DP OCT 1996
              BETA(ILOC)=EXP(-GAM)
              B1=B1*BETA(ILOC)
   10         CONTINUE
          END IF
        ABETA=1.-B1

        IF (QWDEM.LT.0.) THEN
            IQW=1
          ELSE
            IQW=0
          END IF

        END IF

!********** START OF MAIN ITERATION LOOP FOR LOCAL PROBLEM
       
      DO 200 IT=1,IT1

        IF (QWDEM.NE.0.) THEN
!********** HEAT CARRIER FLUID FLOW RATE NOT ZERO
!---------- Set inlet temperature to demand inlet temperature
            TIN=TDEM1
!---------- Set TIN1 to demand inlet temperature
            TIN1=TDEM1
!---------- Calculate fluid-to-ground heat transfer
!---------- Input : TIN1=inlet temperature, IQW=flow direction
            call system_clock(tstart,clock_rate,clock_max) 
            CALL FPIPE90(TIN1,IQW,QDEM1)
            call system_clock(tend,clock_rate,clock_max)

            ti4 = ti4 + real(tend - tstart)/real(clock_rate)
!---------- Output: TIN1=outlet temperature, QDEM1=heat transfer rate (W)
!---------- Set outlet temperature to TIN1
            TOUT=TIN1
          ELSE
!********** HEAT CARRIER FLUID FLOW RATE ZERO
!---------- Set all local fluid-to-ground heat flows to zero
            DO 100 ILOC=1,NLOC
              FRR(ILOC,2)=0.
  100         CONTINUE
!---------- Set inlet temperature to demand inlet temperature
            TIN=TDEM1
!---------- Set outlet temperature to demand inlet temperature (temporary, see below)
            TOUT=TDEM1
!---------- Set heat transfer rate to zero
            QDEM1=0.
          END IF

!********** HEAT FLOWS AND NEW TEMPERATURES FOR EACH SUBREGION
!---------- Heat flows
        DO 110 ILOC=1,NLOC
!---------DP OCT 1996
          IZLOC=MOD(ILOC-1,NZLOC)+1
          IZ=ILAYST(IZLOC)
          DO 50 I=3,IMAXR
            FRR(ILOC,I)=GFRR(I,IZ)*(TR(ILOC,I-1)-TR(ILOC,I))
   50     CONTINUE
          FRR(ILOC,IMAXR1)=0.
          ESUMR(ILOC)=ESUMR(ILOC)+FRR(ILOC,2)*DTR
        
          
!---------- New temperatures
          DO 90 I=2,IMAXR
            TR(ILOC,I)=TR(ILOC,I)+ &
                       CINR(I,IZ)*(FRR(ILOC,I)-FRR(ILOC,I+1))*DTR
!-----------END DP OCT 1996
   90       CONTINUE
  110     CONTINUE

        
!-AVERAGE SOIL TEMPERATURE NEAR THE BOREHOLE DURING THE TIMESTEP DTR
        TMTOT=0.
        PLTOT=0.
        DO 141 I=1,NRLOC
          TMRLOC=0.
          PLRLOC=0.
          DO 140 J=1,NZLOC
            ILOC=(I-1)*NZLOC+J
!-----------DP OCT 1996
            IZ=ILAYST(J)
            TMRLOC=CR(IZ)*PLSTL(ILOC)*(TR(ILOC,2)+TGM(ILOC))+TMRLOC
            PLRLOC=CR(IZ)*PLSTL(ILOC)+PLRLOC
!-----------END DP OCT 1996
  140     CONTINUE
          TUTMED(I)=TMRLOC/PLRLOC
          TMTOT=TMRLOC+TMTOT
          PLTOT=PLRLOC+PLTOT
  141   CONTINUE
        TUTMED(0)=TMTOT/PLTOT
!-------if no flow  TOUT is set to the average soil temp. near the bore.
        IF (QWDEM.EQ.0.) TOUT=TUTMED(0)
!-------sum for time averaging
        DO 150 I=0,NRLOC
          TUTME2(I)=TUTME2(I)+TUTMED(I)*DTR
  150   CONTINUE
  
!!-------------Temperature at each node
!        do i = 1,nloc        
!            do j = 2,imaxr
!               Tij(i,j)=(TR(i,j)+TGM(i))
!            enddo
!        enddo
!!-------------Flux at each node        
!        do i = 1,nloc        
!            do j = 2,imaxr
!               FRRij(i,j)=(FRR(i,j))
!            enddo
!        enddo

!********** HEAT BALANCE FOR HEAT CARRIER FLUID
        IF(QDEM1) 75,80,65
   65   CONTINUE
        DEPLUS=DEPLUS+QDEM1*DTR
        GO TO 80
   75   CONTINUE
        DENEG=DENEG-QDEM1*DTR
   80   CONTINUE

  200 CONTINUE
      
!********** END OF MAIN ITERATION LOOP FOR LOCAL PROBLEM
!      if(time2/3600 == 8760*5)then
!        write(*,*) ti4
!      endif

      QWDEM1=QWDEM

!-AVERAGE SOIL TEMPERATURE NEAR THE BOREHOLE DURING THE TIME STEP DTDEM1
      DO 210 I=0,NRLOC
        IF (DTDEM1.GT.0.) TUTMED(I)=TUTME2(I)/DTDEM1
  210 CONTINUE

!    zdist(1) = PLSTL(1)
!    do i = 2,nzloc
!        zdist(i) = PLSTL(i)+zdist(i-1)
!    enddo
!    rdist = rr
!   temp = TRAD_out
   !TR(2,1:imaxr)
!    do i = 1,nloc
!        write(11,*) time2/3600,Tij(i,1:imaxr)
!    enddo

RETURN
END subroutine local90

