gwf_budget.F90

Go to the documentation of this file.

!####################################################################
SUBROUTINE gwf_budget(KLON,KLAT,OMASK,PHGROUND,PHDRAIN_RIV,  &
                      PGWDEEP,PCR,PCC,PCRIV,PQGCELL,PQDRAIN  )
!####################################################################
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_trip_par
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
INTEGER,               INTENT(IN)    :: KLON
INTEGER,               INTENT(IN)    :: KLAT
!
LOGICAL,  DIMENSION(:,:), INTENT(IN) :: OMASK
!
REAL,  DIMENSION(:,:), INTENT(IN)    :: PHGROUND
REAL,  DIMENSION(:,:), INTENT(IN)    :: PHDRAIN_RIV
REAL,  DIMENSION(:,:), INTENT(IN)    :: PGWDEEP
REAL,  DIMENSION(:,:), INTENT(IN)    :: PCR
REAL,  DIMENSION(:,:), INTENT(IN)    :: PCC
REAL,  DIMENSION(:,:), INTENT(IN)    :: PCRIV
!
REAL,  DIMENSION(:,:), INTENT(INOUT) :: PQGCELL
REAL,  DIMENSION(:,:), INTENT(INOUT) :: PQDRAIN
!
!*      0.2    declarations of local variables
!
INTEGER :: JLON,JLAT,IX,IY
!
REAL, DIMENSION(KLON,KLAT) :: ZTOP
REAL, DIMENSION(KLON,KLAT) :: ZBOTTOM
REAL, DIMENSION(KLON,KLAT) :: ZLEFT
REAL, DIMENSION(KLON,KLAT) :: ZRIGHT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GWF_BUDGET',0,zhook_handle)
!
! *     1.    CALCULATE FLOW BETWEEN ADJACENT CELL
!            -------------------------------------
!
ztop(:,:) = 0.0
zbottom(:,:) = 0.0
zleft(:,:) = 0.0
zright(:,:) = 0.0
!
DO jlat = 1,klat
    DO jlon = 1,klon
!
!       Skip no-flow and constant-head cells
        IF (omask(jlon,jlat)) THEN

!          Calculate flow through the right face
           ix=min(jlon+1,klon)
           zright(jlon,jlat) = pcr(jlon,jlat) *(phground(ix,jlat)-phground(jlon,jlat)) 
!
!          Calculate flow through the left face
           ix=max(jlon-1,1)
           zleft(jlon,jlat) = pcr(ix,jlat)*(phground(ix,jlat)-phground(jlon,jlat))
!
!          Calculate flow through the bottom face
           iy=max(jlat-1,1)
           zbottom(jlon,jlat) = pcc(jlon,iy)*(phground(jlon,iy)-phground(jlon,jlat))
!
!          Calculate flow through the top face
           iy=min(jlat+1,klat)
           ztop(jlon,jlat) = pcc(jlon,jlat) *(phground(jlon,iy)-phground(jlon,jlat))
!
           pqgcell(jlon,jlat) = (ztop(jlon,jlat)+zbottom(jlon,jlat)+zleft(jlon,jlat)+zright(jlon,jlat))*xrholw
!
        ENDIF
!
    ENDDO
ENDDO
!
! *     2. CALCULATE FLOW TO AQUIFER [kg/s]
!          --------------------------------
!
pqdrain(:,:) = 0.0
WHERE(omask(:,:))
      pqdrain(:,:) = (pcriv(:,:)*(phground(:,:)-phdrain_riv(:,:))-pgwdeep(:,:))*xrholw
ENDWHERE
!
IF (lhook) CALL dr_hook('GWF_BUDGET',1,zhook_handle)
!
END SUBROUTINE gwf_budget