| 1 |
SUBROUTINE LWV(KUAER,KTRAER, KLIM |
| 2 |
R , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE |
| 3 |
R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
| 4 |
S , PCNTRB,PCTS,PFLUC) |
| 5 |
use dimens_m |
| 6 |
use dimphy |
| 7 |
use SUPHEC_M |
| 8 |
use raddim |
| 9 |
use raddimlw |
| 10 |
IMPLICIT none |
| 11 |
C |
| 12 |
C----------------------------------------------------------------------- |
| 13 |
C PURPOSE. |
| 14 |
C -------- |
| 15 |
C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE |
| 16 |
C FLUXES OR RADIANCES |
| 17 |
C |
| 18 |
C METHOD. |
| 19 |
C ------- |
| 20 |
C |
| 21 |
C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN |
| 22 |
C CONTRIBUTIONS BY - THE NEARBY LAYERS |
| 23 |
C - THE DISTANT LAYERS |
| 24 |
C - THE BOUNDARY TERMS |
| 25 |
C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. |
| 26 |
C |
| 27 |
C REFERENCE. |
| 28 |
C ---------- |
| 29 |
C |
| 30 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
| 31 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
| 32 |
C |
| 33 |
C AUTHOR. |
| 34 |
C ------- |
| 35 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
| 36 |
C |
| 37 |
C MODIFICATIONS. |
| 38 |
C -------------- |
| 39 |
C ORIGINAL : 89-07-14 |
| 40 |
C----------------------------------------------------------------------- |
| 41 |
C |
| 42 |
C* ARGUMENTS: |
| 43 |
INTEGER KUAER,KTRAER, KLIM |
| 44 |
C |
| 45 |
REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS |
| 46 |
REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS |
| 47 |
REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS |
| 48 |
REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION |
| 49 |
REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION |
| 50 |
REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION |
| 51 |
REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT |
| 52 |
REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY |
| 53 |
REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) |
| 54 |
REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE |
| 55 |
REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
| 56 |
REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS |
| 57 |
REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS |
| 58 |
REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS |
| 59 |
REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS |
| 60 |
REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS |
| 61 |
C |
| 62 |
REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX |
| 63 |
REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM |
| 64 |
REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES |
| 65 |
C----------------------------------------------------------------------- |
| 66 |
C LOCAL VARIABLES: |
| 67 |
REAL*8 ZADJD(KDLON,KFLEV+1) |
| 68 |
REAL*8 ZADJU(KDLON,KFLEV+1) |
| 69 |
REAL*8 ZDBDT(KDLON,Ninter,KFLEV) |
| 70 |
REAL*8 ZDISD(KDLON,KFLEV+1) |
| 71 |
REAL*8 ZDISU(KDLON,KFLEV+1) |
| 72 |
C |
| 73 |
INTEGER jk, jl |
| 74 |
C----------------------------------------------------------------------- |
| 75 |
C |
| 76 |
DO 112 JK=1,KFLEV+1 |
| 77 |
DO 111 JL=1, KDLON |
| 78 |
ZADJD(JL,JK)=0. |
| 79 |
ZADJU(JL,JK)=0. |
| 80 |
ZDISD(JL,JK)=0. |
| 81 |
ZDISU(JL,JK)=0. |
| 82 |
111 CONTINUE |
| 83 |
112 CONTINUE |
| 84 |
C |
| 85 |
DO 114 JK=1,KFLEV |
| 86 |
DO 113 JL=1, KDLON |
| 87 |
PCTS(JL,JK)=0. |
| 88 |
113 CONTINUE |
| 89 |
114 CONTINUE |
| 90 |
C |
| 91 |
C* CONTRIBUTION FROM ADJACENT LAYERS |
| 92 |
C |
| 93 |
CALL LWVN(KUAER,KTRAER |
| 94 |
R , PABCU,PDBSL,PGA,PGB |
| 95 |
S , ZADJD,ZADJU,PCNTRB,ZDBDT) |
| 96 |
C* CONTRIBUTION FROM DISTANT LAYERS |
| 97 |
C |
| 98 |
CALL LWVD(KUAER,KTRAER |
| 99 |
R , PABCU,ZDBDT,PGA,PGB |
| 100 |
S , PCNTRB,ZDISD,ZDISU) |
| 101 |
C |
| 102 |
C* EXCHANGE WITH THE BOUNDARIES |
| 103 |
C |
| 104 |
CALL LWVB(KUAER,KTRAER, KLIM |
| 105 |
R , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP |
| 106 |
R , ZDISD,ZDISU,PEMIS,PPMB |
| 107 |
R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP |
| 108 |
S , PCTS,PFLUC) |
| 109 |
C |
| 110 |
C |
| 111 |
RETURN |
| 112 |
END |
Parent Directory
| 
Revision Log