*IF DEF,A02_1A,OR,DEF,A02_1B LWRAD1A.2
C ******************************COPYRIGHT****************************** GTS2F400.5689
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5690
C GTS2F400.5691
C Use, duplication or disclosure of this code is subject to the GTS2F400.5692
C restrictions as set forth in the contract. GTS2F400.5693
C GTS2F400.5694
C Meteorological Office GTS2F400.5695
C London Road GTS2F400.5696
C BRACKNELL GTS2F400.5697
C Berkshire UK GTS2F400.5698
C RG12 2SZ GTS2F400.5699
C GTS2F400.5700
C If no contract has been raised with this copy of the code, the use, GTS2F400.5701
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5702
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5703
C Modelling at the above address. GTS2F400.5704
C ******************************COPYRIGHT****************************** GTS2F400.5705
C GTS2F400.5706
CLL Subroutine LWRAD ---------------------------------------------- LWRAD1A.3
CLL LWRAD1A.4
CLL Purpose : LWRAD1A.5
CLL It is the top-level routine in component P232. It CALLs LWMAST to LWRAD1A.6
CLL produce longwave fluxes (after setting convective cloud base and LWRAD1A.7
CLL top to safe values) and then differences these fluxes and returns LWRAD1A.8
CLL timestep-by timestep increments. It will diagnose Outgoing LWRAD1A.9
CLL Longwave Radiation (OLR) if requested. LWRAD1A.10
CLL Before LWRAD is called, LWLKIN (in deck LWTRAN) must be CALLed to LWRAD1A.11
CLL initialize LUT. LWRAD1A.12
CLL LWRAD1A.13
CLL Author: William Ingram LWRAD1A.14
CLL LWRAD1A.15
CLL Model Modification history from model version 3.0: LWRAD1A.16
CLL version Date LWRAD1A.17
CLL 3.4 31/10/94 Stephanie Woodward AWA1F304.1408
CLL Added 4 arguments (mmr's of minor gases) for compatibility with AWA1F304.1409
CLL new LWRAD1C. They are declared but never used. AWA1F304.1410
CLL 4.2 Sept.96 T3E migration: *DEF CRAY removed; GSS1F402.53
CLL *DEF T3E used for T3E library functions; GSS1F402.54
CLL dynamic allocation no longer *DEF controlled; GSS1F402.55
CLL cray HF functions replaced by T3E lib functions. GSS1F402.56
CLL S.J.Swarbrick GSS1F402.57
! 4.4 12/03/97 Argument L_CLOUD_WATER_PARTITION passed into AYY1F404.316
! cloud calculation code. A Bushell AYY1F404.317
CLL LWRAD1A.18
CLL Programming standard : LWRAD1A.19
CLL It technically conforms with standard A of UMDP 4 (version 2, LWRAD1A.20
CLL 18/1/90) LWRAD1A.21
CLL If UPDATE *DEF CRAY is off, the code is standard FORTRAN 77 LWRAD1A.22
CLL except for the addition of ! comments (and then sets the "vector LWRAD1A.23
CLL length" to 1) but if not it includes CRAY automatic arrays also. LWRAD1A.24
CLL LWRAD1A.25
CLL Logical components covered : P232, D23 LWRAD1A.26
CLL It is the top-level routine in component P232. LWRAD1A.27
CLL P232 (longwave radiation), D23 (radiation diagnostics). LWRAD1A.28
CLL LWRAD1A.29
CLL Project task : P23 LWRAD1A.30
CLL LWRAD1A.31
CLL External documentation: (where appropriate) is in UMDP 23. LWRAD1A.32
CLL LWRAD1A.33
CLLEND ----------------------------------------------------------------- LWRAD1A.34
C*L LWRAD1A.35
SUBROUTINE LWRAD(H2O, CO2, O3, N2OMMR, CH4MMR, C11MMR, C12MMR, 2,4AWA1F304.1411
& TAC, PEXNER, TSTAR, PSTAR, AB, AWA1F304.1412
& BB, AC, BC, AICE, LCA, LCCWC1, LCCWC2, CCA, CCCWP, CCB, CCT, LWRAD1A.37
& LAND, PTS, LUT, LWRAD1A.38
& TCADIA, TCAON, CSOLRD, CSOLON, SFDN, SFDNON, CSSFDN, CSSDON, LWRAD1A.39
& L_CLOUD_WATER_PARTITION, AYY1F404.318
& L2, NLEVS, NCLDS, GSS1F402.58
& NWET, NOZONE, L1, OLR, LWSEA, LWOUT) LWRAD1A.43
C LWRAD1A.44
CL External Routines called LWRAD1A.45
EXTERNAL LWMAST ! Top-level of the LW physics LWRAD1A.46
& , LWDCSF ! Diagnoses clear-sky fraction LWRAD1A.47
C ! Dimensions: LWRAD1A.48
*CALL LWNLKUPS 
LWRAD1A.49
*CALL LWNBANDS LWRAD1A.50
*CALL LWNTRANS LWRAD1A.51
*CALL LWNGASES LWRAD1A.52
C ! Array dimensions must be constants in FORTRAN: LWRAD1A.54
INTEGER!, INTENT(IN) :: LWRAD1A.59
& L2, ! Number of points to be treated LWRAD1A.61
& NLEVS, ! Number of levels LWRAD1A.62
& NCLDS, ! Number of possibly cloudy levels LWRAD1A.63
& L1, ! Full field dimension LWRAD1A.65
& NWET, ! Number of levels with moisture LWRAD1A.66
& NOZONE ! Number of levels with ozone LWRAD1A.67
REAL!, INTENT(IN) :: LWRAD1A.68
& PSTAR(L1), ! Surface pressure LWRAD1A.69
& AB(NLEVS+1), BB(NLEVS+1), ! As and Bs at layer boundaries LWRAD1A.70
& AC(NLEVS), BC(NLEVS), ! As and Bs at layer centres LWRAD1A.71
& H2O(L1,NWET), CO2, ! Mixing ratios of the three LWRAD1A.72
& O3(L1,NOZONE), ! absorbing gases LWRAD1A.73
& N2OMMR, ! mmrs for minor gases AWA1F304.1413
& CH4MMR, ! not used in this version AWA1F304.1414
& C11MMR, ! but included for compatibility AWA1F304.1415
& C12MMR, ! with 1c AWA1F304.1416
& TAC(L1,NLEVS), ! Temperature at layer centres LWRAD1A.74
& PEXNER(L1,NLEVS+1), ! Exner function @ layer boundaries LWRAD1A.75
& TSTAR(L1), ! Surface temperature LWRAD1A.76
& LUT(IT,NTRANS,NGASES,2), ! Look-up tables for LWTRAN LWRAD1A.77
& AICE(L1), ! Sea-ice fraction LWRAD1A.78
& LCCWC1(L1,1/(NCLDS+1)+NCLDS), LCCWC2(L1,1/(NCLDS+1)+NCLDS), LWRAD1A.79
C ! Layer cloud condensed water contents (specific contents, mass LWRAD1A.80
C ! per unit mass). Only the sum of these two fields is used. LWRAD1A.81
& LCA(L1,1/(NCLDS+1)+NCLDS),! Layer cloud fractional cover LWRAD1A.82
& CCCWP(L1), ! Convective cloud fractional cover LWRAD1A.83
& CCA(L1), ! and condensed water path LWRAD1A.84
& PTS ! Time interval that increments to LWRAD1A.85
C ! be returned are to be added in at ("physics timestep"). The LWRAD1A.86
C ! interval over which they are used ("longwave timestep") has no LWRAD1A.87
C ! effect on the longwave code: it just sets how often it is CALLed LWRAD1A.88
INTEGER!, INTENT(IN) :: LWRAD1A.89
& CCB(L1), CCT(L1) ! Convective cloud base & top LWRAD1A.90
LOGICAL!, INTENT(IN) :: LWRAD1A.91
& LAND(L1) ! Land/sea mask (.TRUE. for land) LWRAD1A.92
& , CSOLON ! Is CSOLRD wanted ? LWRAD1A.93
& , TCAON ! & is TCADIA ? LWRAD1A.94
& , SFDNON ! & is SFDN ? LWRAD1A.95
& , CSSDON ! & is CSSFDN ? LWRAD1A.96
& , L_CLOUD_WATER_PARTITION AYY1F404.319
REAL!, INTENT(OUT) :: LWRAD1A.97
& LWOUT(L1,NLEVS+1), ! This is filled by LWMAST with the LWRAD1A.98
C ! net downward longwave flux at all layer boundaries. LWRAD LWRAD1A.99
C ! converts these to atmospheric heating rates, leaving only the LWRAD1A.100
C ! surface fluxes in the first level. LWRAD1A.101
& LWSEA(L1) ! Then it uses numbers LWPLAN has LWRAD1A.102
C ! put into LWSEA to separate out the total surface flux over the LWRAD1A.103
C ! grid-box into the open-ocean and solid-surface (sea-ice or LWRAD1A.104
C ! land) contributions and returns these in LWSEA and the first LWRAD1A.105
C ! level of LWOUT respectively. LWRAD1A.106
& , OLR(L1) ! Outgoing Longwave Radiation LWRAD1A.107
& , CSOLRD(L1) ! and its clear-sky equivalent LWRAD1A.108
& , TCADIA(L2) ! Total Cloud Amount diagnostic LWRAD1A.109
& , SFDN(L2) ! Surface flux down diagnostic LWRAD1A.110
& , CSSFDN(L1) ! and its clear-sky equivalent LWRAD1A.111
C* LWRAD1A.112
*CALL C_G LWRAD1A.113
*CALL C_R_CP LWRAD1A.114
REAL CPBYG LWRAD1A.115
PARAMETER ( CPBYG = CP / G ) LWRAD1A.116
REAL DACON, DBCON ! Conversion factors for turning LWRAD1A.117
C ! fluxes into increments - difference of As and Bs across the LWRAD1A.118
C ! current layer, times CPBYG and divided by the timestep. LWRAD1A.119
INTEGER LEVEL, J ! Loopers over level and point LWRAD1A.120
LOGICAL SFDNCA ! Is SFDN to be calculated by WI200893.12
C ! LWMAST ? - set if either SFDNON or CSSDON is, because SFDN is LWRAD1A.122
C ! needed to find CSSSDN even if not wanted for its own sake. LWRAD1A.123
C ! Space for SFDN is assigned by the "implied diagnostics" LWRAD1A.124
C ! arrangements in that case, but SFDNON is only set if it is WI200893.13
C ! wanted for its own sake. LWRAD1A.126
C LWRAD1A.127
CL Section 1 - correct input data where necessary LWRAD1A.128
CL --------- LWRAD1A.129
C LWRAD1A.130
CL ! Restrict convective cloud base and top to their physical range. LWRAD1A.131
C LWRAD1A.132
DO 10 J=1, L2 LWRAD1A.133
IF ( CCB(J) .GT. NCLDS .OR. CCB(J) .LT. 1 ) CCB(J) = 1 LWRAD1A.134
IF ( CCT(J) .GT. (NCLDS+1) .OR. CCT(J) .LT. 2 ) CCT(J) = NCLDS+1 LWRAD1A.135
10 CONTINUE LWRAD1A.136
C LWRAD1A.137
SFDNCA = SFDNON .OR. CSSDON LWRAD1A.138
C LWRAD1A.139
CL Section 2 - CALL LWMAST LWRAD1A.140
CL --------- LWRAD1A.141
C LWRAD1A.142
CALL LWMAST (H2O, CO2, O3, TAC, PEXNER, TSTAR, PSTAR, AB, BB, LWRAD1A.143
& AC, BC, AICE, LCA, LCCWC1, LCCWC2, CCA, CCCWP, CCB, CCT, LUT, LWRAD1A.144
& CSOLRD, CSOLON, SFDN, SFDNCA, CSSFDN, CSSDON, LWRAD1A.145
& L_CLOUD_WATER_PARTITION, AYY1F404.320
& L2, NLEVS, NCLDS, GSS1F402.59
& NWET, NOZONE, L1, LWSEA, LWOUT) LWRAD1A.149
C LWRAD1A.150
CL Section 3 - convert fluxes to increments LWRAD1A.151
CL --------- LWRAD1A.152
C LWRAD1A.153
CL ! but first copy the top layer into OLR: LWRAD1A.154
C LWRAD1A.155
DO J=1, L2 LWRAD1A.156
OLR(J) = - LWOUT(J,NLEVS+1) LWRAD1A.157
ENDDO LWRAD1A.158
C LWRAD1A.159
CL ! Convert fluxes to increments (Eq 1.1) within the atmosphere, LWRAD1A.160
CL ! leaving the surface net downward flux at the beginning of LWOUT LWRAD1A.161
C LWRAD1A.162
DO 30 LEVEL=NLEVS, 1, -1 LWRAD1A.163
DACON = ( AB(LEVEL) - AB(LEVEL+1) ) * CPBYG / PTS LWRAD1A.164
DBCON = ( BB(LEVEL) - BB(LEVEL+1) ) * CPBYG / PTS LWRAD1A.165
DO 33 J=1, L2 LWRAD1A.166
LWOUT(J,LEVEL+1) = ( LWOUT(J,LEVEL+1) - LWOUT(J,LEVEL) ) LWRAD1A.167
& / ( DACON + PSTAR(J) * DBCON ) LWRAD1A.168
33 CONTINUE LWRAD1A.169
30 CONTINUE LWRAD1A.170
C LWRAD1A.171
CL ! Separate the contributions for a solid surface (land or sea-ice) LWRAD1A.172
CL ! to be added in by the model's surface scheme, from those for LWRAD1A.173
CL ! open sea, to be used in the ocean model. Initially LWOUT LWRAD1A.174
CL ! has the actual box-mean flux and LWSEA has the difference LWRAD1A.175
CL ! between upward surface fluxes for open-sea and sea-ice. LWRAD1A.176
CL ! The values that will never be used (open-sea value at land LWRAD1A.177
CL ! points and solid-surface values at ice-free sea points) are LWRAD1A.178
CL ! zeroed so that the 2 fields will sum to the actual box-mean flux LWRAD1A.179
DO 35 J=1, L2 LWRAD1A.180
IF (LAND(J)) THEN LWRAD1A.181
LWSEA(J) = 0. LWRAD1A.182
ELSE IF ( AICE(J) .EQ. 0. ) THEN LWRAD1A.183
LWSEA(J) = LWOUT(J,1) LWRAD1A.184
LWOUT(J,1) = 0. LWRAD1A.185
ELSE LWRAD1A.186
C ! Overall, LWOUT(,1) = AICE * ( LWOUT(,1) + (1.-AICE)*LWSEA ) LWRAD1A.187
LWSEA(J) = (1.-AICE(J)) * ( LWOUT(J,1) - AICE(J)*LWSEA(J) ) LWRAD1A.188
LWOUT(J,1) = LWOUT(J,1) - LWSEA(J) LWRAD1A.189
ENDIF LWRAD1A.190
35 CONTINUE LWRAD1A.191
C LWRAD1A.192
CL Section 5 - CALL LWDCSF to calculate clear-sky fraction LWRAD1A.193
CL --------- and put away total cloud amount if requested LWRAD1A.194
C LWRAD1A.195
IF ( TCAON ) THEN LWRAD1A.196
IF ( NCLDS .GT. 0 ) THEN LWRAD1A.197
CALL LWDCSF (LCA, CCA, CCB, CCT, NCLDS, L1, L2, TCADIA) LWRAD1A.198
DO J=1, L2 LWRAD1A.199
TCADIA(J) = 1. - TCADIA(J) LWRAD1A.200
ENDDO LWRAD1A.201
ELSE LWRAD1A.202
DO J=1, L2 LWRAD1A.203
TCADIA(J) = 0. LWRAD1A.204
ENDDO LWRAD1A.205
ENDIF LWRAD1A.206
ENDIF LWRAD1A.207
C LWRAD1A.208
RETURN LWRAD1A.209
END LWRAD1A.210
*ENDIF A02_1A,OR,A02_1B LWRAD1A.211