| [3990] | 1 | SUBROUTINE OLWVB ( KIDIA,KFDIA,KLON,KLEV,KUAER & |
|---|
| 2 | & , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP & |
|---|
| 3 | & , PDISD,PDISU,PEMIS & |
|---|
| 4 | & , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP & |
|---|
| 5 | & , PFLUC ) |
|---|
| 6 | ! |
|---|
| 7 | !**** *LWVB* - L.W., VERTICAL INTEGRATION, EXCHANGE WITH BOUNDARIES |
|---|
| 8 | ! |
|---|
| 9 | ! PURPOSE. |
|---|
| 10 | ! -------- |
|---|
| 11 | ! INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL |
|---|
| 12 | ! INTEGRATION |
|---|
| 13 | ! |
|---|
| 14 | !** INTERFACE. |
|---|
| 15 | ! ---------- |
|---|
| 16 | ! |
|---|
| 17 | ! EXPLICIT ARGUMENTS : |
|---|
| 18 | ! -------------------- |
|---|
| 19 | ! ==== INPUTS === |
|---|
| 20 | ! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS |
|---|
| 21 | ! PADJ.. : (KLON,KLEV+1) ; CONTRIBUTION BY ADJACENT LAYERS |
|---|
| 22 | ! PB : (KLON,NISP,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
|---|
| 23 | ! PBINT : (KLON,KLEV+1) ; HALF-LEVEL PLANCK FUNCTIONS |
|---|
| 24 | ! PBSUI : (KLON) ; SURFACE PLANCK FUNCTION |
|---|
| 25 | ! PBSUR : (KLON,NISP) ; SPECTRAL SURFACE PLANCK FUNCTION |
|---|
| 26 | ! PBTOP : (KLON,NISP) ; SPECTRAL T.O.A. PLANCK FUNCTION |
|---|
| 27 | ! PDIS.. : (KLON,KLEV+1) ; CONTRIBUTION BY DISTANT LAYERS |
|---|
| 28 | ! PEMIS : (KLON) ; SURFACE EMISSIVITY |
|---|
| 29 | ! PGA, PGB ; PADE APPROXIMANTS |
|---|
| 30 | ! PGASUR, PGBSUR ; SURFACE PADE APPROXIMANTS |
|---|
| 31 | ! PGATOP, PGBTOP ; T.O.A. PADE APPROXIMANTS |
|---|
| 32 | ! ==== OUTPUTS === |
|---|
| 33 | ! PFLUC(KLON,2,KLEV) ; RADIATIVE FLUXES CLEAR-SKY: |
|---|
| 34 | ! 1 ==> UPWARD FLUX TOTAL |
|---|
| 35 | ! |
|---|
| 36 | ! IMPLICIT ARGUMENTS : NONE |
|---|
| 37 | ! -------------------- |
|---|
| 38 | ! |
|---|
| 39 | ! METHOD. |
|---|
| 40 | ! ------- |
|---|
| 41 | ! |
|---|
| 42 | ! 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE |
|---|
| 43 | ! ATMOSPHERE |
|---|
| 44 | ! 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND |
|---|
| 45 | ! TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA |
|---|
| 46 | ! 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES |
|---|
| 47 | ! |
|---|
| 48 | ! EXTERNALS. |
|---|
| 49 | ! ---------- |
|---|
| 50 | ! |
|---|
| 51 | ! *LWTT* |
|---|
| 52 | ! |
|---|
| 53 | ! REFERENCE. |
|---|
| 54 | ! ---------- |
|---|
| 55 | ! |
|---|
| 56 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
|---|
| 57 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
|---|
| 58 | ! |
|---|
| 59 | ! AUTHOR. |
|---|
| 60 | ! ------- |
|---|
| 61 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
|---|
| 62 | ! |
|---|
| 63 | ! MODIFICATIONS. |
|---|
| 64 | ! -------------- |
|---|
| 65 | ! ORIGINAL : 89-07-14 |
|---|
| 66 | !----------------------------------------------------------------------- |
|---|
| 67 | |
|---|
| 68 | #include "tsmbkind.h" |
|---|
| 69 | |
|---|
| 70 | USE YOEOLW , ONLY : NISP ,NIPD ,NTRA ,NUA ,NG1P1 |
|---|
| 71 | |
|---|
| 72 | |
|---|
| 73 | IMPLICIT NONE |
|---|
| 74 | |
|---|
| 75 | |
|---|
| 76 | ! DUMMY INTEGER SCALARS |
|---|
| 77 | INTEGER_M :: KFDIA |
|---|
| 78 | INTEGER_M :: KIDIA |
|---|
| 79 | INTEGER_M :: KLEV |
|---|
| 80 | INTEGER_M :: KLON |
|---|
| 81 | INTEGER_M :: KUAER |
|---|
| 82 | |
|---|
| 83 | |
|---|
| 84 | !----------------------------------------------------------------------- |
|---|
| 85 | ! |
|---|
| 86 | !* 0.1 ARGUMENTS |
|---|
| 87 | ! --------- |
|---|
| 88 | ! |
|---|
| 89 | ! |
|---|
| 90 | REAL_B :: PABCU(KLON,NUA,3*KLEV+1) & |
|---|
| 91 | & , PADJD(KLON,KLEV+1), PADJU(KLON,KLEV+1) & |
|---|
| 92 | & , PB(KLON,NISP,KLEV+1), PBINT(KLON,KLEV+1) & |
|---|
| 93 | & , PBSUR(KLON,NISP), PBSUI(KLON), PBTOP(KLON,NISP) & |
|---|
| 94 | & , PDISD(KLON,KLEV+1), PDISU(KLON,KLEV+1) & |
|---|
| 95 | & , PEMIS(KLON) & |
|---|
| 96 | & , PGA(KLON,8,2,KLEV), PGB(KLON,8,2,KLEV) & |
|---|
| 97 | & , PGASUR(KLON,8,2), PGBSUR(KLON,8,2) & |
|---|
| 98 | & , PGATOP(KLON,8,2), PGBTOP(KLON,8,2) |
|---|
| 99 | ! |
|---|
| 100 | REAL_B :: PFLUC(KLON,2,KLEV+1) |
|---|
| 101 | ! |
|---|
| 102 | !----------------------------------------------------------------------- |
|---|
| 103 | ! |
|---|
| 104 | !* 0.2 LOCAL ARRAYS |
|---|
| 105 | ! ------------ |
|---|
| 106 | ! |
|---|
| 107 | INTEGER_M :: ITX(KLON) |
|---|
| 108 | ! |
|---|
| 109 | REAL_B :: ZBGND(KLON), ZFD(KLON), ZFDN(KLON,KLEV+1) & |
|---|
| 110 | & , ZFN10(KLON), ZFU(KLON), ZFUP(KLON,KLEV+1) & |
|---|
| 111 | & , ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA) & |
|---|
| 112 | & , ZUU(KLON,NUA) , ZCNSOL(KLON), ZCNTOP(KLON) |
|---|
| 113 | ! |
|---|
| 114 | |
|---|
| 115 | ! LOCAL INTEGER SCALARS |
|---|
| 116 | INTEGER_M :: IN, JA, JK, JL, IND1, IND2, IND3, IND4, JLIM |
|---|
| 117 | |
|---|
| 118 | ! LOCAL REAL SCALARS |
|---|
| 119 | REAL_B :: ZCNTOP1, ZCNTOP2, ZCNTOP3, ZCNTOP4, ZCNTOP5, ZCNTOP6 |
|---|
| 120 | |
|---|
| 121 | !----------------------------------------------------------------------- |
|---|
| 122 | ! |
|---|
| 123 | !* 1. INITIALIZATION |
|---|
| 124 | ! -------------- |
|---|
| 125 | ! |
|---|
| 126 | ! |
|---|
| 127 | !* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
|---|
| 128 | ! --------------------------------- |
|---|
| 129 | ! |
|---|
| 130 | DO JA=1,NTRA |
|---|
| 131 | DO JL=KIDIA,KFDIA |
|---|
| 132 | ZTT (JL,JA)=1.0 |
|---|
| 133 | ZTT1(JL,JA)=1.0 |
|---|
| 134 | ZTT2(JL,JA)=1.0 |
|---|
| 135 | END DO |
|---|
| 136 | END DO |
|---|
| 137 | ! |
|---|
| 138 | DO JA=1,NUA |
|---|
| 139 | DO JL=KIDIA,KFDIA |
|---|
| 140 | ZUU(JL,JA)=1.0 |
|---|
| 141 | END DO |
|---|
| 142 | END DO |
|---|
| 143 | ! |
|---|
| 144 | ! ------------------------------------------------------------------ |
|---|
| 145 | ! |
|---|
| 146 | !* 2. VERTICAL INTEGRATION |
|---|
| 147 | ! -------------------- |
|---|
| 148 | ! |
|---|
| 149 | IND1=0 |
|---|
| 150 | IND3=0 |
|---|
| 151 | IND4=1 |
|---|
| 152 | IND2=1 |
|---|
| 153 | ! |
|---|
| 154 | ! |
|---|
| 155 | !* 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE |
|---|
| 156 | ! ----------------------------------- |
|---|
| 157 | ! |
|---|
| 158 | DO JK = 1 , KLEV |
|---|
| 159 | IN=(JK-1)*NG1P1+1 |
|---|
| 160 | ! |
|---|
| 161 | DO JA=1,KUAER |
|---|
| 162 | DO JL=KIDIA,KFDIA |
|---|
| 163 | ZUU(JL,JA)=PABCU(JL,JA,IN) |
|---|
| 164 | END DO |
|---|
| 165 | END DO |
|---|
| 166 | ! |
|---|
| 167 | ! |
|---|
| 168 | CALL LWTT ( KIDIA,KFDIA,KLON & |
|---|
| 169 | & , PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT ) |
|---|
| 170 | ! |
|---|
| 171 | DO JL = KIDIA,KFDIA |
|---|
| 172 | ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1) *ZTT(JL,10) & |
|---|
| 173 | & +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) & |
|---|
| 174 | & +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) & |
|---|
| 175 | & +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) & |
|---|
| 176 | & +PBTOP(JL,5)*ZTT(JL,3) *ZTT(JL,14) & |
|---|
| 177 | & +PBTOP(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
|---|
| 178 | ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
|---|
| 179 | ZFDN(JL,JK)=ZFD(JL) |
|---|
| 180 | PFLUC(JL,2,JK)=ZFD(JL) |
|---|
| 181 | END DO |
|---|
| 182 | ! |
|---|
| 183 | END DO |
|---|
| 184 | ! |
|---|
| 185 | JK = KLEV+1 |
|---|
| 186 | IN=(JK-1)*NG1P1+1 |
|---|
| 187 | ! |
|---|
| 188 | DO JL = KIDIA,KFDIA |
|---|
| 189 | ZCNTOP(JL)= PBTOP(JL,1) & |
|---|
| 190 | & + PBTOP(JL,2) & |
|---|
| 191 | & + PBTOP(JL,3) & |
|---|
| 192 | & + PBTOP(JL,4) & |
|---|
| 193 | & + PBTOP(JL,5) & |
|---|
| 194 | & + PBTOP(JL,6) |
|---|
| 195 | ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK) |
|---|
| 196 | ZFDN(JL,JK)=ZFD(JL) |
|---|
| 197 | PFLUC(JL,2,JK)=ZFD(JL) |
|---|
| 198 | END DO |
|---|
| 199 | ! |
|---|
| 200 | !* 2.4 COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA |
|---|
| 201 | ! --------------------------------------- |
|---|
| 202 | ! |
|---|
| 203 | ! |
|---|
| 204 | !* 2.4.1 INITIALIZATION |
|---|
| 205 | ! -------------- |
|---|
| 206 | ! |
|---|
| 207 | ! |
|---|
| 208 | !* 2.5 EXCHANGE WITH LOWER LIMIT |
|---|
| 209 | ! ------------------------- |
|---|
| 210 | ! |
|---|
| 211 | DO JL = KIDIA,KFDIA |
|---|
| 212 | ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL)) & |
|---|
| 213 | & *PFLUC(JL,2,1)-PBINT(JL,1) |
|---|
| 214 | END DO |
|---|
| 215 | ! |
|---|
| 216 | JK = 1 |
|---|
| 217 | IN=(JK-1)*NG1P1+1 |
|---|
| 218 | ! |
|---|
| 219 | DO JL = KIDIA,KFDIA |
|---|
| 220 | ZCNSOL(JL)=PBSUR(JL,1) & |
|---|
| 221 | & +PBSUR(JL,2) & |
|---|
| 222 | & +PBSUR(JL,3) & |
|---|
| 223 | & +PBSUR(JL,4) & |
|---|
| 224 | & +PBSUR(JL,5) & |
|---|
| 225 | & +PBSUR(JL,6) |
|---|
| 226 | ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
|---|
| 227 | ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
|---|
| 228 | ZFUP(JL,JK)=ZFU(JL) |
|---|
| 229 | PFLUC(JL,1,JK)=ZFU(JL) |
|---|
| 230 | END DO |
|---|
| 231 | ! |
|---|
| 232 | DO JK = 2 , KLEV+1 |
|---|
| 233 | IN=(JK-1)*NG1P1+1 |
|---|
| 234 | ! |
|---|
| 235 | ! |
|---|
| 236 | DO JA=1,KUAER |
|---|
| 237 | DO JL=KIDIA,KFDIA |
|---|
| 238 | ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN) |
|---|
| 239 | END DO |
|---|
| 240 | END DO |
|---|
| 241 | ! |
|---|
| 242 | ! |
|---|
| 243 | CALL LWTT ( KIDIA,KFDIA,KLON & |
|---|
| 244 | & , PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT ) |
|---|
| 245 | ! |
|---|
| 246 | DO JL = KIDIA,KFDIA |
|---|
| 247 | ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1) *ZTT(JL,10) & |
|---|
| 248 | & +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) & |
|---|
| 249 | & +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) & |
|---|
| 250 | & +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) & |
|---|
| 251 | & +PBSUR(JL,5)*ZTT(JL,3) *ZTT(JL,14) & |
|---|
| 252 | & +PBSUR(JL,6)*ZTT(JL,6) *ZTT(JL,15) |
|---|
| 253 | ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL) |
|---|
| 254 | ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK) |
|---|
| 255 | ZFUP(JL,JK)=ZFU(JL) |
|---|
| 256 | PFLUC(JL,1,JK)=ZFU(JL) |
|---|
| 257 | END DO |
|---|
| 258 | ! |
|---|
| 259 | ! |
|---|
| 260 | END DO |
|---|
| 261 | ! |
|---|
| 262 | ! |
|---|
| 263 | ! |
|---|
| 264 | !* 2.7 CLEAR-SKY FLUXES |
|---|
| 265 | ! ---------------- |
|---|
| 266 | ! |
|---|
| 267 | DO JK = 1 , KLEV+1 |
|---|
| 268 | DO JL = KIDIA,KFDIA |
|---|
| 269 | PFLUC(JL,1,JK) = ZFUP(JL,JK) |
|---|
| 270 | PFLUC(JL,2,JK) = ZFDN(JL,JK) |
|---|
| 271 | END DO |
|---|
| 272 | END DO |
|---|
| 273 | ! |
|---|
| 274 | ! ------------------------------------------------------------------ |
|---|
| 275 | ! |
|---|
| 276 | RETURN |
|---|
| 277 | END SUBROUTINE OLWVB |
|---|
