*IF DEF,CONTROL,AND,DEF,ATMOS READLSA1.2
C ******************************COPYRIGHT****************************** GTS2F400.8083
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8084
C GTS2F400.8085
C Use, duplication or disclosure of this code is subject to the GTS2F400.8086
C restrictions as set forth in the contract. GTS2F400.8087
C GTS2F400.8088
C Meteorological Office GTS2F400.8089
C London Road GTS2F400.8090
C BRACKNELL GTS2F400.8091
C Berkshire UK GTS2F400.8092
C RG12 2SZ GTS2F400.8093
C GTS2F400.8094
C If no contract has been raised with this copy of the code, the use, GTS2F400.8095
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8096
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8097
C Modelling at the above address. GTS2F400.8098
C ******************************COPYRIGHT****************************** GTS2F400.8099
C GTS2F400.8100
CLL Subroutine READLSTA READLSA1.3
CLL READLSA1.4
CLL Purpose: Reads control information from NAMELIST, and READLSA1.5
CLL copies into dump header/history file for reference. READLSA1.6
CLL READLSA1.7
CLL Control routine for Cray YMP READLSA1.8
CLL READLSA1.9
CLL Model Modification history from model version 3.0: READLSA1.10
CLL version Date READLSA1.11
CLL 3.1 18/01/93 Add *call comdeck CTHETAPV and add extra variable MM180193.58
CLL to runcnst namelist. MM180193.59
CLL 3.2 27/03/93 Dynamic allocation of main data arrays. R. Rawlins @DYALLOC.3134
CLL 3.3 13/12/93 Variables WIND_LIMIT and DIV_LIMIT AL131293.29
CLL added to namelist RUNCNST for half AL131293.30
CLL timestep dynamics. A.S.Lawless AL131293.31
CLL 3.4 09/09/94 Add 3 constants (ALPHAC,ALPHAM,DTICE) to AWA1F304.1384
CLL namelist RUNCNST. C D Hewitt AWA1F304.1385
CLL 3.4 03/10/94 Add 4 constants (N2OMMR,CH4MMR,C11MMR,C12MMR) to AWA1F304.1386
CLL namelist RUNCNST. S Woodward AWA1F304.1387
CLL 3.5 27/03/95 Sub-model changes : Remove run time constants ADR1F305.131
CLL from Atmos dump headers. Some variables in ADR1F305.132
CLL RUNCNST namelist renamed. All RUNCNST namelist ADR1F305.133
CLL variables initialised to IMDI/RMDI. Remove ADR1F305.134
CLL A_ILEVDEPC from argument list. D. Robinson ADR1F305.135
CLL 3.5 11/04/95 Sub-Models stage 1: revised History/control files GRB1F305.454
CLL contents. Add atmos. control variables. RTHBarnes. GRB1F305.455
CLL 4.0 17/08/95 Add pressure_altitude to runtime consts. RTHBarnes. ARB0F400.85
! 4.0 05/07/95 Extra Namelists for version 3A of the SW and LW ADB1F400.363
! radiation schemes added. J. M. Edwards ADB1F400.364
CLL 4.0 04/07/95 Remove SNOW_MASKING_FACTOR. W Ingram AWI2F400.9
CLL 4.1 12/03/96 Add SO2_HIGH_LEVEL. D. Robinson. GDR1F401.125
CLL 4.3 18/3/97 Add CLMCHFCG namelist, to specify time variation AWI1F403.11
CLL of climate change forcings, & remove old CO2 variables. AWI1F403.12
CLL 4.3 07/03/97 Add KAY_LEE_GWAVE S.Webster ASW1F403.16
CLL 4.4 26/09/97 Add ANVIL_FACTOR and TOWER_FACTOR for calculation AJX0F404.431
CLL of convective cloud amount and MPARWTR parameter AJX0F404.432
CLL used in CLOUDW in convection 3A & 3B. J.M.Gregory. AJX0F404.433
CLL 4.4 14/10/97 Add PHENOL_PERIOD and TRIFFID_PERIOD. R Betts ABX1F404.271
!LL 4.4 19/09/97 O2MMR added to namelist ADB2F404.1042
!LL Decks of radiative options split. J. M. Edwards ADB2F404.1043
!LL 4.5 24/02/98 Mixing ratios of additional (H)(C)FCs added: ADB1F405.546
!LL additional logical for new partitioning of ADB1F405.547
!LL convective cloud included. ADB1F405.548
!LL J. M. Edwards ADB1F405.549
! 4.5 07/07/98 Add SOOT_HIGH_LEVEL M Woodage ADB1F405.550
CLL 4.5 21.08.98 New RUNCNST ALPHAB for RAD_COM. Jonathan Gregory AJG1F405.17
CLL 4.4 23.11.98 Move PHENOL_PERIOD and TRIFFID_PERIOD to namelist AJG1F405.18
CCL NLSTCATM in comdeck CNTLATM. Richard Betts AJG1F405.19
CLL READLSA1.12
CLL Programming Standard : UM documentation paper no. 3 READLSA1.13
CLL READLSA1.15
CLL System components covered : C26 (part) READLSA1.16
CLL READLSA1.17
CLL System task : C0 READLSA1.18
CLL READLSA1.19
CLL Documentation : Unified Model Documentation Paper no. C0. READLSA1.20
CLL READLSA1.21
CLLEND---------------------------------------------------------------- READLSA1.22
SUBROUTINE READLSTA( 1,1@DYALLOC.3135
*CALL ARGSIZE 
@DYALLOC.3136
*CALL ARGDUMA @DYALLOC.3137
*CALL ARGPTRA @DYALLOC.3140
*CALL ARGCONA @DYALLOC.3141
& ICODE,CMESSAGE) @DYALLOC.3142
READLSA1.24
IMPLICIT NONE READLSA1.25
READLSA1.26
C*L Arguments @DYALLOC.3143
CL @DYALLOC.3144
*CALL CMAXSIZE @DYALLOC.3145
*CALL TYPSIZE @DYALLOC.3146
*CALL TYPDUMA @DYALLOC.3147
*CALL TYPPTRA @DYALLOC.3150
*CALL TYPCONA @DYALLOC.3151
INTEGER @DYALLOC.3152
& ICODE ! OUT: Error return code @DYALLOC.3153
C @DYALLOC.3154
CHARACTER*256 @DYALLOC.3155
& CMESSAGE ! OUT: Error return message @DYALLOC.3156
C @DYALLOC.3157
*CALL CSUBMODL GRB1F305.456
*CALL CHSUNITS GRB1F305.457
*CALL CCONTROL GRB1F305.458
*CALL CRUNTIMC ADR1F305.136
*CALL CPPRINT READLSA1.30
*CALL RAD_COM AWA1F304.1388
*CALL CZONPRIT @DYALLOC.3158
*CALL C_MDI ADR1F305.137
*CALL C_PI ADR1F305.138
*CALL SWOPT3A ADB1F400.365
*CALL LWOPT3A ADB1F400.366
*CALL SWCOPT3A ADB2F404.1044
*CALL LWCOPT3A ADB2F404.1045
*CALL CTLNL3A ADB1F400.367
*CALL CSENARIO AWI1F403.13
READLSA1.34
LOGICAL AWI1F403.14
& L_CLMCHFCG ! Local variable, read from RUNCNSTS to AWI1F403.15
C ! see if CLMCHFCG must also be read. AWI1F403.16
NAMELIST /RUNCNST/ ADR1F305.139
& LATITUDE_BAND, VERTICAL_DIFFUSION, L_CLMCHFCG, AWI1F403.17
& CO2_MMR, GRAV_WAVE_SPEED, KAY_GWAVE, KAY_LEE_GWAVE, AWI1F403.18
& NU_BASIC, FILTERING_SAFETY_FACTOR, START_LEVEL_GWDRAG, ADR1F305.142
& BOTTOM_VDIF_LEVEL, TOP_VDIF_LEVEL, TRAC_ADV_ LEVELS, ADR1F305.143
& DIFF_COEFF, DIFF_COEFF_Q, DIFF_EXP, DIFF_EXP_Q, RHCRIT, ADR1F305.144
& DIV_DAMP_COEFF_ASSM, DIV_DAMP_COEFF_FC, PRESSURE_ALTITUDE, ARB0F400.86
& ALPHAM, ALPHAC, ALPHAB, DTICE, AJG1F405.20
& N2OMMR, CH4MMR, C11MMR, C12MMR, AJG1F405.21
& O2MMR, C113MMR, HCFC22MMR, HFC125MMR, HFC134AMMR, ADB1F405.551
& ETA_SPLIT, CW_SEA, CW_LAND, REQ_THETA_PV_LEVS, ADR1F305.147
& ADJ_TIME_SMOOTHING_WEIGHT, ADJ_TIME_SMOOTHING_COEFF, ADR1F305.148
& WIND_LIMIT, DIV_LIMIT, SOOT_HIGH_LEVEL, SO2_HIGH_LEVEL AWO0F405.94
& ,ANVIL_FACTOR, TOWER_FACTOR, MPARWTR, UD_FACTOR AJX3F405.151
READLSA1.80
NAMELIST/PPRINTXN/ READLSA1.81
& LPRVXN,LPRVXNP,LPPRINT,LPPRINT_A,LPPRINT_S,LVPRINT, READLSA1.82
& LHPRINT,PPRINT_STEP,PPRINT_POINT,PPRINT_TOL, READLSA1.83
& PPRINT_FIRST,PPRINT_LAST, READLSA1.84
& PRVXN_FIRST,PRVXN_LAST,PRVXN_LEVEL, READLSA1.85
& PRVXN_STEP,LMOISTP, READLSA1.86
& LPRFLD,PRFLD_STEP,PRFLD_FIRST,PRFLD_LAST READLSA1.87
READLSA1.88
NAMELIST/ZONPCTL/ READLSA1.89
& IPRTWIND,IPRTTEMP,IPRTQ,IPRTKE,IPRTVAR,IPRTEXTRA READLSA1.90
READLSA1.91
NAMELIST / CLMCHFCG / CLIM_FCG_NYEARS, CLIM_FCG_YEARS, AWI1F403.19
& CLIM_FCG_LEVLS, CLIM_FCG_RATES AWI1F403.20
READLSA1.93
C* Local variable @DYALLOC.3191
INTEGER READLSA1.95
& LEVEL READLSA1.96
& ,J ADR1F305.150
& ,JJ AWI1F403.21
READLSA1.97
CL Read of atmosphere control data into COMMON/CNTLCATM/ GRB1F305.459
CL done in READCNTL GRB1F305.460
!! READ(5,NLSTCATM) GRB1F305.461
GRB1F305.462
CL Set assimilation logicals from character variable. GRB1F305.463
L_3DVAR_BG = A_ASSIM_MODE .EQ. "BG" GRB1F305.464
L_AC = A_ASSIM_MODE .EQ. "AC" GRB1F305.465
L_3DVAR = A_ASSIM_MODE .EQ. "3DVAR" GRB1F305.466
L_4DVAR = A_ASSIM_MODE .EQ. "4DVAR" GRB1F305.467
GRB1F305.468
! Set H_SECT to values found in ATMOS_SR in COMDECK MODEL GRB1F305.469
! Needs tidied at a later version to be done in a less messy way. GRB1F305.470
CALL SET_H_SECT(H_SECT,MAXSECTS) GRB1F305.471
GRB1F305.472
CL Read atmosphere run consts. control data into COMMON/RUNCNST/(F011) GRB1F305.473
READLSA1.99
CL Initialise variables in RUNCNST Namelist ADR1F305.151
READLSA1.101
L_CLMCHFCG = .FALSE. AWI1F403.22
C In common block CRUNTIMA ADR1F305.152
START_LEVEL_GWDRAG = IMDI ADR1F305.153
BOTTOM_VDIF_LEVEL = IMDI ADR1F305.154
TOP_VDIF_LEVEL = IMDI ADR1F305.155
TRAC_ADV_LEVELS = IMDI ADR1F305.156
SOOT_HIGH_LEVEL = IMDI AWO0F405.95
SO2_HIGH_LEVEL = IMDI GDR1F401.127
LATITUDE_BAND = RMDI ADR1F305.157
VERTICAL_DIFFUSION = RMDI ADR1F305.158
CO2_MMR = RMDI AWI1F403.23
GRAV_WAVE_SPEED = RMDI ADR1F305.163
FILTERING_SAFETY_FACTOR = RMDI ADR1F305.164
WIND_LIMIT = RMDI ADR1F305.165
DIV_LIMIT = RMDI ADR1F305.166
KAY_GWAVE = RMDI ADR1F305.167
KAY_LEE_GWAVE = RMDI ASW1F403.17
NU_BASIC = RMDI ADR1F305.168
CW_SEA = RMDI ADR1F305.169
CW_LAND = RMDI ADR1F305.170
PRESSURE_ALTITUDE = 200000.0 ! Pascal, to default diffusion to ARB0F400.87
! standard treatment if pressure_altitude not present in namelist ARB0F400.88
ANVIL_FACTOR = RMDI AJX0F404.435
TOWER_FACTOR = RMDI AJX0F404.436
MPARWTR = RMDI AJX0F404.437
UD_FACTOR = RMDI AJX3F405.152
DO LEVEL=1,MAX_P_LEVELS ADR1F305.171
DIFF_COEFF (LEVEL) = RMDI ADR1F305.172
DIFF_COEFF_Q(LEVEL) = RMDI ADR1F305.173
DIFF_EXP (LEVEL) = IMDI ADR1F305.174
DIFF_EXP_Q (LEVEL) = IMDI ADR1F305.175
DIV_DAMP_COEFF_ASSM(LEVEL) = RMDI ADR1F305.176
DIV_DAMP_COEFF_FC (LEVEL) = RMDI ADR1F305.177
RHCRIT(LEVEL) = RMDI ADR1F305.178
ENDDO ADR1F305.179
READLSA1.103
C In common block RAD_COM ADR1F305.180
ALPHAC = RMDI ADR1F305.181
ALPHAM = RMDI ADR1F305.182
DTICE = RMDI ADR1F305.183
N2OMMR = RMDI ADR1F305.184
CH4MMR = RMDI ADR1F305.185
C11MMR = RMDI ADR1F305.186
C12MMR = RMDI ADR1F305.187
O2MMR = RMDI ADB1F405.552
C113MMR = RMDI ADB1F405.553
HCFC22MMR = RMDI ADB1F405.554
HFC125MMR = RMDI ADB1F405.555
HFC134AMMR = RMDI ADB1F405.556
ADB1F405.557
C In common block LWOPT3A ADB1F405.558
L_LOCAL_CNV_PARTITION_LW = .FALSE. ADB1F405.559
ADB1F405.560
C In common block SWOPT3A ADB1F405.561
L_LOCAL_CNV_PARTITION_SW = .FALSE. ADB1F405.562
READLSA1.120
C In common block CDERIVED (in comdeck CCONSTS called in TYPCONA) ADR1F305.188
ADJ_TIME_SMOOTHING_COEFF = RMDI ADR1F305.189
DO J = 1,MAX_ADJ_TSL ADR1F305.190
ADJ_TIME_SMOOTHING_WEIGHT(J) = IMDI ADR1F305.191
ENDDO ADR1F305.192
DO J = 1,NUM_CLOUD_TYPES+1 ADR1F305.193
ETA_SPLIT(J) = RMDI ADR1F305.194
ENDDO ADR1F305.195
DO J = 1,MAX_REQ_THPV_LEVS ADR1F305.196
REQ_THETA_PV_LEVS(J) = RMDI ADR1F305.197
ENDDO ADR1F305.198
READLSA1.130
CL Read in RUNCNST Namelist ADR1F305.199
ADR1F305.200
READ (5,RUNCNST) ADR1F305.202
WRITE(6,RUNCNST) ADR1F305.203
ADR1F305.204
C Convert from degrees to radians ADR1F305.205
LATITUDE_BAND = LATITUDE_BAND * PI_OVER_180 ADR1F305.206
MM180193.62
CL Multiply input req_theta_pv_levs by 100. to convert mb to pascals. MM180193.63
DO LEVEL = 1,THETA_PV_P_LEVS MM180193.64
REQ_THETA_PV_LEVS(LEVEL) = REQ_THETA_PV_LEVS(LEVEL)*100. MM180193.65
END DO MM180193.66
READLSA1.131
CL Read atmosphere patch print and min/max controls into COMMON/CPPRINT/ READLSA1.132
READLSA1.133
READ(5,PPRINTXN) READLSA1.134
READLSA1.135
READLSA1.136
CL Read atmosphere zonal mean print controls READLSA1.138
READLSA1.139
READ(5,ZONPCTL) READLSA1.140
! ADB1F400.368
! ADB1F400.369
! Read controlling information for version 3A of the SW or LW ADB1F400.370
! radiation schemes. ADB1F400.371
! ADB1F400.372
IF (H_SECT(1).EQ.'03A') THEN ADB1F400.373
! Options for the shortwave ADB1F400.374
READ(5, R2SWCLNL) ADB1F400.375
ENDIF ADB1F400.376
! ADB1F400.377
IF (H_SECT(2).EQ.'03A') THEN ADB1F400.378
! Options for the longwave ADB1F400.379
READ(5, R2LWCLNL) ADB1F400.380
ENDIF ADB1F400.381
AWI1F403.24
IF ( L_CLMCHFCG ) THEN AWI1F403.25
READ (5, CLMCHFCG) AWI1F403.26
! Convert rates from percent to multiplicative factors: AWI1F403.27
DO J=1, NCLMFCGS AWI1F403.28
! ! This is a null loop, as it should be, if CLIM_FCG_NYEARS=0 AWI1F403.29
DO JJ=1, CLIM_FCG_NYEARS(J) AWI1F403.30
IF ( CLIM_FCG_RATES(JJ,J) .GT. -100. ) AWI1F403.31
& CLIM_FCG_RATES(JJ,J) = 1. + 0.01 * CLIM_FCG_RATES(JJ,J) AWI1F403.32
ENDDO AWI1F403.33
ENDDO AWI1F403.34
ELSE AWI1F403.35
! ! If the namelist is not to be read, set number of designated AWI1F403.36
! ! years to zero for all possible forcings, as this may be AWI1F403.37
! ! used to test if this system is being used for each forcing. AWI1F403.38
DO J=1, NCLMFCGS AWI1F403.39
CLIM_FCG_NYEARS(J) = 0 AWI1F403.40
ENDDO AWI1F403.41
ENDIF AWI1F403.42
READLSA1.143
READLSA1.144
RETURN READLSA1.145
END READLSA1.146
READLSA1.147
SUBROUTINE SET_H_SECT(H_SECT,MAXSECTS) 1GRB1F305.474
! Temporary routine introduced at vn3.5 to set H_SECT in COMDECK GRB1F305.475
! CCONTROL to values in ATMOS_SR in COMDECK MODEL. GRB1F305.476
! Necessary bc. CCONTROL & MODEL contain some variable names the same GRB1F305.477
! - this needs tidied at a future version. GRB1F305.478
IMPLICIT NONE GRB1F305.479
INTEGER MAXSECTS GRB1F305.480
CHARACTER*3 H_SECT(0:MAXSECTS) GRB1F305.481
*CALL CSUBMODL GRB1F305.482
*CALL VERSION GRB1F305.483
*CALL MODEL GRB1F305.484
! Local variables GRB1F305.485
INTEGER I ! loop variable GRB1F305.486
GRB1F305.487
DO I = 0,NSECTP GRB1F305.488
H_SECT(I)(1:1) = '0' GRB1F305.489
H_SECT(I)(2:3) = ATMOS_SR(I) GRB1F305.490
END DO GRB1F305.491
GRB1F305.492
RETURN GRB1F305.493
END GRB1F305.494
*ENDIF READLSA1.148