RDTEMP.F
References to this file elsewhere.
1 !
2 !NCEP_MESO:MODEL_LAYER: PHYSICS
3 !
4 !***********************************************************************
5 SUBROUTINE RDTEMP(NTSD,DT,JULDAY,JULYR,IHRST,GLAT,GLON &
6 & ,CZEN,CZMEAN,T,RSWTT,RLWTT,HTM,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 !
28 ! USAGE: CALL RDTEMP FROM SUBROUTINE SOLVE_RUNSTREAM
29 !
30 ! ATTRIBUTES:
31 ! LANGUAGE: FORTRAN 90
32 ! MACHINE : IBM SP
33 !$$$
34 !-----------------------------------------------------------------------
35 USE MODULE_MPP
36 USE MODULE_RA_GFDLETA,ONLY : CAL_MON_DAY,ZENITH
37 !-----------------------------------------------------------------------
38 !
39 IMPLICIT NONE
40 !
41 !-----------------------------------------------------------------------
42 !
43 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
44 & ,IMS,IME,JMS,JME,KMS,KME &
45 & ,ITS,ITE,JTS,JTE,KTS,KTE
46 !
47 INTEGER,INTENT(IN) :: IHRST,JULDAY,JULYR,NTSD
48 !
49 REAL,INTENT(IN) :: DT
50 !
51 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZMEAN,GLAT,GLON &
52 & ,HBM2
53 !
54 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM &
55 & ,RLWTT &
56 & ,RSWTT
57 !
58 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),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 !
91 DO J=MYJS,MYJE
92 DO I=MYIS,MYIE
93 XLAT2(I,J)=GLAT(I,J)
94 XLON2(I,J)=GLON(I,J)
95 !!!!!!!!!!!!Remove the following lines after bit-correct answers
96 !!!!!!!!!!!!are established with the control
97 ! xlat1=glat(i,j)/degrad
98 ! xlat2(i,j)=xlat1*degrad
99 ! xlon1=glon(i,j)/degrad
100 ! xlon2(i,j)=xlon1*degrad
101 !!!!!!!!!!!!
102 !!!!!!!!!!!!
103 ENDDO
104 ENDDO
105 !
106 CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
107
108 IDAT(1)=JMONTH
109 IDAT(2)=JDAY
110 IDAT(3)=JULYR
111 !
112 CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,XLON2,XLAT2,CZEN2 &
113 & ,MYIS,MYIE,MYJS,MYJE &
114 & ,IDS,IDE,JDS,JDE,KDS,KDE &
115 & ,IMS,IME,JMS,JME,KMS,KME &
116 & ,ITS,ITE,JTS,JTE,KTS,KTE)
117 !
118 DO J=MYJS,MYJE
119 DO I=MYIS,MYIE
120 CZEN(I,J)=CZEN2(I,J)
121 IF(CZMEAN(I,J).GT.0.)THEN
122 FACTR(I,J)=CZEN(I,J)/CZMEAN(I,J)
123 ELSE
124 FACTR(I,J)=0.
125 ENDIF
126 ENDDO
127 ENDDO
128 !
129 DO J=MYJS,MYJE
130 DO K=KTS,KTE
131 DO I=MYIS,MYIE
132 TTNDKL=RSWTT(I,K,J)*FACTR(I,J)+RLWTT(I,K,J)
133 T(I,K,J)=T(I,K,J)+TTNDKL*DT*HTM(I,K,J)*HBM2(I,J)
134 ENDDO
135 ENDDO
136 ENDDO
137 !-----------------------------------------------------------------------
138 END SUBROUTINE RDTEMP
139 !-----------------------------------------------------------------------