| 1 | SUBROUTINE LWVD & |
|---|
| 2 | &( KIDIA, KFDIA, KLON , KLEV , KTRAER & |
|---|
| 3 | &, PABCU, PDBDT & |
|---|
| 4 | &, PGA , PGB & |
|---|
| 5 | &, PCNTRB, PDISD, PDISU, PDWFSU & |
|---|
| 6 | &) |
|---|
| 7 | |
|---|
| 8 | !**** *LWVD* - L.W., VERTICAL INTEGRATION, DISTANT LAYERS |
|---|
| 9 | |
|---|
| 10 | ! PURPOSE. |
|---|
| 11 | ! -------- |
|---|
| 12 | ! CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS |
|---|
| 13 | |
|---|
| 14 | !** INTERFACE. |
|---|
| 15 | ! ---------- |
|---|
| 16 | |
|---|
| 17 | ! EXPLICIT ARGUMENTS : |
|---|
| 18 | ! -------------------- |
|---|
| 19 | ! ==== INPUTS === |
|---|
| 20 | ! PABCU : (KLON,NUA,3*KLEV+1) ; ABSORBER AMOUNTS |
|---|
| 21 | ! PDBDT : (KLON,KLEV) ; LAYER PLANCK FUNCTION GRADIENT |
|---|
| 22 | ! PGA, PGB ; PADE APPROXIMANTS |
|---|
| 23 | ! ==== OUTPUTS === |
|---|
| 24 | ! PCNTRB : (KLON,KLEV+1,KLEV+1); ENERGY EXCHANGE MATRIX |
|---|
| 25 | ! PDIS.. : (KLON,KLEV+1) ; CONTRIBUTION BY DISTANT LAYERS |
|---|
| 26 | ! PDWFSU : (KLON,NSIL) ; SPECTRAL DOWNWARD FLUX AT SURFACE |
|---|
| 27 | |
|---|
| 28 | ! IMPLICIT ARGUMENTS : NONE |
|---|
| 29 | ! -------------------- |
|---|
| 30 | |
|---|
| 31 | ! METHOD. |
|---|
| 32 | ! ------- |
|---|
| 33 | |
|---|
| 34 | ! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE |
|---|
| 35 | ! CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE |
|---|
| 36 | |
|---|
| 37 | ! EXTERNALS. |
|---|
| 38 | ! ---------- |
|---|
| 39 | |
|---|
| 40 | ! *LWTT* |
|---|
| 41 | |
|---|
| 42 | ! REFERENCE. |
|---|
| 43 | ! ---------- |
|---|
| 44 | |
|---|
| 45 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
|---|
| 46 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
|---|
| 47 | |
|---|
| 48 | ! AUTHOR. |
|---|
| 49 | ! ------- |
|---|
| 50 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
|---|
| 51 | |
|---|
| 52 | ! MODIFICATIONS. |
|---|
| 53 | ! -------------- |
|---|
| 54 | ! ORIGINAL : 89-07-14 |
|---|
| 55 | ! JJ Morcrette 97-04-18 Revised continuum + Surf. Emissiv. |
|---|
| 56 | !----------------------------------------------------------------------- |
|---|
| 57 | |
|---|
| 58 | #include "tsmbkind.h" |
|---|
| 59 | |
|---|
| 60 | USE YOELW , ONLY : NSIL ,NIPD ,NTRA ,NUA ,NG1P1 |
|---|
| 61 | |
|---|
| 62 | |
|---|
| 63 | IMPLICIT NONE |
|---|
| 64 | |
|---|
| 65 | |
|---|
| 66 | ! DUMMY INTEGER SCALARS |
|---|
| 67 | INTEGER_M :: KFDIA |
|---|
| 68 | INTEGER_M :: KIDIA |
|---|
| 69 | INTEGER_M :: KLEV |
|---|
| 70 | INTEGER_M :: KLON |
|---|
| 71 | INTEGER_M :: KTRAER |
|---|
| 72 | |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | !----------------------------------------------------------------------- |
|---|
| 76 | |
|---|
| 77 | !* 0.1 ARGUMENTS |
|---|
| 78 | ! --------- |
|---|
| 79 | |
|---|
| 80 | |
|---|
| 81 | REAL_B :: PABCU(KLON,NUA,3*KLEV+1)& |
|---|
| 82 | &, PDBDT(KLON,NSIL,KLEV)& |
|---|
| 83 | &, PGA(KLON,NIPD,2,KLEV) , PGB(KLON,NIPD,2,KLEV) |
|---|
| 84 | |
|---|
| 85 | REAL_B :: PCNTRB(KLON,KLEV+1,KLEV+1)& |
|---|
| 86 | &, PDISD(KLON,KLEV+1) , PDISU(KLON,KLEV+1)& |
|---|
| 87 | &, PDWFSU(KLON,NSIL) |
|---|
| 88 | |
|---|
| 89 | !----------------------------------------------------------------------- |
|---|
| 90 | |
|---|
| 91 | !* 0.2 LOCAL ARRAYS |
|---|
| 92 | ! ------------ |
|---|
| 93 | |
|---|
| 94 | REAL_B :: ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA) |
|---|
| 95 | |
|---|
| 96 | ! LOCAL INTEGER SCALARS |
|---|
| 97 | INTEGER_M :: IJKL, IKD1, IKD2, IKJ, IKJP1, IKM1, IKN,& |
|---|
| 98 | &IKP1, IKU1, IKU2, ITT, JA, JK, JKJ, JL, JLK |
|---|
| 99 | |
|---|
| 100 | ! LOCAL REAL SCALARS |
|---|
| 101 | REAL_B :: ZWW, ZWW1, ZWW2, ZWW3, ZWW4, ZWW5, ZWW6 |
|---|
| 102 | |
|---|
| 103 | |
|---|
| 104 | !----------------------------------------------------------------------- |
|---|
| 105 | |
|---|
| 106 | !* 1. INITIALIZATION |
|---|
| 107 | ! -------------- |
|---|
| 108 | |
|---|
| 109 | !* 1.1 INITIALIZE LAYER CONTRIBUTIONS |
|---|
| 110 | ! ------------------------------ |
|---|
| 111 | |
|---|
| 112 | DO JK = 1, KLEV+1 |
|---|
| 113 | DO JL = KIDIA,KFDIA |
|---|
| 114 | PDISD(JL,JK) = _ZERO_ |
|---|
| 115 | PDISU(JL,JK) = _ZERO_ |
|---|
| 116 | ENDDO |
|---|
| 117 | ENDDO |
|---|
| 118 | |
|---|
| 119 | !* 1.2 INITIALIZE TRANSMISSION FUNCTIONS |
|---|
| 120 | ! --------------------------------- |
|---|
| 121 | |
|---|
| 122 | DO JA = 1, NTRA |
|---|
| 123 | DO JL = KIDIA,KFDIA |
|---|
| 124 | ZTT (JL,JA) = _ONE_ |
|---|
| 125 | ZTT1(JL,JA) = _ONE_ |
|---|
| 126 | ZTT2(JL,JA) = _ONE_ |
|---|
| 127 | ENDDO |
|---|
| 128 | ENDDO |
|---|
| 129 | |
|---|
| 130 | ! ------------------------------------------------------------------ |
|---|
| 131 | |
|---|
| 132 | !* 2. VERTICAL INTEGRATION |
|---|
| 133 | ! -------------------- |
|---|
| 134 | |
|---|
| 135 | |
|---|
| 136 | !* 2.2 CONTRIBUTION FROM DISTANT LAYERS |
|---|
| 137 | ! --------------------------------- |
|---|
| 138 | |
|---|
| 139 | |
|---|
| 140 | !* 2.2.1 DISTANT AND ABOVE LAYERS |
|---|
| 141 | ! ------------------------ |
|---|
| 142 | |
|---|
| 143 | |
|---|
| 144 | !* 2.2.2 FIRST UPPER LEVEL |
|---|
| 145 | ! ----------------- |
|---|
| 146 | |
|---|
| 147 | DO JK = 1 , KLEV-1 |
|---|
| 148 | IKP1=JK+1 |
|---|
| 149 | IKN=(JK-1)*NG1P1+1 |
|---|
| 150 | IKD1= JK *NG1P1+1 |
|---|
| 151 | |
|---|
| 152 | CALL LWTTM & |
|---|
| 153 | &( KIDIA , KFDIA , KLON & |
|---|
| 154 | &, PGA(1,1,1,JK) , PGB(1,1,1,JK)& |
|---|
| 155 | &, PABCU(1,1,IKN), PABCU(1,1,IKD1), ZTT1 & |
|---|
| 156 | &) |
|---|
| 157 | |
|---|
| 158 | |
|---|
| 159 | |
|---|
| 160 | !* 2.2.3 HIGHER UP |
|---|
| 161 | ! --------- |
|---|
| 162 | |
|---|
| 163 | ITT=1 |
|---|
| 164 | DO JKJ=IKP1,KLEV |
|---|
| 165 | IF(ITT == 1) THEN |
|---|
| 166 | ITT=2 |
|---|
| 167 | ELSE |
|---|
| 168 | ITT=1 |
|---|
| 169 | ENDIF |
|---|
| 170 | IKJP1=JKJ+1 |
|---|
| 171 | IKD2= JKJ *NG1P1+1 |
|---|
| 172 | |
|---|
| 173 | IF(ITT == 1) THEN |
|---|
| 174 | CALL LWTTM & |
|---|
| 175 | &( KIDIA , KFDIA , KLON & |
|---|
| 176 | &, PGA(1,1,1,JKJ), PGB(1,1,1,JKJ)& |
|---|
| 177 | &, PABCU(1,1,IKN), PABCU(1,1,IKD2), ZTT1 & |
|---|
| 178 | &) |
|---|
| 179 | |
|---|
| 180 | |
|---|
| 181 | ELSE |
|---|
| 182 | CALL LWTTM & |
|---|
| 183 | &( KIDIA , KFDIA , KLON & |
|---|
| 184 | &, PGA(1,1,1,JKJ), PGB(1,1,1,JKJ)& |
|---|
| 185 | &, PABCU(1,1,IKN), PABCU(1,1,IKD2), ZTT2 & |
|---|
| 186 | &) |
|---|
| 187 | |
|---|
| 188 | |
|---|
| 189 | ENDIF |
|---|
| 190 | |
|---|
| 191 | DO JA = 1, KTRAER |
|---|
| 192 | DO JL = KIDIA,KFDIA |
|---|
| 193 | ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*_HALF_ |
|---|
| 194 | ENDDO |
|---|
| 195 | ENDDO |
|---|
| 196 | |
|---|
| 197 | DO JL = KIDIA,KFDIA |
|---|
| 198 | ZWW1=PDBDT(JL,1,JKJ)*ZTT(JL,1) *ZTT(JL,10) |
|---|
| 199 | ZWW2=PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) |
|---|
| 200 | ZWW3=PDBDT(JL,3,JKJ)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) |
|---|
| 201 | ZWW4=PDBDT(JL,4,JKJ)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) |
|---|
| 202 | ZWW5=PDBDT(JL,5,JKJ)*ZTT(JL,3) *ZTT(JL,14) |
|---|
| 203 | ZWW6=PDBDT(JL,6,JKJ)*ZTT(JL,6) *ZTT(JL,15) |
|---|
| 204 | ZWW=ZWW1+ZWW2+ZWW3+ZWW4+ZWW5+ZWW6 |
|---|
| 205 | PDISD(JL,JK)=PDISD(JL,JK)+ZWW |
|---|
| 206 | PCNTRB(JL,JK,IKJP1)=ZWW |
|---|
| 207 | IF (JK == 1) THEN |
|---|
| 208 | PDWFSU(JL,1)=PDWFSU(JL,1)+ZWW1 |
|---|
| 209 | PDWFSU(JL,2)=PDWFSU(JL,2)+ZWW2 |
|---|
| 210 | PDWFSU(JL,3)=PDWFSU(JL,3)+ZWW3 |
|---|
| 211 | PDWFSU(JL,4)=PDWFSU(JL,4)+ZWW4 |
|---|
| 212 | PDWFSU(JL,5)=PDWFSU(JL,5)+ZWW5 |
|---|
| 213 | PDWFSU(JL,6)=PDWFSU(JL,6)+ZWW6 |
|---|
| 214 | ENDIF |
|---|
| 215 | ENDDO |
|---|
| 216 | |
|---|
| 217 | |
|---|
| 218 | ENDDO |
|---|
| 219 | ENDDO |
|---|
| 220 | |
|---|
| 221 | |
|---|
| 222 | !* 2.2.4 DISTANT AND BELOW LAYERS |
|---|
| 223 | ! ------------------------ |
|---|
| 224 | |
|---|
| 225 | |
|---|
| 226 | !* 2.2.5 FIRST LOWER LEVEL |
|---|
| 227 | ! ----------------- |
|---|
| 228 | |
|---|
| 229 | DO JK=3,KLEV+1 |
|---|
| 230 | IKN=(JK-1)*NG1P1+1 |
|---|
| 231 | IKM1=JK-1 |
|---|
| 232 | IKJ=JK-2 |
|---|
| 233 | IKU1= IKJ *NG1P1+1 |
|---|
| 234 | |
|---|
| 235 | |
|---|
| 236 | CALL LWTTM & |
|---|
| 237 | &( KIDIA , KFDIA , KLON & |
|---|
| 238 | &, PGA(1,1,1,IKJ) , PGB(1,1,1,IKJ)& |
|---|
| 239 | &, PABCU(1,1,IKU1), PABCU(1,1,IKN), ZTT1 & |
|---|
| 240 | &) |
|---|
| 241 | |
|---|
| 242 | |
|---|
| 243 | |
|---|
| 244 | |
|---|
| 245 | !* 2.2.6 DOWN BELOW |
|---|
| 246 | ! ---------- |
|---|
| 247 | |
|---|
| 248 | ITT=1 |
|---|
| 249 | DO JLK=1,IKJ |
|---|
| 250 | IF(ITT == 1) THEN |
|---|
| 251 | ITT=2 |
|---|
| 252 | ELSE |
|---|
| 253 | ITT=1 |
|---|
| 254 | ENDIF |
|---|
| 255 | IJKL=IKM1-JLK |
|---|
| 256 | IKU2=(IJKL-1)*NG1P1+1 |
|---|
| 257 | |
|---|
| 258 | |
|---|
| 259 | IF(ITT == 1) THEN |
|---|
| 260 | CALL LWTTM & |
|---|
| 261 | &( KIDIA , KFDIA , KLON & |
|---|
| 262 | &, PGA(1,1,1,IJKL), PGB(1,1,1,IJKL)& |
|---|
| 263 | &, PABCU(1,1,IKU2), PABCU(1,1,IKN) , ZTT1 & |
|---|
| 264 | &) |
|---|
| 265 | |
|---|
| 266 | |
|---|
| 267 | ELSE |
|---|
| 268 | CALL LWTTM & |
|---|
| 269 | &( KIDIA , KFDIA , KLON & |
|---|
| 270 | &, PGA(1,1,1,IJKL), PGB(1,1,1,IJKL)& |
|---|
| 271 | &, PABCU(1,1,IKU2), PABCU(1,1,IKN) , ZTT2 & |
|---|
| 272 | &) |
|---|
| 273 | |
|---|
| 274 | |
|---|
| 275 | ENDIF |
|---|
| 276 | |
|---|
| 277 | DO JA = 1, KTRAER |
|---|
| 278 | DO JL = KIDIA,KFDIA |
|---|
| 279 | ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*_HALF_ |
|---|
| 280 | ENDDO |
|---|
| 281 | ENDDO |
|---|
| 282 | |
|---|
| 283 | DO JL = KIDIA,KFDIA |
|---|
| 284 | ZWW=PDBDT(JL,1,IJKL)*ZTT(JL,1) *ZTT(JL,10)& |
|---|
| 285 | &+PDBDT(JL,2,IJKL)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)& |
|---|
| 286 | &+PDBDT(JL,3,IJKL)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)& |
|---|
| 287 | &+PDBDT(JL,4,IJKL)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)& |
|---|
| 288 | &+PDBDT(JL,5,IJKL)*ZTT(JL,3) *ZTT(JL,14)& |
|---|
| 289 | &+PDBDT(JL,6,IJKL)*ZTT(JL,6) *ZTT(JL,15) |
|---|
| 290 | PDISU(JL,JK)=PDISU(JL,JK)+ZWW |
|---|
| 291 | PCNTRB(JL,JK,IJKL)=ZWW |
|---|
| 292 | ENDDO |
|---|
| 293 | |
|---|
| 294 | |
|---|
| 295 | ENDDO |
|---|
| 296 | ENDDO |
|---|
| 297 | |
|---|
| 298 | ! ------------------------------------------------------------------ |
|---|
| 299 | |
|---|
| 300 | RETURN |
|---|
| 301 | END SUBROUTINE LWVD |
|---|
