phys/module_sf_tmnupdate.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_sf_tmnupdate
   4
   5
   6 CONTAINS
   7
   8    SUBROUTINE tmnupdate(tsk,tmn,tlag,tyr,tyra,tdly,nday,nyear,lagday, &
   9                 julian_in, dt, yr,                                  &
  10                 ids, ide, jds, jde, kds, kde,                       &
  11                 ims, ime, jms, jme, kms, kme,                       &
  12                 i_start,i_end, j_start,j_end, kts,kte, num_tiles   )
  13
  14
  15    IMPLICIT NONE
  16
  17 !---------------------------------------------------------------------
  18    INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
  19                                      ims, ime, jms, jme, kms, kme,   &
  20                                      kts, kte, num_tiles, lagday
  21
  22    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
  23      &           i_start,i_end,j_start,j_end
  24
  25    INTEGER, INTENT(INOUT ) ::   NYEAR
  26    REAL   , INTENT(INOUT ) ::   NDAY
  27    INTEGER, INTENT(IN ) ::   YR
  28
  29    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)::   TSK
  30    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   TMN
  31    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) ::   TYR
  32    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) ::   TYRA
  33    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) ::   TDLY
  34    REAL, DIMENSION( ims:ime , 1:lagday , jms:jme ), INTENT(INOUT ) ::   TLAG
  35    REAL,                                INTENT(IN)  :: julian_in, dt
  36
  37 !... Local Variables
  38
  39 !... Integer
  40       INTEGER :: ij, i, j, n
  41 !... Real
  42       REAL, PARAMETER      :: tconst = 0.6
  43       REAL  :: julian, yrday, tprior, deltat
  44
  45 #ifdef NO_LEAP_CALENDAR
  46 ! no leap year when coupled with CCSM
  47       yrday=365.      ! number of days in a non-leap year
  48 #else
  49       yrday=365.      ! number of days in a non-leap year
  50       if(mod(yr,4).eq.0) yrday=366.
  51 #endif
  52
  53 ! accumulate tsk of current day
  54     !$OMP PARALLEL DO   &
  55     !$OMP PRIVATE ( ij, i, j )
  56     DO ij = 1 , num_tiles
  57       DO j=j_start(ij),j_end(ij)
  58       DO i=i_start(ij),i_end(ij)
  59              tdly(i,j)=tdly(i,j)+tsk(i,j)*dt
  60       ENDDO
  61       ENDDO
  62      ENDDO
  63     nday=nday+1.*dt
  64
  65
  66 ! Update deep soil temperature
  67 ! if it is the end of a day, update variables
  68     !! deltat=(julian_in-int(julian_in))*24.*3600.
  69     !! IF(nint(deltat).lt.dt) THEN
  70     deltat=(julian_in-nint(julian_in))*24.*3600.
  71     IF(abs(deltat).le.dt/2.) THEN
  72       julian=(julian_in-1.)+(dt/(60.*60.*24.))
  73       !$OMP PARALLEL DO   &
  74       !$OMP PRIVATE ( ij, i, j, n )
  75       DO ij = 1 , num_tiles
  76         DO j=j_start(ij),j_end(ij)
  77         DO i=i_start(ij),i_end(ij)
  78 ! update tmn
  79                tprior=0.0
  80                do n=1,lagday
  81                  tprior=tprior+tlag(i,n,j)
  82                end do
  83                tprior=tprior/lagday
  84                tmn(i,j)=tconst*tyr(i,j)+(1.-tconst)*tprior
  85 ! update tlag and tyra
  86                do n=1,lagday-1
  87                  tlag(i,n,j)=tlag(i,n+1,j)
  88                end do
  89                tlag(i,lagday,j)=tdly(i,j)/nday
  90                tdly(i,j)=0.0
  91         ENDDO
  92         ENDDO
  93       ENDDO
  94       nday=0.
  95 ! update tyr if it is the end of a year
  96       if((yrday-julian).le.1.) then
  97         DO ij = 1 , num_tiles
  98           DO j=j_start(ij),j_end(ij)
  99           DO i=i_start(ij),i_end(ij)
 100                 tyr(i,j)=tyra(i,j)/nyear
 101                 tyra(i,j)=0.0
 102           ENDDO
 103           ENDDO
 104         ENDDO
 105         nyear=0
 106       else
 107         DO ij = 1 , num_tiles
 108           DO j=j_start(ij),j_end(ij)
 109           DO i=i_start(ij),i_end(ij)
 110                 tyra(i,j)=tyra(i,j)+tlag(i,lagday,j)
 111           ENDDO
 112           ENDDO
 113         ENDDO
 114         nyear=nyear+1
 115       endif
 116     ENDIF
 117
 118 !
 119       return
 120
 121    END SUBROUTINE tmnupdate
 122
 123
 124 END MODULE module_sf_tmnupdate