gwf_int.F90

Go to the documentation of this file.

!     #################################################################
      SUBROUTINE gwf_int(KLON,KLAT,PGRID_RES,PLAT,OMASK,PNUM_AQUI,PTRANS,PCR,PCC)
!     #################################################################
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_trip_par, ONLY : xpi
!
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
REAL,                    INTENT(IN)    :: PGRID_RES
REAL, DIMENSION(:  ),    INTENT(IN)    :: PLAT
REAL, DIMENSION(:,:),    INTENT(IN)    :: PNUM_AQUI
REAL, DIMENSION(:,:),    INTENT(IN)    :: PTRANS
!
LOGICAL, DIMENSION(:,:), INTENT(IN)    :: OMASK
!
REAL,    DIMENSION(:,:), INTENT(INOUT) :: PCR
REAL,    DIMENSION(:,:), INTENT(INOUT) :: PCC
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(KLON,KLAT)     :: ZT
REAL                           :: ZDLAT
INTEGER                        :: JLON, JLAT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GWF_INT',0,zhook_handle)
!
! *      1.   CALCULATE TRANSMISSIVITY
!             ------------------------
!
zdlat = pgrid_res/2.0
!
zt(:,:)=0.0 
WHERE(omask(:,:))
      zt(:,:)=ptrans(:,:)
ENDWHERE
!
! *      2.   CALCULATE HORIZONTAL CONDUCTANCES TO THE RIGHT (CR)
!             AND TO THE TOP(CC)
!             ------------------
!
DO jlat = 1,klat
    DO jlon = 1,klon
!
! CALCULATE CONDUCTANCE TO THE RIGHT (CR)
!
       IF(omask(jlon,jlat).AND.jlon<klon)THEN
!
           IF(pnum_aqui(jlon,jlat)==pnum_aqui(jlon+1,jlat))THEN
!              variable head cells adjacent
               pcr(jlon,jlat) =  sqrt(zt(jlon+1,jlat)*zt(jlon,jlat))/(cos(plat(jlat)*xpi/180.))
           ELSEIF(pnum_aqui(jlon,jlat)==0.0)THEN
!              adjacent constant head cells (flux to ocean)
               pcr(jlon,jlat) = zt(jlon+1,jlat)/(cos(plat(jlat)*xpi/180.))
           ELSEIF(pnum_aqui(jlon+1,jlat)==0.0)THEN
!              adjacent constant head cells (flux to ocean)
               pcr(jlon,jlat) = zt(jlon,jlat)/(cos(plat(jlat)*xpi/180.))
           ENDIF
!
       ENDIF
!
! CALCULATE CONDUCTANCE TO THE TOP (CC)
!
       IF(omask(jlon,jlat).AND.jlat<klat)THEN
!
           IF(pnum_aqui(jlon,jlat)==pnum_aqui(jlon,jlat+1))THEN
!              variable head cells adjacent
               pcc(jlon,jlat) = sqrt(zt(jlon,jlat)*zt(jlon,jlat+1))*cos((plat(jlat)+zdlat)*xpi/180.)
           ELSEIF(pnum_aqui(jlon,jlat)==0.0)THEN
!              adjacent constant head cells (flux to ocean)
               pcc(jlon,jlat) = zt(jlon,jlat+1)*cos((plat(jlat)+zdlat)*xpi/180.)
           ELSEIF(pnum_aqui(jlon,jlat+1)==0.0)THEN
!              adjacent constant head cells (flux to ocean)
               pcc(jlon,jlat) = zt(jlon,jlat)*cos((plat(jlat)+zdlat)*xpi/180.)
           ENDIF
!
       ENDIF
    ENDDO
ENDDO
!
IF (lhook) CALL dr_hook('GWF_INT',1,zhook_handle)
!
END SUBROUTINE gwf_int
!