| 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 | !----------------------------------------------------------------------- |
|---|
