wrfv2_fire/dyn_nmm/RDTEMP.F

   1 !
   2 !NCEP_MESO:MODEL_LAYER: PHYSICS
   3 !
   4 !***********************************************************************
   5       SUBROUTINE RDTEMP(NTSD,DT,JULDAY,JULYR,XTIME,IHRST,GLAT,GLON      &
   6      &                 ,CZEN,CZMEAN,T,RSWTT,RLWTT,HBM2                  &
   7      &                 ,IDS,IDE,JDS,JDE,KDS,KDE                         &
   8      &                 ,IMS,IME,JMS,JME,KMS,KME                         &
   9      &                 ,ITS,ITE,JTS,JTE,KTS,KTE)
  10 !***********************************************************************
  11 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
  12 !                .      .    .
  13 ! SUBPROGRAM:    RDTEMP      RADIATIVE TEMPERATURE CHANGE
  14 !   PRGRMMR: BLACK           ORG: W/NP22     DATE: 93-12-29
  15 !
  16 ! ABSTRACT:
  17 !     RDTEMP APPLIES THE TEMPERATURE TENDENCIES DUE TO
  18 !     RADIATION AT ALL LAYERS AT EACH ADJUSTMENT TIME STEP
  19 !
  20 ! PROGRAM HISTORY LOG:
  21 !   87-09-??  BLACK      - ORIGINATOR
  22 !   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
  23 !   95-11-20  ABELES     - PARALLEL OPTIMIZATION
  24 !   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
  25 !   02-06-07  BLACK      - WRF CODING STANDARDS
  26 !   02-09-09  WOLFE      - CONVERTING TO GLOBAL INDEXING
  27 !   05-12-19  BLACK      - CONVERTED FROM IKJ TO IJK
  28 !
  29 ! USAGE: CALL RDTEMP FROM SUBROUTINE SOLVE_RUNSTREAM
  30 !
  31 ! ATTRIBUTES:
  32 !   LANGUAGE: FORTRAN 90
  33 !   MACHINE : IBM SP
  34 !$$$
  35 !-----------------------------------------------------------------------
  36       USE MODULE_MPP
  37       USE MODULE_RA_GFDLETA,ONLY : CAL_MON_DAY,ZENITH
  38 !-----------------------------------------------------------------------
  39 !
  40       IMPLICIT NONE
  41 !
  42 !-----------------------------------------------------------------------
  43 !
  44       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
  45      &                     ,IMS,IME,JMS,JME,KMS,KME                     &
  46      &                     ,ITS,ITE,JTS,JTE,KTS,KTE
  47 !
  48       INTEGER,INTENT(IN) :: IHRST,JULDAY,JULYR,NTSD
  49 !
  50       REAL,INTENT(IN) :: DT,XTIME
  51 !
  52       REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZMEAN,GLAT,GLON    &
  53      &                                             ,HBM2
  54 !
  55       REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: RLWTT       &
  56      &                                                     ,RSWTT
  57 !
  58       REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: T
  59 !
  60       REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CZEN
  61 !
  62 !-----------------------------------------------------------------------
  63 !***  LOCAL VARIABLES
  64 !-----------------------------------------------------------------------
  65 !
  66       INTEGER :: I,J,JDAY,JMONTH,K
  67 !
  68       INTEGER,DIMENSION(3) :: IDAT
  69 !
  70       REAL :: DAYI,HOUR,TIMES,TTNDKL
  71 !
  72       REAL,DIMENSION(IMS:IME,JMS:JME) :: CZEN2,XLAT2,XLON2
  73 !
  74       REAL,DIMENSION(ITS:ITE,JTS:JTE) :: FACTR
  75 !
  76       REAL :: DEGRAD=3.1415926/180.
  77       real :: xlat1,xlon1
  78 !
  79 !-----------------------------------------------------------------------
  80 !-----------------------------------------------------------------------
  81       MYIS=MAX(IDS,ITS)
  82       MYIE=MIN(IDE,ITE)
  83       MYJS=MAX(JDS,JTS)
  84       MYJE=MIN(JDE,JTE)
  85 !-----------------------------------------------------------------------
  86 !
  87 !***  GET CURRENT VALUE OF COS(ZENITH ANGLE)
  88 !
  89 !      TIMES=NTSD*DT
  90       TIMES=XTIME*60.
  91 !
  92       DO J=MYJS,MYJE
  93       DO I=MYIS,MYIE
  94         XLAT2(I,J)=GLAT(I,J)
  95         XLON2(I,J)=GLON(I,J)
  96 !!!!!!!!!!!!Remove the following lines after bit-correct answers
  97 !!!!!!!!!!!!are established with the control
  98 !       xlat1=glat(i,j)/degrad
  99 !       xlat2(i,j)=xlat1*degrad
 100 !       xlon1=glon(i,j)/degrad
 101 !       xlon2(i,j)=xlon1*degrad
 102 !!!!!!!!!!!!
 103 !!!!!!!!!!!!
 104       ENDDO
 105       ENDDO
 106 !
 107       CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
 108
 109       IDAT(1)=JMONTH
 110       IDAT(2)=JDAY
 111       IDAT(3)=JULYR
 112 !
 113       CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,XLON2,XLAT2,CZEN2          &
 114      &           ,MYIS,MYIE,MYJS,MYJE                                   &
 115      &           ,IDS,IDE,JDS,JDE,KDS,KDE                               &
 116      &           ,IMS,IME,JMS,JME,KMS,KME                               &
 117      &           ,ITS,ITE,JTS,JTE,KTS,KTE)
 118 !
 119       DO J=MYJS,MYJE
 120       DO I=MYIS,MYIE
 121         CZEN(I,J)=CZEN2(I,J)
 122         IF(CZMEAN(I,J)>0.)THEN
 123           FACTR(I,J)=CZEN(I,J)/CZMEAN(I,J)
 124         ELSE
 125           FACTR(I,J)=0.
 126         ENDIF
 127       ENDDO
 128       ENDDO
 129 !
 130       DO K=KTS,KTE
 131         DO J=MYJS,MYJE
 132         DO I=MYIS,MYIE
 133           TTNDKL=RSWTT(I,J,K)*FACTR(I,J)+RLWTT(I,J,K)
 134           T(I,J,K)=T(I,J,K)+TTNDKL*DT*HBM2(I,J)
 135         ENDDO
 136         ENDDO
 137       ENDDO
 138 !-----------------------------------------------------------------------
 139       END SUBROUTINE RDTEMP
 140 !-----------------------------------------------------------------------