SUBROUTINE R2_SW_SPECIN(IERR, CMESSAGE 2,2ADB2F404.1061
& , L_O2 ADB1F405.615
& , L_CLIMAT_AEROSOL, L_USE_SULPC_DIRECT ADB2F404.1062
& , L_USE_SOOT_DIRECT ALR3F405.132
& ) ADB2F404.1063
! SPIN3A.24
! SPIN3A.25
IMPLICIT NONE ADB1F405.616
! ADB1F405.617
! ADB1F405.618
*CALL MXSIZE3A 
SPIN3A.26
*CALL ERROR3A ADB1F405.619
*CALL STDIO3A ADB1F405.620
! SPIN3A.27
! SPIN3A.28
! DUMMY ARGUMENTS SPIN3A.29
LOGICAL !, INTENT(IN) ADB2F404.1064
& L_O2 ADB1F405.621
! ABSORPTION BY OXYGEN IS TO BE INCLUDED. ADB1F405.622
& , L_CLIMAT_AEROSOL ADB1F405.623
! CLIMATOLOGICAL AEROSOLS ARE TO BE INCLUDED ADB2F404.1066
& , L_USE_SULPC_DIRECT ADB2F404.1067
! THE DIRECT EFFECTS OF SULPHATE AEROSOLS ARE ADB2F404.1068
! TO BE INCLUDED ADB2F404.1069
& , L_USE_SOOT_DIRECT ALR3F405.133
! USE THE DIRECT RAD EFFECTS OF SOOT IN THE SW ALR3F405.134
! SPIN3A.33
INTEGER !, INTENT(OUT) SPIN3A.34
& IERR SPIN3A.35
! ERROR FLAG SPIN3A.36
CHARACTER*80 !, INTENT(OUT) SPIN3A.37
& CMESSAGE SPIN3A.38
! SPIN3A.39
! SPIN3A.43
! SPIN3A.44
! LOCAL VARIABLES. SPIN3A.46
! SPIN3A.47
! ADB1F405.624
! RADIATIVE VARIABLES FOR REDUCING THE SPECTRUM ADB1F405.625
! ADB1F405.626
*CALL AERPRM3A ADB1F405.627
*CALL AERCMP3A ADB1F405.628
*CALL GASID3A ADB1F405.629
! ADB1F405.630
CHARACTER*80 SPIN3A.48
& SW_SPECTRAL_FILE SPIN3A.49
! NAME OF FILE CONTAINING THE SPECTRAL DATA SPIN3A.50
INTEGER SPIN3A.51
& IERR_GET_FILE SPIN3A.52
! ERROR FLAG RETURNED BY GET_FILE (NOT NECESSARILY SPIN3A.53
! CONSISTENT WITH THE FLAGS IN ERROR3A). SPIN3A.54
& , IOS SPIN3A.55
! STATUS OF I/O SPIN3A.56
! SPIN3A.57
LOGICAL ADB1F405.631
& L_RETAIN_ABSORB(NPD_SPECIES) ADB1F405.632
! FLAG SET TO .TRUE. IF THE ABSORBER IS TO BE RETAINED ADB1F405.633
& , L_GAS_INCLUDED(NPD_GASES) ADB1F405.634
! LOGICAL TO TEST FOR ACTUAL GASES INCLUDED ADB1F405.635
INTEGER ADB2F404.1070
& N_ABSORB_RETAIN ADB1F405.636
! NUMBER OF ABSORBERS TO RETAIN ADB1F405.637
& , INDEX_ABSORB_RETAIN(NPD_SPECIES) ADB1F405.638
! INDICES OF ABSORBERS TO BE RETAINED ADB1F405.639
& , COMPRESSED_INDEX(NPD_SPECIES) ADB1F405.640
! MAPPING FROM ORIGINAL TO COMPRESSED INDICES OF ABSORBERS ADB1F405.641
& , N_AEROSOL_RETAIN ADB1F405.642
! NUMBER OF AEROSOLS IN THE SPECTRAL FILE TO BE RETAINED ADB2F404.1072
! FOR THE RADIATIVE CALCULATION ADB2F404.1073
& , INDEX_AEROSOL_RETAIN(NPD_AEROSOL_SPECIES) ADB2F404.1074
! INDEXING NUMBERS OF THE RETAINED AEROSOLS ADB2F404.1075
& , N_AEROSOL_FOUND ADB2F404.1076
! NUMBER OF AEROSOLS FOR THE CURRENT GROUP OF PROCESSES ADB2F404.1077
! FOUND IN THE SPECTRAL FILE ADB2F404.1078
! SPIN3A.58
! ADB2F404.1079
! ADB2F404.1080
! DECLARE THE ELEMENTS OF THE INITIAL SPECTRUM FOR DYNAMIC ADB2F404.1081
! ALLOCATION AND SET UP AN APPROPRIATE NAMELIST. ADB2F404.1082
! ADB2F404.1083
*CALL SPDEC3A SPIN3A.61
*CALL SWSP3A SPIN3A.62
! ADB2F404.1084
! ADB2F404.1085
! DECLARE THE REDUCED SW SPECTRAL FILE AND ITS HOLDING COMMON BLOCK. ADB2F404.1086
! ADB2F404.1087
*CALL SWSPDL3A ADB2F404.1088
*CALL SWSPCM3A ADB2F404.1089
! ADB2F404.1090
! ADB2F404.1091
! ADB1F405.643
INTEGER SPIN3A.106
& I SPIN3A.107
! LOOP VARIABLE SPIN3A.108
& , J SPIN3A.109
! LOOP VARIABLE SPIN3A.110
! ADB2F404.1096
CHARACTER ADB2F404.1097
& CH_IOS*5 ADB2F404.1098
! CHARACTER STRING FOR IOS ERROR ADB2F404.1099
! SPIN3A.111
! SPIN3A.112
! SUBROUTINES CALLED SPIN3A.113
EXTERNAL SPIN3A.114
& R2_COMPRESS_SPECTRUM SPIN3A.115
! SPIN3A.116
! SPIN3A.117
! EACH BLOCK IS INITIALIZED AS MISSING: SPIN3A.118
DATA L_PRESENT/.FALSE., NPD_TYPE*.FALSE./ SPIN3A.119
! ADB2F404.1100
! INITIALIZE THE RANGE OF VALIDITY OF THE PARAMETRIZATIONS OF ADB2F404.1101
! DROPLETS AND ICE CRYSTALS. OLD SPECTRAL FILES WILL NOT CONTAIN ADB2F404.1102
! SUCH DATA, SO THE LIMITS FOR DROPLETS ARE INITIALIZED TO THOSE ADB2F404.1103
! FORMERLY SET IN THE MICROPHYSICAL SCHEME (MRF/UMIST ADB2F404.1104
! PARAMETRIZATION) TO ENSURE THAT THE RESULTS ARE BIT-REPRODUCIBLE. ADB2F404.1105
! VALUES FOR ICE COVER THE RANGE OF EFFECTIVE RADII USED IN ADB2F404.1106
! GENERATING THE DATA FOR THE ORIGINAL PARAMETRIZATION OF ICE ADB2F404.1107
! CRYSTALS. ADB2F404.1108
! AT SOME FUTURE RELEASE IT MAY BE DESIRABLE TO REMOVE DEFAULT ADB2F404.1109
! SETTINGS. ADB2F404.1110
DATA DROP_PARM_MIN_DIM/NPD_DROP_TYPE*3.5E-07/ ADB2F404.1111
DATA DROP_PARM_MAX_DIM/NPD_DROP_TYPE*3.7E-05/ ADB2F404.1112
DATA ICE_PARM_MIN_DIM/NPD_ICE_TYPE*3.75E-07/ ADB2F404.1113
DATA ICE_PARM_MAX_DIM/NPD_ICE_TYPE*8.0E-05/ ADB2F404.1114
! SPIN3A.120
! SPIN3A.121
! SPIN3A.122
! READ THE SHORTWAVE SPECTRUM AS A NAMELIST. SPIN3A.123
CALL GET_FILE(57, SW_SPECTRAL_FILE, 80, IERR_GET_FILE) SPIN3A.124
IF (IERR_GET_FILE.NE.0) THEN SPIN3A.125
! CONVERT THE ERROR FLAG FROM GET_FILE TO A FLAG RECOGNISED SPIN3A.126
! BY THE RADIATION CODE. SPIN3A.127
IERR=I_ERR_IO SPIN3A.128
CMESSAGE='Error reading name of shortwave spectral file.' SPIN3A.129
RETURN SPIN3A.130
ENDIF SPIN3A.131
OPEN(UNIT=57, FILE=SW_SPECTRAL_FILE, IOSTAT=IOS, PXNAMLST.15
& DELIM='APOSTROPHE') PXNAMLST.16
IF (IOS.NE.0) THEN SPIN3A.133
IERR=I_ERR_IO SPIN3A.134
WRITE(CH_IOS, '(I5)') IOS ADB2F404.1115
CMESSAGE='Error opening shortwave spectral file.' ADB1F401.948
& //' IOSTAT='//CH_IOS ADB2F404.1116
RETURN SPIN3A.136
ENDIF SPIN3A.137
READ(57, R2SWSP) SPIN3A.138
CLOSE(57) SPIN3A.139
! SPIN3A.140
! TEST FOR MINIMAL REQUISITE INFORMATION. SPIN3A.141
IF ( .NOT.(L_PRESENT(0).AND. SPIN3A.142
& L_PRESENT(2) ) ) THEN SPIN3A.143
CMESSAGE='Shortwave spectrum is deficient.' SPIN3A.144
IERR=I_ERR_FATAL SPIN3A.145
RETURN SPIN3A.146
ENDIF SPIN3A.147
! SPIN3A.148
! SPIN3A.149
! SPIN3A.150
! SET REDUCED DIMENSIONS, EITHER FROM THE SIZES OF THE FIXED ARRAYS SPIN3A.151
! OR FROM THE ARRAYS READ IN. SPIN3A.152
! SPIN3A.153
NPD_TYPE_SW=NPD_TYPE ADB2F404.1117
NPD_BAND_SW=MAX(N_BAND, 1) ADB2F404.1118
NPD_SPECIES_SW=MAX(N_ABSORB, 1) ADB2F404.1119
NPD_ALBEDO_PARM_SW=NPD_ALBEDO_PARM ADB2F404.1120
NPD_SCALE_FNC_SW=NPD_SCALE_FNC ADB2F404.1121
NPD_SCALE_VARIABLE_SW=NPD_SCALE_VARIABLE ADB2F404.1122
NPD_SURFACE_SW=NPD_SURFACE ADB2F404.1123
NPD_CONTINUUM_SW=NPD_CONTINUUM ADB2F404.1124
NPD_CLOUD_PARAMETER_SW=NPD_CLOUD_PARAMETER ADB2F404.1125
NPD_THERMAL_COEFF_SW=1 ADB2F404.1126
! SPIN3A.165
! SPIN3A.166
! SEARCH THE SPECTRUM TO FIND MAXIMUM DIMENSIONS. SPIN3A.167
! SPIN3A.168
NPD_EXCLUDE_SW=1 ADB2F404.1127
IF (L_PRESENT(14)) THEN SPIN3A.170
DO I=1, N_BAND SPIN3A.171
NPD_EXCLUDE_SW=MAX(NPD_EXCLUDE_SW, N_BAND_EXCLUDE(I)) ADB2F404.1128
ENDDO SPIN3A.173
ENDIF SPIN3A.174
! SPIN3A.175
! Search the spectrum to find those gases to be retained. ADB1F405.644
! Water vapour, carbon dioxide and ozone are included ADB1F405.645
! if present, but a warning is printed if they are ADB1F405.646
! not included. ADB1F405.647
DO I=1, NPD_GASES ADB1F405.648
L_GAS_INCLUDED(I)=.FALSE. ADB1F405.649
ENDDO ADB1F405.650
N_ABSORB_RETAIN=0 ADB1F405.651
! ADB1F405.652
DO I=1, N_ABSORB ADB1F405.653
! ADB1F405.654
L_RETAIN_ABSORB(I)=.FALSE. ADB1F405.655
COMPRESSED_INDEX(I)=0 ADB1F405.656
! ADB1F405.657
IF ( (TYPE_ABSORB(I).EQ.IP_H2O).OR. ADB1F405.658
& (TYPE_ABSORB(I).EQ.IP_CO2).OR. ADB1F405.659
& (TYPE_ABSORB(I).EQ.IP_O3).OR. ADB1F405.660
& ( (TYPE_ABSORB(I).EQ.IP_O2).AND.L_O2 ) ) THEN ADB1F405.661
N_ABSORB_RETAIN=N_ABSORB_RETAIN+1 ADB1F405.662
INDEX_ABSORB_RETAIN(N_ABSORB_RETAIN)=I ADB1F405.663
COMPRESSED_INDEX(I)=N_ABSORB_RETAIN ADB1F405.664
L_RETAIN_ABSORB(I)=.TRUE. ADB1F405.665
L_GAS_INCLUDED(TYPE_ABSORB(I))=.TRUE. ADB1F405.666
ENDIF ADB1F405.667
! ADB1F405.668
ENDDO ADB1F405.669
! ADB1F405.670
! ADB1F405.671
! Print warning messages if those gases normally expected ADB1F405.672
! are not present. ADB1F405.673
IF (.NOT.L_GAS_INCLUDED(IP_H2O)) THEN ADB1F405.674
WRITE(IU_ERR, '(/A, /A)') ADB1F405.675
& '*** WARNING: Water vapour is not included in the ' ADB1F405.676
& , 'shortwave spectral file.' ADB1F405.677
ENDIF ADB1F405.678
! ADB1F405.679
IF (.NOT.L_GAS_INCLUDED(IP_CO2)) THEN ADB1F405.680
WRITE(IU_ERR, '(/A, /A)') ADB1F405.681
& '*** WARNING: Carbon dioxide is not included in the ' ADB1F405.682
& , 'shortwave spectral file.' ADB1F405.683
ENDIF ADB1F405.684
! ADB1F405.685
IF (.NOT.L_GAS_INCLUDED(IP_O3)) THEN ADB1F405.686
WRITE(IU_ERR, '(/A, /A)') ADB1F405.687
& '*** WARNING: Ozone is not included in the ' ADB1F405.688
& , 'shortwave spectral file.' ADB1F405.689
ENDIF ADB1F405.690
! ADB1F405.691
IF ((.NOT.L_GAS_INCLUDED(IP_O2)).AND.L_O2) THEN ADB1F405.692
WRITE(IU_ERR, '(/A, /A)') ADB1F405.693
& '*** ERROR: Oxygen is not included in the shortwave ' ADB1F405.694
& , 'spectral file, but was requested in the run.' ADB1F405.695
IERR=I_ERR_FATAL ADB1F405.696
RETURN ADB1F405.697
ENDIF ADB1F405.698
! ADB1F405.699
! Set an appropriate reduced dimension. ADB1F405.700
NPD_SPECIES_SW=MAX(N_ABSORB_RETAIN, 1) ADB1F405.701
! ADB1F405.702
! ADB1F405.703
NPD_ESFT_TERM_SW=1 ADB2F404.1129
IF (L_PRESENT(5)) THEN SPIN3A.177
DO I=1, N_BAND SPIN3A.178
DO J=1, N_BAND_ABSORB(I) SPIN3A.179
IF (L_RETAIN_ABSORB(INDEX_ABSORB(J, I))) ADB1F405.704
& NPD_ESFT_TERM_SW=MAX(NPD_ESFT_TERM_SW ADB1F405.705
& , I_BAND_ESFT(I, INDEX_ABSORB(J, I))) SPIN3A.181
ENDDO SPIN3A.182
ENDDO SPIN3A.183
ENDIF SPIN3A.184
! SPIN3A.185
NPD_DROP_TYPE_SW=1 ADB2F404.1131
IF (L_PRESENT(10)) THEN SPIN3A.187
DO I=1, NPD_DROP_TYPE SPIN3A.188
IF (L_DROP_TYPE(I)) THEN SPIN3A.189
NPD_DROP_TYPE_SW=MAX(NPD_DROP_TYPE_SW, I) ADB2F404.1132
ENDIF SPIN3A.191
ENDDO SPIN3A.192
ENDIF SPIN3A.193
! SPIN3A.194
NPD_ICE_TYPE_SW=1 ADB2F404.1133
IF (L_PRESENT(12)) THEN SPIN3A.196
DO I=1, NPD_ICE_TYPE SPIN3A.197
IF (L_ICE_TYPE(I)) THEN SPIN3A.198
NPD_ICE_TYPE_SW=MAX(NPD_ICE_TYPE_SW, I) ADB2F404.1134
ENDIF SPIN3A.200
ENDDO SPIN3A.201
ENDIF SPIN3A.202
! SPIN3A.203
! ADB2F404.1135
! Aerosols must be treated carefully to allow for various ADB2F404.1136
! different combinations without requiring the spectral file ADB2F404.1137
! to be too constrained. Only those required will be retained. ADB2F404.1138
! ADB2F404.1139
! Basic initialization to safe values. ADB2F404.1140
NPD_HUMIDITIES_SW=1 ADB2F404.1141
N_AEROSOL_RETAIN=0 ADB2F404.1142
! ADB2F404.1143
! Check the spectral file for climatological aerosols ADB2F404.1144
IF (L_CLIMAT_AEROSOL) THEN ADB2F404.1145
! ADB2F404.1146
IF (L_PRESENT(11)) THEN ADB2F404.1147
! ADB2F404.1148
! Search for the aerosols required for this scheme. ADB2F404.1149
N_AEROSOL_FOUND=0 ADB2F404.1150
DO I=1, N_AEROSOL ADB2F404.1151
! ADB2F404.1152
IF ( (TYPE_AEROSOL(I).EQ.IP_WATER_SOLUBLE).OR. ADB2F404.1153
& (TYPE_AEROSOL(I).EQ.IP_DUST_LIKE).OR. ADB2F404.1154
& (TYPE_AEROSOL(I).EQ.IP_OCEANIC).OR. ADB2F404.1155
& (TYPE_AEROSOL(I).EQ.IP_SOOT).OR. ADB2F404.1156
& (TYPE_AEROSOL(I).EQ.IP_SULPHURIC) ) THEN ADB2F404.1157
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ADB2F404.1158
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ADB2F404.1159
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ADB2F404.1160
ENDIF ADB2F404.1161
ADB2F404.1162
ENDDO ADB2F404.1163
! ADB2F404.1164
IF (N_AEROSOL_FOUND.NE.5) THEN ADB2F404.1165
! ADB2F404.1166
IERR=I_ERR_FATAL ADB2F404.1167
CMESSAGE='The SW Spectral file lacks some ' ADB2F404.1168
& //'climatological aerosols.' ADB2F404.1169
RETURN ADB2F404.1170
! ADB2F404.1171
ENDIF ADB2F404.1172
ADB2F404.1173
ELSE ADB2F404.1174
! ADB2F404.1175
IERR=I_ERR_FATAL ADB2F404.1176
CMESSAGE='SW Spectral file contains no aerosol data.' ADB2F404.1177
RETURN ADB2F404.1178
! ADB2F404.1179
ENDIF ADB2F404.1180
! ADB2F404.1181
ENDIF ADB2F404.1182
ADB2F404.1183
! ADB2F404.1184
! Check the spectral file for sulphate aerosols. (These are ADB2F404.1185
! required only for the direct effect). ADB2F404.1186
! ADB2F404.1187
IF (L_USE_SULPC_DIRECT) THEN ADB2F404.1188
! ADB2F404.1189
IF (L_PRESENT(11)) THEN ADB2F404.1190
! ADB2F404.1191
! Search for the aerosols required for this scheme. ADB2F404.1192
N_AEROSOL_FOUND=0 ADB2F404.1193
DO I=1, N_AEROSOL ADB2F404.1194
! ADB2F404.1195
IF ( (TYPE_AEROSOL(I).EQ.IP_ACCUM_SULPHATE).OR. ADB2F404.1196
& (TYPE_AEROSOL(I).EQ.IP_AITKEN_SULPHATE) ) THEN ADB2F404.1197
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ADB2F404.1198
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ADB2F404.1199
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ADB2F404.1200
ENDIF ADB2F404.1201
ADB2F404.1202
ENDDO ADB2F404.1203
! ADB2F404.1204
IF (N_AEROSOL_FOUND.NE.2) THEN ADB2F404.1205
! ADB2F404.1206
IERR=I_ERR_FATAL ADB2F404.1207
CMESSAGE='The SW Spectral file lacks some ' ADB2F404.1208
& //'sulphate aerosols.' ADB2F404.1209
RETURN ADB2F404.1210
! ADB2F404.1211
ENDIF ADB2F404.1212
ADB2F404.1213
ELSE ADB2F404.1214
! ADB2F404.1215
IERR=I_ERR_FATAL ADB2F404.1216
CMESSAGE='SW Spectral file contains no aerosol data.' ADB2F404.1217
RETURN ADB2F404.1218
! ADB2F404.1219
ENDIF ADB2F404.1220
! ADB2F404.1221
ENDIF ADB2F404.1222
! ADB2F404.1223
! ALR3F405.135
! Check the spectral file for soot aerosol modes. (Also only ALR3F405.136
! required for the direct effect). ALR3F405.137
! ALR3F405.138
IF (L_USE_SOOT_DIRECT) THEN ALR3F405.139
! ALR3F405.140
IF (L_PRESENT(11)) THEN ! aerosol block present in spec file ALR3F405.141
! ALR3F405.142
! Search for the aerosols required for this scheme. ALR3F405.143
N_AEROSOL_FOUND=0 ALR3F405.144
DO I=1, N_AEROSOL ALR3F405.145
! ALR3F405.146
IF ( (TYPE_AEROSOL(I).EQ.IP_FRESH_SOOT).OR. ALR3F405.147
& (TYPE_AEROSOL(I).EQ.IP_AGED_SOOT) ) THEN ALR3F405.148
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ALR3F405.149
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ALR3F405.150
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ALR3F405.151
ENDIF ALR3F405.152
! ALR3F405.153
ENDDO ALR3F405.154
! ALR3F405.155
IF (N_AEROSOL_FOUND.NE.2) THEN ALR3F405.156
! ALR3F405.157
IERR=I_ERR_FATAL ALR3F405.158
CMESSAGE='The SW Spectral file lacks some ' ALR3F405.159
& //'soot aerosol.' ALR3F405.160
RETURN ALR3F405.161
! ALR3F405.162
ENDIF ALR3F405.163
ALR3F405.164
ELSE ALR3F405.165
! ALR3F405.166
IERR=I_ERR_FATAL ALR3F405.167
CMESSAGE='SW Spectral file contains no aerosol data.' ALR3F405.168
RETURN ALR3F405.169
! ALR3F405.170
ENDIF ALR3F405.171
! ALR3F405.172
ENDIF ALR3F405.173
! ALR3F405.174
! Set an appropriate reduced dimension. ADB2F404.1224
NPD_AEROSOL_SPECIES_SW=MAX(N_AEROSOL_RETAIN, 1) ADB2F404.1225
! ADB2F404.1226
! Set the allowed number of humidities from the number of ADB2F404.1227
! retained aerosols. ADB2F404.1228
! ADB2F404.1229
IF (L_PRESENT(11)) THEN SPIN3A.205
DO I=1, N_AEROSOL_RETAIN ADB2F404.1230
IF (I_AEROSOL_PARAMETRIZATION(INDEX_AEROSOL_RETAIN(I)).EQ. ADB2F404.1231
& IP_AEROSOL_PARAM_MOIST) THEN SPIN3A.208
NPD_HUMIDITIES_SW=MAX(NPD_HUMIDITIES_SW ADB2F404.1232
& , NHUMIDITY(INDEX_AEROSOL_RETAIN(I))) ADB2F404.1233
ENDIF SPIN3A.210
ENDDO SPIN3A.211
ENDIF SPIN3A.212
! SPIN3A.213
! SPIN3A.214
! SPIN3A.215
! SPIN3A.216
! TRANSFER THE LARGE NAMELIST TO THE REDUCED SPECTRUM. SPIN3A.217
! SPIN3A.218
! SPIN3A.219
CALL R2_COMPRESS_SPECTRUM( SPIN3A.272
! Spectral Array in Namelist SPIN3A.273
& L_PRESENT SPIN3A.274
& , N_BAND, WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG SPIN3A.275
& , N_BAND_EXCLUDE, INDEX_EXCLUDE SPIN3A.276
& , SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT SPIN3A.277
& , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB SPIN3A.278
& , L_RETAIN_ABSORB, N_ABSORB_RETAIN, INDEX_ABSORB_RETAIN ADB1F405.706
& , COMPRESSED_INDEX, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT ADB1F405.707
& , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE SPIN3A.280
& , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK SPIN3A.281
& , I_SPEC_SURFACE, L_SURFACE, SURFACE_ALBEDO SPIN3A.282
& , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND SPIN3A.283
& , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER SPIN3A.284
& , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM SPIN3A.285
& , P_REF_CONTINUUM, T_REF_CONTINUUM SPIN3A.286
& , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST SPIN3A.287
& , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM ADB2F404.1234
& , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST SPIN3A.288
& , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM ADB2F404.1235
& , N_AEROSOL, TYPE_AEROSOL SPIN3A.289
& , N_AEROSOL_RETAIN, INDEX_AEROSOL_RETAIN ADB2F404.1236
& , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION SPIN3A.290
& , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY SPIN3A.291
& , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION SPIN3A.292
& , L_DOPPLER_PRESENT, DOPPLER_CORRECTION SPIN3A.293
! Reduced Spectral Array SPIN3A.302
*CALL SWSARG3A ADB2F404.1237
& ) SPIN3A.356
! SPIN3A.357
! SPIN3A.358
! SPIN3A.359
RETURN SPIN3A.360
END SPIN3A.361
!+ Subroutine to read a longwave spectral namelist. SPIN3A.362
! SPIN3A.363
! Purpose: SPIN3A.364
! To read a longwave namelist into a spectral array. SPIN3A.365
! SPIN3A.366
! Method: SPIN3A.367
! The spectrum is read into the dynamically allocated array SPIN3A.368
! and then reduced to a more manageable size. SPIN3A.369
! SPIN3A.370
! Current Owner of Code: J. M. Edwards SPIN3A.371
! SPIN3A.372
! History: SPIN3A.373
! Version Date Comment SPIN3A.374
! 4.0 27-07-95 Original Code SPIN3A.375
! (J. M. Edwards) SPIN3A.376
! SPIN3A.377
! 4.4 02-09-97 Aerosol flags passed ADB2F404.1238
! in to the code to ADB2F404.1239
! enable only those ADB2F404.1240
! required to be ADB2F404.1241
! selected. Spectral ADB2F404.1242
! data are no longer ADB2F404.1243
! compressed into a ADB2F404.1244
! single array. ADB2F404.1245
! IOSTAT error code ADB2F404.1246
! returned as part of ADB2F404.1247
! CMESSAGE. ADB2F404.1248
! (J. M. Edwards) ADB2F404.1249
! 4.5 April 1998 Allow soot spectral data to be read. ADB1F405.708
! Luke Robinson. ADB1F405.709
! 4.5 18-05-98 Coding to allow ADB1F405.710
! selection of gases ADB1F405.711
! from the spectral ADB1F405.712
! file. ADB1F405.713
! (J. M. Edwards) ADB1F405.714
! ADB2F404.1250
! Description of Code: SPIN3A.378
! FORTRAN 77 with extensions listed in documentation. SPIN3A.379
! SPIN3A.380
!- --------------------------------------------------------------------- SPIN3A.381
SUBROUTINE R2_LW_SPECIN(IERR, CMESSAGE 2,2ADB2F404.1251
& , L_CH4, L_N2O, L_CFC11, L_CFC12 ADB1F405.715
& , L_CFC113, L_HCFC22, L_HFC125, L_HFC134A ADB1F405.716
& , L_CLIMAT_AEROSOL, L_USE_SULPC_DIRECT ADB2F404.1252
& , L_USE_SOOT_DIRECT ALR3F405.175
& ) ADB2F404.1253
! SPIN3A.383
! SPIN3A.384
IMPLICIT NONE ADB1F405.717
! ADB1F405.718
! ADB1F405.719
*CALL MXSIZE3A SPIN3A.385
*CALL ERROR3A ADB1F405.720
*CALL STDIO3A ADB1F405.721
! SPIN3A.386
! SPIN3A.387
! DUMMY ARGUMENTS SPIN3A.388
LOGICAL !, INTENT(IN) ADB2F404.1254
& L_CH4 ADB1F405.722
! ABSORPTION BY METHANE IS INCLUDED ADB1F405.723
& , L_N2O ADB1F405.724
! ABSORPTION BY NITROUS OXIDE IS INCLUDED ADB1F405.725
& , L_CFC11 ADB1F405.726
! ABSORPTION BY CFC11 IS INCLUDED ADB1F405.727
& , L_CFC12 ADB1F405.728
! ABSORPTION BY CFC12 IS INCLUDED ADB1F405.729
& , L_CFC113 ADB1F405.730
! ABSORPTION BY CFC113 IS INCLUDED ADB1F405.731
& , L_HCFC22 ADB1F405.732
! ABSORPTION BY HCFC22 IS INCLUDED ADB1F405.733
& , L_HFC125 ADB1F405.734
! ABSORPTION BY HFC125 IS INCLUDED ADB1F405.735
& , L_HFC134A ADB1F405.736
! ABSORPTION BY HFC134A IS INCLUDED ADB1F405.737
& , L_CLIMAT_AEROSOL ADB1F405.738
! CLIMATOLOGICAL AEROSOLS ARE TO BE INCLUDED ADB2F404.1256
& , L_USE_SULPC_DIRECT ADB2F404.1257
! THE DIRECT EFFECTS OF SULPHATE AEROSOLS ARE ADB2F404.1258
! TO BE INCLUDED ADB2F404.1259
& , L_USE_SOOT_DIRECT ALR3F405.176
! USE THE DIRECT RAD EFFECTS OF SOOT IN THE LW ALR3F405.177
! SPIN3A.392
INTEGER !, INTENT(OUT) SPIN3A.393
& IERR SPIN3A.394
! ERROR FLAG SPIN3A.395
CHARACTER*80 !, INTENT(OUT) SPIN3A.396
& CMESSAGE SPIN3A.397
! SPIN3A.402
! SPIN3A.403
! SPIN3A.404
! LOCAL VARIABLES. SPIN3A.405
! SPIN3A.406
! ADB1F405.739
! RADIATIVE VARIABLES FOR REDUCING THE SPECTRUM ADB1F405.740
! ADB1F405.741
*CALL AERPRM3A ADB1F405.742
*CALL AERCMP3A ADB1F405.743
*CALL GASID3A ADB1F405.744
! ADB1F405.745
CHARACTER*80 SPIN3A.407
& LW_SPECTRAL_FILE SPIN3A.408
! NAME OF FILE CONTAINING THE SPECTRAL DATA SPIN3A.409
INTEGER SPIN3A.410
& IERR_GET_FILE SPIN3A.411
! ERROR FLAG RETURNED BY GET_FILE (NOT NECESSARILY SPIN3A.412
! CONSISTENT WITH THE FLAGS IN ERROR3A). SPIN3A.413
& , IOS SPIN3A.414
! STATUS OF I/O SPIN3A.415
! SPIN3A.416
LOGICAL ADB1F405.746
& L_RETAIN_ABSORB(NPD_SPECIES) ADB1F405.747
! FLAG SET TO .TRUE. IF THE ABSORBER IS TO BE RETAINED ADB1F405.748
& , L_GAS_INCLUDED(NPD_GASES) ADB1F405.749
! LOGICAL TO TEST FOR ACTUAL GASES INCLUDED ADB1F405.750
INTEGER ADB2F404.1260
& N_ABSORB_RETAIN ADB1F405.751
! NUMBER OF ABSORBERS TO RETAIN ADB1F405.752
& , INDEX_ABSORB_RETAIN(NPD_SPECIES) ADB1F405.753
! INDICES OF ABSORBERS TO BE RETAINED ADB1F405.754
& , N_AEROSOL_RETAIN ADB1F405.755
! NUMBER OF AEROSOLS IN THE SPECTRAL FILE TO BE RETAINED ADB2F404.1262
! FOR THE RADIATIVE CALCULATION ADB2F404.1263
& , INDEX_AEROSOL_RETAIN(NPD_AEROSOL_SPECIES) ADB2F404.1264
! INDEXING NUMBERS OF THE RETAINED AEROSOLS ADB2F404.1265
& , COMPRESSED_INDEX(NPD_SPECIES) ADB1F405.756
! MAPPING FROM OLD TO NEW INDICES OF ABSORBERS ADB1F405.757
& , N_AEROSOL_FOUND ADB2F404.1266
! NUMBER OF AEROSOLS FOR THE CURRENT GROUP OF PROCESSES ADB2F404.1267
! FOUND IN THE SPECTRAL FILE ADB2F404.1268
! SPIN3A.417
! ADB2F404.1269
! DECLARE THE ELEMENTS OF THE INITIAL SPECTRUM FOR DYNAMIC ADB2F404.1270
! ALLOCATION AND SET UP AN APPROPRIATE NAMELIST. ADB2F404.1271
! ADB2F404.1272
*CALL SPDEC3A SPIN3A.420
*CALL LWSP3A SPIN3A.421
! ADB2F404.1273
! ADB2F404.1274
! DECLARE THE REDUCED SW SPECTRAL FILE AND ITS HOLDING COMMON BLOCK. ADB2F404.1275
! ADB2F404.1276
*CALL LWSPDL3A ADB2F404.1277
*CALL LWSPCM3A ADB2F404.1278
! SPIN3A.424
! SPIN3A.463
! SPIN3A.464
INTEGER SPIN3A.465
& I SPIN3A.466
! LOOP VARIABLE SPIN3A.467
& , J SPIN3A.468
! LOOP VARIABLE SPIN3A.469
! ADB2F404.1284
CHARACTER ADB2F404.1285
& CH_IOS*5 ADB2F404.1286
! CHARACTER STRING FOR IOSTAT ERROR ADB2F404.1287
! SPIN3A.470
! SUBROUTINES CALLED SPIN3A.471
EXTERNAL SPIN3A.472
& R2_COMPRESS_SPECTRUM SPIN3A.473
! SPIN3A.474
! SPIN3A.475
! EACH BLOCK IS INITIALIZED AS MISSING: SPIN3A.476
DATA L_PRESENT/.FALSE., NPD_TYPE*.FALSE./ SPIN3A.477
! ADB2F404.1288
! INITIALIZE THE RANGE OF VALIDITY OF THE PARAMETRIZATIONS OF ADB2F404.1289
! DROPLETS AND ICE CRYSTALS. OLD SPECTRAL FILES WILL NOT CONTAIN ADB2F404.1290
! SUCH DATA, SO THE LIMITS FOR DROPLETS ARE INITIALIZED TO THOSE ADB2F404.1291
! FORMERLY SET IN THE MICROPHYSICAL SCHEME (MRF/UMIST ADB2F404.1292
! PARAMETRIZATION) TO ENSURE THAT THE RESULTS ARE BIT-REPRODUCIBLE. ADB2F404.1293
! VALUES FOR ICE COVER THE RANGE OF EFFECTIVE RADII USED IN ADB2F404.1294
! GENERATING THE DATA FOR THE ORIGINAL PARAMETRIZATION OF ICE ADB2F404.1295
! CRYSTALS. ADB2F404.1296
! AT SOME FUTURE RELEASE IT MAY BE DESIRABLE TO REMOVE DEFAULT ADB2F404.1297
! SETTINGS. ADB2F404.1298
DATA DROP_PARM_MIN_DIM/NPD_DROP_TYPE*3.5E-07/ ADB2F404.1299
DATA DROP_PARM_MAX_DIM/NPD_DROP_TYPE*3.7E-05/ ADB2F404.1300
DATA ICE_PARM_MIN_DIM/NPD_ICE_TYPE*3.75E-07/ ADB2F404.1301
DATA ICE_PARM_MAX_DIM/NPD_ICE_TYPE*8.0E-05/ ADB2F404.1302
! SPIN3A.478
! SPIN3A.479
! SPIN3A.480
! READ THE LONGWAVE SPECTRUM AS A NAMELIST. SPIN3A.481
CALL GET_FILE(80, LW_SPECTRAL_FILE, 80, IERR_GET_FILE) SPIN3A.482
IF (IERR_GET_FILE.NE.0) THEN SPIN3A.483
! CONVERT THE ERROR FLAG FROM GET_FILE TO A FLAG RECOGNISED SPIN3A.484
! BY THE RADIATION CODE. SPIN3A.485
IERR=I_ERR_IO SPIN3A.486
CMESSAGE='Error reading name of longwave spectral file.' SPIN3A.487
RETURN SPIN3A.488
ENDIF SPIN3A.489
OPEN(UNIT=80, FILE=LW_SPECTRAL_FILE, IOSTAT=IOS, PXNAMLST.17
& DELIM='APOSTROPHE') PXNAMLST.18
IF (IOS.NE.0) THEN SPIN3A.491
IERR=I_ERR_IO SPIN3A.492
WRITE(CH_IOS, '(I5)') IOS ADB2F404.1303
CMESSAGE='Error opening longwave spectral file.' ADB1F401.952
& //' IOSTAT='//CH_IOS ADB2F404.1304
RETURN SPIN3A.494
ENDIF SPIN3A.495
READ(80, R2LWSP) SPIN3A.496
CLOSE(80) SPIN3A.497
! SPIN3A.498
! TEST FOR MINIMAL REQUISITE INFORMATION. SPIN3A.499
IF ( .NOT.(L_PRESENT(0).AND. SPIN3A.500
& L_PRESENT(6) ) ) THEN SPIN3A.501
CMESSAGE='Longwave spectrum is deficient.' SPIN3A.502
IERR=I_ERR_FATAL SPIN3A.503
RETURN SPIN3A.504
ENDIF SPIN3A.505
! SPIN3A.506
! SPIN3A.507
! SPIN3A.508
! SET REDUCED DIMENSIONS, EITHER FROM THE SIZES OF THE FIXED ARRAYS SPIN3A.509
! OR FROM THE ARRAYS READ IN. SPIN3A.510
! SPIN3A.511
NPD_TYPE_LW=NPD_TYPE ADB2F404.1305
NPD_BAND_LW=MAX(N_BAND, 1) ADB2F404.1306
NPD_SPECIES_LW=MAX(N_ABSORB, 1) ADB2F404.1307
NPD_ALBEDO_PARM_LW=NPD_ALBEDO_PARM ADB2F404.1308
NPD_SCALE_FNC_LW=NPD_SCALE_FNC ADB2F404.1309
NPD_SCALE_VARIABLE_LW=NPD_SCALE_VARIABLE ADB2F404.1310
NPD_SURFACE_LW=NPD_SURFACE ADB2F404.1311
NPD_CONTINUUM_LW=NPD_CONTINUUM ADB2F404.1312
NPD_THERMAL_COEFF_LW=N_DEG_FIT+1 ADB2F404.1313
NPD_CLOUD_PARAMETER_LW=NPD_CLOUD_PARAMETER ADB2F404.1314
! SPIN3A.523
! SPIN3A.524
! SEARCH THE SPECTRUM TO FIND MAXIMUM DIMENSIONS. SPIN3A.525
! SPIN3A.526
NPD_EXCLUDE_LW=1 ADB2F404.1315
IF (L_PRESENT(14)) THEN SPIN3A.528
DO I=1, N_BAND SPIN3A.529
NPD_EXCLUDE_LW=MAX(NPD_EXCLUDE_LW, N_BAND_EXCLUDE(I)) ADB2F404.1316
ENDDO SPIN3A.531
ENDIF SPIN3A.532
! SPIN3A.533
! Search the spectrum to find those gases to be retained. ADB1F405.758
! Water vapour, carbon dioxide and ozone are included ADB1F405.759
! if present, but a warning is printed if they are ADB1F405.760
! not included. ADB1F405.761
DO I=1, NPD_GASES ADB1F405.762
L_GAS_INCLUDED(I)=.FALSE. ADB1F405.763
ENDDO ADB1F405.764
N_ABSORB_RETAIN=0 ADB1F405.765
! ADB1F405.766
DO I=1, N_ABSORB ADB1F405.767
! ADB1F405.768
L_RETAIN_ABSORB(I)=.FALSE. ADB1F405.769
COMPRESSED_INDEX(I)=0 ADB1F405.770
! ADB1F405.771
IF ( (TYPE_ABSORB(I).EQ.IP_H2O).OR. ADB1F405.772
& (TYPE_ABSORB(I).EQ.IP_CO2).OR. ADB1F405.773
& (TYPE_ABSORB(I).EQ.IP_O3).OR. ADB1F405.774
& ( (TYPE_ABSORB(I).EQ.IP_CH4).AND.L_CH4 ).OR. ADB1F405.775
& ( (TYPE_ABSORB(I).EQ.IP_N2O).AND.L_N2O ).OR. ADB1F405.776
& ( (TYPE_ABSORB(I).EQ.IP_CFC11).AND.L_CFC11 ).OR. ADB1F405.777
& ( (TYPE_ABSORB(I).EQ.IP_CFC12).AND.L_CFC12 ).OR. ADB1F405.778
& ( (TYPE_ABSORB(I).EQ.IP_CFC113).AND.L_CFC113 ).OR. ADB1F405.779
& ( (TYPE_ABSORB(I).EQ.IP_HCFC22).AND.L_HCFC22 ).OR. ADB1F405.780
& ( (TYPE_ABSORB(I).EQ.IP_HFC125).AND.L_HFC125 ).OR. ADB1F405.781
& ( (TYPE_ABSORB(I).EQ.IP_HFC134A).AND.L_HFC134A ) ) THEN ADB1F405.782
N_ABSORB_RETAIN=N_ABSORB_RETAIN+1 ADB1F405.783
INDEX_ABSORB_RETAIN(N_ABSORB_RETAIN)=I ADB1F405.784
COMPRESSED_INDEX(I)=N_ABSORB_RETAIN ADB1F405.785
L_RETAIN_ABSORB(I)=.TRUE. ADB1F405.786
L_GAS_INCLUDED(TYPE_ABSORB(I))=.TRUE. ADB1F405.787
ENDIF ADB1F405.788
! ADB1F405.789
ENDDO ADB1F405.790
! ADB1F405.791
! ADB1F405.792
! Print warning messages if those gases normally expected ADB1F405.793
! are not present. ADB1F405.794
IF (.NOT.L_GAS_INCLUDED(IP_H2O)) THEN ADB1F405.795
WRITE(IU_ERR, '(/A, /A)') ADB1F405.796
& '*** WARNING: Water vapour is not included in the ' ADB1F405.797
& , 'longwave spectral file.' ADB1F405.798
ENDIF ADB1F405.799
! ADB1F405.800
IF (.NOT.L_GAS_INCLUDED(IP_CO2)) THEN ADB1F405.801
WRITE(IU_ERR, '(/A, /A)') ADB1F405.802
& '*** WARNING: Carbon dioxide is not included in the ' ADB1F405.803
& , 'longwave spectral file.' ADB1F405.804
ENDIF ADB1F405.805
! ADB1F405.806
IF (.NOT.L_GAS_INCLUDED(IP_O3)) THEN ADB1F405.807
WRITE(IU_ERR, '(/A, /A)') ADB1F405.808
& '*** WARNING: Ozone is not included in the ' ADB1F405.809
& , 'longwave spectral file.' ADB1F405.810
ENDIF ADB1F405.811
! ADB1F405.812
IF ((.NOT.L_GAS_INCLUDED(IP_CH4)).AND.L_CH4) THEN ADB1F405.813
WRITE(IU_ERR, '(/A, /A)') ADB1F405.814
& '*** ERROR: Methane is not included in the longwave ' ADB1F405.815
& , 'spectral file, but was requested in the run.' ADB1F405.816
IERR=I_ERR_FATAL ADB1F405.817
RETURN ADB1F405.818
ENDIF ADB1F405.819
! ADB1F405.820
IF ((.NOT.L_GAS_INCLUDED(IP_N2O)).AND.L_N2O) THEN ADB1F405.821
WRITE(IU_ERR, '(/A, /A)') ADB1F405.822
& '*** ERROR: Nitrous oxide is not included in the longwave ' ADB1F405.823
& , 'spectral file, but was requested in the run.' ADB1F405.824
IERR=I_ERR_FATAL ADB1F405.825
RETURN ADB1F405.826
ENDIF ADB1F405.827
! ADB1F405.828
IF ((.NOT.L_GAS_INCLUDED(IP_CFC11)).AND.L_CFC11) THEN ADB1F405.829
WRITE(IU_ERR, '(/A, /A)') ADB1F405.830
& '*** ERROR: CFC11 is not included in the longwave ' ADB1F405.831
& , 'spectral file, but was requested in the run.' ADB1F405.832
IERR=I_ERR_FATAL ADB1F405.833
RETURN ADB1F405.834
ENDIF ADB1F405.835
! ADB1F405.836
IF ((.NOT.L_GAS_INCLUDED(IP_CFC12)).AND.L_CFC12) THEN ADB1F405.837
WRITE(IU_ERR, '(/A, /A)') ADB1F405.838
& '*** ERROR: CFC12 is not included in the longwave ' ADB1F405.839
& , 'spectral file, but was requested in the run.' ADB1F405.840
IERR=I_ERR_FATAL ADB1F405.841
RETURN ADB1F405.842
ENDIF ADB1F405.843
! ADB1F405.844
IF ((.NOT.L_GAS_INCLUDED(IP_CFC113)).AND.L_CFC113) THEN ADB1F405.845
WRITE(IU_ERR, '(/A, /A)') ADB1F405.846
& '*** ERROR: CFC113 is not included in the longwave ' ADB1F405.847
& , 'spectral file, but was requested in the run.' ADB1F405.848
IERR=I_ERR_FATAL ADB1F405.849
RETURN ADB1F405.850
ENDIF ADB1F405.851
! ADB1F405.852
IF ((.NOT.L_GAS_INCLUDED(IP_HCFC22)).AND.L_HCFC22) THEN ADB1F405.853
WRITE(IU_ERR, '(/A, /A)') ADB1F405.854
& '*** ERROR: HCFC22 is not included in the longwave ' ADB1F405.855
& , 'spectral file, but was requested in the run.' ADB1F405.856
IERR=I_ERR_FATAL ADB1F405.857
RETURN ADB1F405.858
ENDIF ADB1F405.859
! ADB1F405.860
IF ((.NOT.L_GAS_INCLUDED(IP_HFC125)).AND.L_HFC125) THEN ADB1F405.861
WRITE(IU_ERR, '(/A, /A)') ADB1F405.862
& '*** ERROR: HFC125 is not included in the longwave ' ADB1F405.863
& , 'spectral file, but was requested in the run.' ADB1F405.864
IERR=I_ERR_FATAL ADB1F405.865
RETURN ADB1F405.866
ENDIF ADB1F405.867
! ADB1F405.868
IF ((.NOT.L_GAS_INCLUDED(IP_HFC134A)).AND.L_HFC134A) THEN ADB1F405.869
WRITE(IU_ERR, '(/A, /A)') ADB1F405.870
& '*** ERROR: HFC134A is not included in the longwave ' ADB1F405.871
& , 'spectral file, but was requested in the run.' ADB1F405.872
IERR=I_ERR_FATAL ADB1F405.873
RETURN ADB1F405.874
ENDIF ADB1F405.875
! ADB1F405.876
! Set an appropriate reduced dimension. ADB1F405.877
NPD_SPECIES_LW=MAX(N_ABSORB_RETAIN, 1) ADB1F405.878
! ADB1F405.879
NPD_ESFT_TERM_LW=1 ADB2F404.1317
IF (L_PRESENT(5)) THEN SPIN3A.535
DO I=1, N_BAND SPIN3A.536
DO J=1, N_BAND_ABSORB(I) SPIN3A.537
IF (L_RETAIN_ABSORB(INDEX_ABSORB(J, I))) ADB1F405.880
& NPD_ESFT_TERM_LW=MAX(NPD_ESFT_TERM_LW ADB1F405.881
& , I_BAND_ESFT(I, INDEX_ABSORB(J, I))) SPIN3A.539
ENDDO SPIN3A.540
ENDDO SPIN3A.541
ENDIF SPIN3A.542
! SPIN3A.543
NPD_DROP_TYPE_LW=1 ADB2F404.1319
IF (L_PRESENT(10)) THEN SPIN3A.545
DO I=1, NPD_DROP_TYPE ADB1F405.882
IF (L_DROP_TYPE(I)) THEN SPIN3A.547
NPD_DROP_TYPE_LW=MAX(NPD_DROP_TYPE_LW, I) ADB2F404.1321
ENDIF SPIN3A.549
ENDDO SPIN3A.550
ENDIF SPIN3A.551
! SPIN3A.552
NPD_ICE_TYPE_LW=1 ADB2F404.1322
IF (L_PRESENT(12)) THEN SPIN3A.554
DO I=1, NPD_ICE_TYPE SPIN3A.555
IF (L_ICE_TYPE(I)) THEN SPIN3A.556
NPD_ICE_TYPE_LW=MAX(NPD_ICE_TYPE_LW, I) ADB2F404.1323
ENDIF SPIN3A.558
ENDDO SPIN3A.559
ENDIF SPIN3A.560
! SPIN3A.561
! ADB2F404.1324
! ADB2F404.1325
! Aerosols must be treated carefully to allow for various ADB2F404.1326
! different combinations without requiring the spectral file ADB2F404.1327
! to be too constrained. Only those required will be retained. ADB2F404.1328
! ADB2F404.1329
! Basic initialization to safe values. ADB2F404.1330
NPD_HUMIDITIES_LW=1 ADB2F404.1331
N_AEROSOL_RETAIN=0 ADB2F404.1332
! ADB2F404.1333
! Check the spectral file for climatological aerosols ADB2F404.1334
IF (L_CLIMAT_AEROSOL) THEN ADB2F404.1335
! ADB2F404.1336
IF (L_PRESENT(11)) THEN ADB2F404.1337
! ADB2F404.1338
! Search for the aerosols required for this scheme. ADB2F404.1339
N_AEROSOL_FOUND=0 ADB2F404.1340
DO I=1, N_AEROSOL ADB2F404.1341
! ADB2F404.1342
IF ( (TYPE_AEROSOL(I).EQ.IP_WATER_SOLUBLE).OR. ADB2F404.1343
& (TYPE_AEROSOL(I).EQ.IP_DUST_LIKE).OR. ADB2F404.1344
& (TYPE_AEROSOL(I).EQ.IP_OCEANIC).OR. ADB2F404.1345
& (TYPE_AEROSOL(I).EQ.IP_SOOT).OR. ADB2F404.1346
& (TYPE_AEROSOL(I).EQ.IP_SULPHURIC) ) THEN ADB2F404.1347
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ADB2F404.1348
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ADB2F404.1349
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ADB2F404.1350
ENDIF ADB2F404.1351
ADB2F404.1352
ENDDO ADB2F404.1353
! ADB2F404.1354
IF (N_AEROSOL_FOUND.NE.5) THEN ADB2F404.1355
! ADB2F404.1356
IERR=I_ERR_FATAL ADB2F404.1357
CMESSAGE='The LW Spectral file lacks some ' ADB2F404.1358
& //'climatological aerosols.' ADB2F404.1359
RETURN ADB2F404.1360
! ADB2F404.1361
ENDIF ADB2F404.1362
ADB2F404.1363
ELSE ADB2F404.1364
! ADB2F404.1365
IERR=I_ERR_FATAL ADB2F404.1366
CMESSAGE='LW Spectral file contains no aerosol data.' ADB2F404.1367
RETURN ADB2F404.1368
! ADB2F404.1369
ENDIF ADB2F404.1370
! ADB2F404.1371
ENDIF ADB2F404.1372
! Check the spectral file for soot aerosols. ALR3F405.178
IF (L_USE_SOOT_DIRECT) THEN ALR3F405.179
IF (L_PRESENT(11)) THEN ALR3F405.180
! Search for the aerosols required for this scheme. ALR3F405.181
N_AEROSOL_FOUND=0 ALR3F405.182
DO I=1, N_AEROSOL ALR3F405.183
IF ((TYPE_AEROSOL(I).EQ.IP_FRESH_SOOT) .OR. ALR3F405.184
& (TYPE_AEROSOL(I).EQ.IP_AGED_SOOT)) THEN ALR3F405.185
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ALR3F405.186
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ALR3F405.187
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ALR3F405.188
ENDIF ALR3F405.189
ENDDO ALR3F405.190
! ALR3F405.191
IF (N_AEROSOL_FOUND.NE.2) THEN ALR3F405.192
! ALR3F405.193
IERR=I_ERR_FATAL ALR3F405.194
CMESSAGE='The LW Spectral file lacks some ' ALR3F405.195
& //'soot aerosol data.' ALR3F405.196
RETURN ALR3F405.197
! ALR3F405.198
ENDIF ALR3F405.199
! ALR3F405.200
ELSE ALR3F405.201
! ALR3F405.202
! ALR3F405.203
IERR=I_ERR_FATAL ALR3F405.204
CMESSAGE='LW Spectral file contains no soot data.' ALR3F405.205
RETURN ALR3F405.206
! ALR3F405.207
ENDIF ALR3F405.208
! ALR3F405.209
ENDIF ALR3F405.210
! ALR3F405.211
ADB2F404.1373
! ADB2F404.1374
! Check the spectral file for sulphate aerosols. (These are ADB2F404.1375
! required only for the direct effect). ADB2F404.1376
! ADB2F404.1377
IF (L_USE_SULPC_DIRECT) THEN ADB2F404.1378
! ADB2F404.1379
IF (L_PRESENT(11)) THEN ADB2F404.1380
! ADB2F404.1381
! Search for the aerosols required for this scheme. ADB2F404.1382
N_AEROSOL_FOUND=0 ADB2F404.1383
DO I=1, N_AEROSOL ADB2F404.1384
! ADB2F404.1385
IF ( (TYPE_AEROSOL(I).EQ.IP_ACCUM_SULPHATE).OR. ADB2F404.1386
& (TYPE_AEROSOL(I).EQ.IP_AITKEN_SULPHATE) ) THEN ADB2F404.1387
N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1 ADB2F404.1388
INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I ADB2F404.1389
N_AEROSOL_FOUND=N_AEROSOL_FOUND+1 ADB2F404.1390
ENDIF ADB2F404.1391
ADB2F404.1392
ENDDO ADB2F404.1393
! ADB2F404.1394
IF (N_AEROSOL_FOUND.NE.2) THEN ADB2F404.1395
! ADB2F404.1396
IERR=I_ERR_FATAL ADB2F404.1397
CMESSAGE='The LW Spectral file lacks some ' ADB2F404.1398
& //'sulphate aerosols.' ADB2F404.1399
RETURN ADB2F404.1400
! ADB2F404.1401
ENDIF ADB2F404.1402
ADB2F404.1403
ELSE ADB2F404.1404
! ADB2F404.1405
IERR=I_ERR_FATAL ADB2F404.1406
CMESSAGE='LW Spectral file contains no aerosol data.' ADB2F404.1407
RETURN ADB2F404.1408
! ADB2F404.1409
ENDIF ADB2F404.1410
! ADB2F404.1411
ENDIF ADB2F404.1412
! ADB2F404.1413
! Set an appropriate reduced dimension. ADB2F404.1414
NPD_AEROSOL_SPECIES_LW=MAX(N_AEROSOL_RETAIN, 1) ADB2F404.1415
! ADB2F404.1416
! Set the allowed number of humidities from the number of ADB2F404.1417
! retained aerosols. ADB2F404.1418
! ADB2F404.1419
IF (L_PRESENT(11)) THEN SPIN3A.563
DO I=1, N_AEROSOL_RETAIN ADB2F404.1420
IF (I_AEROSOL_PARAMETRIZATION(INDEX_AEROSOL_RETAIN(I)).EQ. ADB2F404.1421
& IP_AEROSOL_PARAM_MOIST) THEN SPIN3A.566
NPD_HUMIDITIES_LW=MAX(NPD_HUMIDITIES_LW ADB2F404.1422
& , NHUMIDITY(INDEX_AEROSOL_RETAIN(I))) ADB2F404.1423
ENDIF SPIN3A.568
ENDDO SPIN3A.569
ENDIF SPIN3A.570
! SPIN3A.571
! SPIN3A.572
! SPIN3A.573
! SPIN3A.574
! TRANSFER THE LARGE NAMELIST TO THE REDUCED SPECTRUM. SPIN3A.575
! SPIN3A.576
! SPIN3A.577
CALL R2_COMPRESS_SPECTRUM( SPIN3A.630
! Spectral Array in Namelist SPIN3A.631
& L_PRESENT SPIN3A.632
& , N_BAND, WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG SPIN3A.633
& , N_BAND_EXCLUDE, INDEX_EXCLUDE SPIN3A.634
& , SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT SPIN3A.635
& , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB SPIN3A.636
& , L_RETAIN_ABSORB, N_ABSORB_RETAIN, INDEX_ABSORB_RETAIN ADB1F405.883
& , COMPRESSED_INDEX, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT ADB1F405.884
& , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE SPIN3A.638
& , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK SPIN3A.639
& , I_SPEC_SURFACE, L_SURFACE, SURFACE_ALBEDO SPIN3A.640
& , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND SPIN3A.641
& , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER SPIN3A.642
& , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM SPIN3A.643
& , P_REF_CONTINUUM, T_REF_CONTINUUM SPIN3A.644
& , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST SPIN3A.645
& , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM ADB2F404.1424
& , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST SPIN3A.646
& , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM ADB2F404.1425
& , N_AEROSOL, TYPE_AEROSOL SPIN3A.647
& , N_AEROSOL_RETAIN, INDEX_AEROSOL_RETAIN ADB2F404.1426
& , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION SPIN3A.648
& , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY SPIN3A.649
& , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION SPIN3A.650
& , L_DOPPLER_PRESENT, DOPPLER_CORRECTION SPIN3A.651
! Reduced Spectral Array SPIN3A.660
*CALL LWSARG3A ADB2F404.1427
& ) SPIN3A.712
! SPIN3A.713
! SPIN3A.714
! SPIN3A.715
RETURN SPIN3A.716
END SPIN3A.717
!+ Subroutine to transfer spectrum to reduced array. SPIN3A.718
! SPIN3A.719
! Purpose: SPIN3A.720
! Spectral data from the large dynamically allocated array SPIN3A.721
! are transferred to the reduced array. SPIN3A.722
! SPIN3A.723
! Method: SPIN3A.724
! Elements are copied across. SPIN3A.725
! SPIN3A.726
! Current Owner of Code: J. M. Edwards SPIN3A.727
! SPIN3A.728
! History: SPIN3A.729
! Version Date Comment SPIN3A.730
! 4.0 27-07-95 Original Code SPIN3A.731
! (J. M. Edwards) SPIN3A.732
! 4.4 03-09-97 Coding changes ADB2F404.1428
! associated with the ADB2F404.1429
! removal of pointers ADB2F404.1430
! into the spectral data. ADB2F404.1431
! Capability to select ADB2F404.1432
! aerosols added. ADB2F404.1433
! (J. M. Edwards) ADB2F404.1434
! 4.5 18-05-98 Coding to allow ADB1F405.885
! selection of gases ADB1F405.886
! from the spectral ADB1F405.887
! file. ADB1F405.888
! (J. M. Edwards) ADB1F405.889
! SPIN3A.733
! Description of Code: SPIN3A.734
! FORTRAN 77 with extensions listed in documentation. SPIN3A.735
! SPIN3A.736
!- --------------------------------------------------------------------- SPIN3A.737
SUBROUTINE R2_COMPRESS_SPECTRUM( 2SPIN3A.738
! Original Spectrum SPIN3A.739
& L_PRESENT SPIN3A.740
& , N_BAND, WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG SPIN3A.741
& , N_BAND_EXCLUDE, INDEX_EXCLUDE SPIN3A.742
& , SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT SPIN3A.743
& , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB SPIN3A.744
& , L_RETAIN_ABSORB, N_ABSORB_RETAIN, INDEX_ABSORB_RETAIN ADB1F405.890
& , COMPRESSED_INDEX, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT ADB1F405.891
& , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE SPIN3A.746
& , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK SPIN3A.747
& , I_SPEC_SURFACE, L_SURFACE, SURFACE_ALBEDO SPIN3A.748
& , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND SPIN3A.749
& , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER SPIN3A.750
& , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM SPIN3A.751
& , P_REF_CONTINUUM, T_REF_CONTINUUM SPIN3A.752
& , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST SPIN3A.753
& , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM ADB2F404.1435
& , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST SPIN3A.754
& , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM ADB2F404.1436
& , N_AEROSOL, TYPE_AEROSOL SPIN3A.755
& , N_AEROSOL_RETAIN, INDEX_AEROSOL_RETAIN ADB2F404.1437
& , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION SPIN3A.756
& , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY SPIN3A.757
& , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION SPIN3A.758
& , L_DOPPLER_PRESENT, DOPPLER_CORRECTION SPIN3A.759
! Reduced Spectral Array ADB2F404.1438
& , NPDR_TYPE, NPDR_BAND, NPDR_EXCLUDE SPIN3A.761
& , NPDR_SPECIES, NPDR_ESFT_TERM, NPDR_SCALE_FNC SPIN3A.762
& , NPDR_SCALE_VARIABLE, NPDR_THERMAL_COEFF SPIN3A.763
& , NPDR_SURFACE, NPDR_ALBEDO_PARM SPIN3A.764
& , NPDR_CONTINUUM, NPDR_DROP_TYPE, NPDR_ICE_TYPE SPIN3A.765
& , NPDR_CLOUD_PARAMETER, NPDR_AEROSOL_SPECIES SPIN3A.766
& , NPDR_HUMIDITIES SPIN3A.767
& , L_PRESENT_RD SPIN3A.776
& , N_BAND_RD, WAVE_LENGTH_SHORT_RD , WAVE_LENGTH_LONG_RD SPIN3A.777
& , N_BAND_EXCLUDE_RD, INDEX_EXCLUDE_RD SPIN3A.778
& , SOLAR_FLUX_BAND_RD, RAYLEIGH_COEFFICIENT_RD SPIN3A.779
& , N_ABSORB_RD, N_BAND_ABSORB_RD, INDEX_ABSORB_RD SPIN3A.780
& , TYPE_ABSORB_RD SPIN3A.781
& , I_BAND_ESFT_RD, I_SCALE_ESFT_RD, I_SCALE_FNC_RD ADB2F404.1439
& , K_ESFT_RD, W_ESFT_RD, SCALE_VECTOR_RD ADB2F404.1440
& , P_REFERENCE_RD, T_REFERENCE_RD SPIN3A.784
& , N_DEG_FIT_RD, THERMAL_COEFFICIENT_RD, T_REF_PLANCK_RD SPIN3A.785
& , I_SPEC_SURFACE_RD, N_DIR_ALBEDO_FIT_RD ADB2F404.1441
& , L_SURFACE_RD, SURFACE_ALBEDO_RD, DIRECT_ALBEDO_PARM_RD ADB2F404.1442
& , EMISSIVITY_GROUND_RD SPIN3A.788
& , N_BAND_CONTINUUM_RD, INDEX_CONTINUUM_RD, INDEX_WATER_RD SPIN3A.789
& , I_SCALE_FNC_CONT_RD, K_CONTINUUM_RD, SCALE_CONTINUUM_RD ADB2F404.1443
& , P_REF_CONTINUUM_RD, T_REF_CONTINUUM_RD SPIN3A.791
& , I_DROP_PARAMETRIZATION_RD, L_DROP_TYPE_RD ADB2F404.1444
& , DROP_PARAMETER_LIST_RD SPIN3A.793
& , DROP_PARM_MIN_DIM_RD, DROP_PARM_MAX_DIM_RD ADB2F404.1445
& , N_AEROSOL_RD, TYPE_AEROSOL_RD, I_AEROSOL_PARAMETRIZATION_RD ADB2F404.1446
& , NHUMIDITY_RD, HUMIDITIES_RD ADB2F404.1447
& , L_AEROSOL_SPECIES_RD, AEROSOL_ABSORPTION_RD SPIN3A.797
& , AEROSOL_SCATTERING_RD, AEROSOL_ASYMMETRY_RD SPIN3A.798
& , I_ICE_PARAMETRIZATION_RD, L_ICE_TYPE_RD ADB2F404.1448
& , ICE_PARAMETER_LIST_RD ADB2F404.1449
& , ICE_PARM_MIN_DIM_RD, ICE_PARM_MAX_DIM_RD ADB2F404.1450
& , L_DOPPLER_PRESENT_RD, DOPPLER_CORRECTION_RD SPIN3A.800
& ) SPIN3A.801
! SPIN3A.802
! SPIN3A.803
IMPLICIT NONE ADB1F405.892
! ADB1F405.893
! ADB1F405.894
! SPIN3A.804
! ------------------------------------------------------------------ SPIN3A.805
! DECLARATION OF INITIAL SPECTRUM. SPIN3A.806
! ------------------------------------------------------------------ SPIN3A.807
*CALL MXSIZE3A SPIN3A.808
*CALL SPDEC3A SPIN3A.809
! ADB2F404.1451
! AUXILIARY VARIABLES USED TO SELECT PARTS OF THE INITIAL SPECTRUM ADB2F404.1452
LOGICAL !, INTENT(IN) ADB1F405.895
& L_RETAIN_ABSORB(NPD_SPECIES) ADB1F405.896
! FLAGS FOR THE RETENTION OF GASES IN THE SPECTRAL FILE ADB1F405.897
INTEGER !, INTENT(IN) ADB2F404.1453
& N_ABSORB_RETAIN ADB1F405.898
! NUMBER OF ABSORBERS TO BE RETAINED ADB1F405.899
& , INDEX_ABSORB_RETAIN(NPD_SPECIES) ADB1F405.900
! INDICES OF ABSORBERS TO BE RETAINED ADB1F405.901
& , COMPRESSED_INDEX(NPD_SPECIES) ADB1F405.902
! MAPPING FROM OLD TO NEW INDICES OF ABSORBERS ADB1F405.903
& , N_AEROSOL_RETAIN ADB1F405.904
! NUMBER OF AEROSOLS IN THE INITIAL SPECTRUM TO BE USED ADB2F404.1455
! IN THE CALCULATION ADB2F404.1456
& , INDEX_AEROSOL_RETAIN(NPD_AEROSOL_SPECIES) ADB2F404.1457
! INDICES OF THE RETAINED AEROSOLS ADB2F404.1458
! SPIN3A.810
! SPIN3A.811
! ------------------------------------------------------------------ SPIN3A.812
! DECLARATION OF REDUCED SPECTRUM. SPIN3A.813
! ------------------------------------------------------------------ SPIN3A.814
! SPIN3A.815
! DIMENSIONS OF REDUCED ARRAY: SPIN3A.816
! SPIN3A.817
INTEGER SPIN3A.818
& NPDR_BAND SPIN3A.819
! NUMBER OF SPECTRAL BANDS SPIN3A.820
& , NPDR_EXCLUDE SPIN3A.821
! NUMER OF EXCLUDED BANDS SPIN3A.822
& , NPDR_ESFT_TERM SPIN3A.823
! NUMBER OF ESFT TERMS SPIN3A.824
& , NPDR_TYPE SPIN3A.825
! NUMBER OF DATA TYPES SPIN3A.826
& , NPDR_SPECIES SPIN3A.827
! NUMBER OF GASEOUS SPECIES SPIN3A.828
& , NPDR_SCALE_FNC SPIN3A.829
! NUMBER OF SCALING FUNCTIONS SPIN3A.830
& , NPDR_SCALE_VARIABLE SPIN3A.831
! NUMBER OF SCALING VARIABLES SPIN3A.832
& , NPDR_SURFACE SPIN3A.833
! NUMBER OF SURFACE TYPES SPIN3A.834
& , NPDR_ALBEDO_PARM SPIN3A.835
! NUMBER OF ALBEDO PARAMETERS SPIN3A.836
& , NPDR_CONTINUUM SPIN3A.837
! NUMBER OF CONTINUA SPIN3A.838
& , NPDR_DROP_TYPE SPIN3A.839
! NUMBER OF DROP TYPES SPIN3A.840
& , NPDR_ICE_TYPE SPIN3A.841
! NUMBER OF ICE CRYSTAL TYPES SPIN3A.842
& , NPDR_AEROSOL_SPECIES SPIN3A.843
! NUMBER OF AEROSOL SPECIES SPIN3A.844
& , NPDR_THERMAL_COEFF SPIN3A.845
! NUMBER OF THERMAL COEFFICIENTS SPIN3A.846
& , NPDR_CLOUD_PARAMETER SPIN3A.847
! MAX NUMBER OF CLOUD PARAMETERS SPIN3A.848
& , NPDR_HUMIDITIES SPIN3A.849
! MAXIMUM NUMBER OF HUMIDITIES SPIN3A.886
! SPIN3A.887
! SPIN3A.888
! SPIN3A.889
! GENERAL FIELDS: SPIN3A.890
! SPIN3A.891
LOGICAL SPIN3A.892
& L_PRESENT_RD(0: NPDR_TYPE) SPIN3A.893
! FLAG FOR TYPES OF DATA PRESENT SPIN3A.894
! SPIN3A.895
! SPIN3A.896
! SPIN3A.897
! PROPERTIES OF THE SPECTRAL BANDS: SPIN3A.898
! SPIN3A.899
INTEGER SPIN3A.900
& N_BAND_RD SPIN3A.901
! NUMBER OF SPECTRAL BANDS SPIN3A.902
! SPIN3A.903
REAL SPIN3A.904
& WAVE_LENGTH_SHORT_RD(NPDR_BAND) SPIN3A.905
! SHORTER WAVELENGTH LIMITS SPIN3A.906
& , WAVE_LENGTH_LONG_RD(NPDR_BAND) SPIN3A.907
! LONGER WAVELENGTH LIMITS SPIN3A.908
! SPIN3A.909
! SPIN3A.910
! SPIN3A.911
! EXCLUSION OF SPECIFIC BANDS FROM PARTS OF THE SPECTRUM: SPIN3A.912
INTEGER SPIN3A.913
& N_BAND_EXCLUDE_RD(NPDR_BAND) SPIN3A.914
! NUMBER OF EXCLUDED BANDS WITHIN EACH SPECTRAL BAND SPIN3A.915
& , INDEX_EXCLUDE_RD(NPDR_EXCLUDE, NPDR_BAND) SPIN3A.916
! INDICES OF EXCLUDED BANDS SPIN3A.917
! SPIN3A.918
! SPIN3A.919
! SPIN3A.920
! FIELDS FOR THE SOLAR FLUX: SPIN3A.921
! SPIN3A.922
REAL SPIN3A.923
& SOLAR_FLUX_BAND_RD(NPDR_BAND) SPIN3A.924
! FRACTION OF THE INCIDENT SOLAR FLUX IN EACH BAND SPIN3A.925
! SPIN3A.926
! SPIN3A.927
! SPIN3A.928
! FIELDS FOR RAYLEIGH SCATTERING: SPIN3A.929
! SPIN3A.930
REAL SPIN3A.931
& RAYLEIGH_COEFFICIENT_RD(NPDR_BAND) SPIN3A.932
! RAYLEIGH COEFFICIENTS SPIN3A.933
! SPIN3A.934
! SPIN3A.935
! SPIN3A.936
! FIELDS FOR GASEOUS ABSORPTION: SPIN3A.937
! SPIN3A.938
INTEGER SPIN3A.939
& N_ABSORB_RD SPIN3A.940
! NUMBER OF ABSORBERS SPIN3A.941
& , N_BAND_ABSORB_RD(NPDR_BAND) SPIN3A.942
! NUMBER OF ABSORBERS IN EACH BAND SPIN3A.943
& , INDEX_ABSORB_RD(NPDR_SPECIES, NPDR_BAND) SPIN3A.944
! LIST OF ABSORBERS IN EACH BAND SPIN3A.945
& , TYPE_ABSORB_RD(NPDR_SPECIES) SPIN3A.946
! TYPES OF EACH GAS IN THE SPECTRAL FILE SPIN3A.947
& , I_BAND_ESFT_RD(NPDR_BAND, NPDR_SPECIES) SPIN3A.948
! NUMBER OF ESFT TERMS IN BAND FOR EACH GAS SPIN3A.949
& , I_SCALE_ESFT_RD(NPDR_BAND, NPDR_SPECIES) SPIN3A.950
! TYPE OF ESFT SCALING SPIN3A.951
& , I_SCALE_FNC_RD(NPDR_BAND, NPDR_SPECIES) SPIN3A.952
! TYPE OF SCALING FUNCTION SPIN3A.953
! SPIN3A.954
REAL SPIN3A.955
& K_ESFT_RD(NPDR_ESFT_TERM, NPDR_BAND, NPDR_SPECIES) SPIN3A.956
! ESFT EXPONENTS SPIN3A.957
& , W_ESFT_RD(NPDR_ESFT_TERM, NPDR_BAND, NPDR_SPECIES) SPIN3A.958
! ESFT WEIGHTS SPIN3A.959
& , SCALE_VECTOR_RD(NPDR_SCALE_VARIABLE, NPDR_ESFT_TERM SPIN3A.960
& , NPDR_BAND, NPDR_SPECIES) SPIN3A.961
! SCALING PARAMETERS FOR EACH ABSORBER AND TERM SPIN3A.962
& , P_REFERENCE_RD(NPDR_SPECIES, NPDR_BAND) SPIN3A.963
! REFERENCE PRESSURE FOR SCALING FUNCTION SPIN3A.964
& , T_REFERENCE_RD(NPDR_SPECIES, NPDR_BAND) SPIN3A.965
! REFERENCE TEMPERATURE FOR SCALING FUNCTION SPIN3A.966
! SPIN3A.967
! SPIN3A.968
! SPIN3A.969
! REPRESENTATION OF THE PLANCKIAN: SPIN3A.970
! SPIN3A.971
INTEGER SPIN3A.972
& N_DEG_FIT_RD SPIN3A.973
! DEGREE OF THERMAL POLYNOMIAL SPIN3A.974
! SPIN3A.975
REAL SPIN3A.976
& THERMAL_COEFFICIENT_RD(0: NPDR_THERMAL_COEFF-1, NPDR_BAND) SPIN3A.977
! COEFFICIENTS IN POLYNOMIAL FIT TO SOURCE FUNCTION SPIN3A.978
& , T_REF_PLANCK_RD SPIN3A.979
! PLANCKIAN REFERENCE TEMPERATURE SPIN3A.980
! SPIN3A.981
! SPIN3A.982
! SPIN3A.983
! SURFACE PROPERTIES: SPIN3A.984
! SPIN3A.985
INTEGER SPIN3A.986
& I_SPEC_SURFACE_RD(NPDR_SURFACE) SPIN3A.987
! METHOD OF SPECIFYING PROPERTIES OF SURFACE SPIN3A.988
& , N_DIR_ALBEDO_FIT_RD(NPDR_SURFACE) SPIN3A.989
! NUMBER OF PARAMETERS FITTING THE DIRECT ALBEDO SPIN3A.990
! SPIN3A.991
LOGICAL SPIN3A.992
& L_SURFACE_RD(NPDR_SURFACE) SPIN3A.993
! SURFACE TYPES INCLUDED SPIN3A.994
! SPIN3A.995
REAL SPIN3A.996
& SURFACE_ALBEDO_RD(NPDR_BAND, NPDR_SURFACE) SPIN3A.997
! SURFACE ALBEDOS SPIN3A.998
& , DIRECT_ALBEDO_PARM_RD(0: NPDR_ALBEDO_PARM SPIN3A.999
& , NPD_BAND, NPD_SURFACE) SPIN3A.1000
! COEFFICIENTS FOR FITTING DIRECT ALBEDO SPIN3A.1001
& , EMISSIVITY_GROUND_RD(NPDR_BAND, NPDR_SURFACE) SPIN3A.1002
! SURFACE EMISSIVITIES SPIN3A.1003
! SPIN3A.1004
! SPIN3A.1005
! SPIN3A.1006
! FIELDS FOR CONTINUA: SPIN3A.1007
! SPIN3A.1008
INTEGER SPIN3A.1009
& N_BAND_CONTINUUM_RD(NPDR_BAND) SPIN3A.1010
! NUMBER OF CONTINUA IN EACH BAND SPIN3A.1011
& , INDEX_CONTINUUM_RD(NPDR_BAND, NPDR_CONTINUUM) SPIN3A.1012
! LIST OF CONTINUA IN EACH BAND ADB1F401.956
& , INDEX_WATER_RD SPIN3A.1014
! INDEX OF WATER VAPOUR SPIN3A.1015
& , I_SCALE_FNC_CONT_RD(NPDR_BAND, NPDR_CONTINUUM) SPIN3A.1016
! TYPE OF SCALING FUNCTION FOR CONTINUUM SPIN3A.1017
! SPIN3A.1018
REAL SPIN3A.1019
& K_CONTINUUM_RD(NPDR_BAND, NPDR_CONTINUUM) SPIN3A.1020
! GREY EXTINCTION COEFFICIENTS FOR CONTINUUM SPIN3A.1021
& , SCALE_CONTINUUM_RD(NPDR_SCALE_VARIABLE SPIN3A.1022
& , NPDR_BAND, NPDR_CONTINUUM) SPIN3A.1023
! SCALING PARAMETERS FOR CONTINUUM SPIN3A.1024
& , P_REF_CONTINUUM_RD(NPDR_CONTINUUM, NPDR_BAND) SPIN3A.1025
! REFERENCE PRESSURE FOR SCALING OF CONTINUUM SPIN3A.1026
& , T_REF_CONTINUUM_RD(NPDR_CONTINUUM, NPDR_BAND) SPIN3A.1027
! REFERENCE TEMPERATURE FOR SCALING OF CONTINUUM SPIN3A.1028
! SPIN3A.1029
! SPIN3A.1030
! SPIN3A.1031
! FIELDS FOR WATER DROPLETS: SPIN3A.1032
! SPIN3A.1033
INTEGER SPIN3A.1034
& I_DROP_PARAMETRIZATION_RD(NPDR_DROP_TYPE) SPIN3A.1035
! PARAMETRIZATION TYPE OF DROPLETS SPIN3A.1036
! SPIN3A.1037
LOGICAL SPIN3A.1038
& L_DROP_TYPE_RD(NPDR_DROP_TYPE) SPIN3A.1039
! TYPES OF DROPLET PRESENT SPIN3A.1040
! SPIN3A.1041
REAL SPIN3A.1042
& DROP_PARAMETER_LIST_RD(NPDR_CLOUD_PARAMETER SPIN3A.1043
& , NPDR_BAND, NPDR_DROP_TYPE) SPIN3A.1044
! PARAMETERS USED TO FIT OPTICAL PROPERTIES OF CLOUDS SPIN3A.1045
& , DROP_PARM_MIN_DIM_RD(NPDR_DROP_TYPE) ADB2F404.1459
! MINIMUM SIZE OF DROPLET PERMITTED IN THE PARAMETRIZATION ADB2F404.1460
& , DROP_PARM_MAX_DIM_RD(NPDR_DROP_TYPE) ADB2F404.1461
! MAXIMUM SIZE OF DROPLET PERMITTED IN THE PARAMETRIZATION ADB2F404.1462
! SPIN3A.1046
! SPIN3A.1047
! SPIN3A.1048
! FIELDS FOR AEROSOLS: SPIN3A.1049
! SPIN3A.1050
INTEGER SPIN3A.1051
& N_AEROSOL_RD SPIN3A.1052
! NUMBER OF SPECIES OF AEROSOL SPIN3A.1053
& , TYPE_AEROSOL_RD(NPDR_AEROSOL_SPECIES) SPIN3A.1054
! TYPES OF AEROSOLS SPIN3A.1055
& , I_AEROSOL_PARAMETRIZATION_RD(NPDR_AEROSOL_SPECIES) SPIN3A.1056
! PARAMETRIZATION OF AEROSOLS SPIN3A.1057
& , NHUMIDITY_RD(NPDR_AEROSOL_SPECIES) SPIN3A.1058
! NUMBERS OF HUMIDITIES SPIN3A.1059
! SPIN3A.1060
LOGICAL SPIN3A.1061
& L_AEROSOL_SPECIES_RD(NPDR_AEROSOL_SPECIES) SPIN3A.1062
! AEROSOL SPECIES INCLUDED SPIN3A.1063
! SPIN3A.1064
REAL SPIN3A.1065
& AEROSOL_ABSORPTION_RD(NPDR_HUMIDITIES, NPDR_AEROSOL_SPECIES SPIN3A.1066
& , NPDR_BAND) SPIN3A.1067
! ABSORPTION BY AEROSOLS SPIN3A.1068
& , AEROSOL_SCATTERING_RD(NPDR_HUMIDITIES, NPDR_AEROSOL_SPECIES SPIN3A.1069
& , NPDR_BAND) SPIN3A.1070
! SCATTERING BY AEROSOLS SPIN3A.1071
& , AEROSOL_ASYMMETRY_RD(NPDR_HUMIDITIES, NPDR_AEROSOL_SPECIES SPIN3A.1072
& , NPDR_BAND) SPIN3A.1073
! ASYMMETRY OF AEROSOLS SPIN3A.1074
& , HUMIDITIES_RD(NPDR_HUMIDITIES, NPDR_AEROSOL_SPECIES) SPIN3A.1075
! HUMIDITIES FOR COMPONENTS SPIN3A.1076
! SPIN3A.1077
! SPIN3A.1078
! SPIN3A.1079
! FIELDS FOR ICE CRYSTALS: SPIN3A.1080
! SPIN3A.1081
INTEGER SPIN3A.1082
& I_ICE_PARAMETRIZATION_RD(NPDR_ICE_TYPE) SPIN3A.1083
! TYPES OF PARAMETRIZATION OF ICE CRYSTALS SPIN3A.1084
! SPIN3A.1085
LOGICAL SPIN3A.1086
& L_ICE_TYPE_RD(NPDR_ICE_TYPE) SPIN3A.1087
! TYPES OF ICE CRYSTAL PRESENT SPIN3A.1088
! SPIN3A.1089
REAL SPIN3A.1090
& ICE_PARAMETER_LIST_RD(NPDR_CLOUD_PARAMETER SPIN3A.1091
& , NPDR_BAND, NPDR_ICE_TYPE) SPIN3A.1092
! PARAMETERS USED TO FIT SINGLE SCATTERING OF ICE CRYSTALS SPIN3A.1093
& , ICE_PARM_MIN_DIM_RD(NPDR_ICE_TYPE) ADB2F404.1463
! MINIMUM SIZE OF ICE CRYSTAL PERMITTED ADB2F404.1464
! IN THE PARAMETRIZATION ADB2F404.1465
& , ICE_PARM_MAX_DIM_RD(NPDR_ICE_TYPE) ADB2F404.1466
! MAXIMUM SIZE OF ICE CRYSTAL PERMITTED ADB2F404.1467
! IN THE PARAMETRIZATION ADB2F404.1468
! SPIN3A.1094
! SPIN3A.1095
! SPIN3A.1096
! FIELDS FOR DOPPLER BROADENING: SPIN3A.1097
! SPIN3A.1098
LOGICAL SPIN3A.1099
& L_DOPPLER_PRESENT_RD(NPDR_SPECIES) SPIN3A.1100
! FLAG FOR DOPPLER BROADENING FOR EACH SPECIES SPIN3A.1101
! SPIN3A.1102
REAL SPIN3A.1103
& DOPPLER_CORRECTION_RD(NPDR_SPECIES) SPIN3A.1104
! DOPPLER CORRECTION TERMS SPIN3A.1105
! SPIN3A.1106
! SPIN3A.1107
! SPIN3A.1108
! LOCAL VARIABLES. SPIN3A.1109
INTEGER SPIN3A.1110
& I SPIN3A.1111
! LOOP VARIABLE SPIN3A.1112
& , J SPIN3A.1113
! LOOP VARIABLE SPIN3A.1114
& , K SPIN3A.1115
! LOOP VARIABLE SPIN3A.1116
& , L SPIN3A.1117
! LOOP VARIABLE SPIN3A.1118
& , N_PARAMETER SPIN3A.1119
! NUMBER OF PARAMETERS IN SCHEME. SPIN3A.1120
& , I_SPECIES SPIN3A.1121
! SPECIES OF GAS SPIN3A.1122
& , I_CONTINUUM ADB1F405.905
! TYPE OF CONTINUUM ADB1F405.906
& , I_INITIAL ADB2F404.1469
! INDEXING NUMBER IN INITIAL SPECTRAL FILE ADB2F404.1470
! SPIN3A.1123
! SPIN3A.1124
*CALL SCLFNC3A SPIN3A.1125
*CALL WCLPRM3A SPIN3A.1126
*CALL ICLPRM3A SPIN3A.1127
*CALL AERPRM3A SPIN3A.1128
*CALL SCLFND3A SPIN3A.1129
! SPIN3A.1130
! SPIN3A.1131
! SPIN3A.1132
! SPIN3A.1151
! SPIN3A.1152
! INITAILIZE ALL BLOCKS OF THE COMPRESSED SPECTRUM TO .FALSE. ADB1F401.957
DO I=1, NPDR_TYPE ADB2F404.1471
L_PRESENT_RD(I)=.FALSE. ADB1F401.959
ENDDO ADB1F401.960
! ADB1F401.961
! ADB1F401.962
! PROCEED THROUGH EACH BLOCK OF THE SPECTRAL FILE TRANSFERRING SPIN3A.1153
! THE DATA FROM THE INPUT ARRAY TO THE REDUCED ARRAY. SPIN3A.1154
! SPIN3A.1155
! SPIN3A.1156
! BLOCK 0: SPIN3A.1157
! SPIN3A.1158
IF (L_PRESENT(0)) THEN SPIN3A.1159
L_PRESENT_RD(0)=.TRUE. ADB1F401.963
N_BAND_RD=N_BAND SPIN3A.1160
N_ABSORB_RD=N_ABSORB_RETAIN ADB1F405.907
N_AEROSOL_RD=N_AEROSOL_RETAIN ADB2F404.1472
DO I=1, N_ABSORB_RETAIN ADB1F405.908
TYPE_ABSORB_RD(I)=TYPE_ABSORB(INDEX_ABSORB_RETAIN(I)) ADB1F405.909
ENDDO SPIN3A.1165
DO I=1, N_AEROSOL_RETAIN ADB2F404.1473
TYPE_AEROSOL_RD(I)=TYPE_AEROSOL(INDEX_AEROSOL_RETAIN(I)) ADB2F404.1474
ENDDO SPIN3A.1168
ENDIF SPIN3A.1169
! SPIN3A.1170
! BLOCK 1: SPIN3A.1171
IF (L_PRESENT(1)) THEN SPIN3A.1172
L_PRESENT_RD(1)=.TRUE. ADB1F401.964
DO I=1, N_BAND SPIN3A.1173
WAVE_LENGTH_SHORT_RD(I)=WAVE_LENGTH_SHORT(I) SPIN3A.1174
WAVE_LENGTH_LONG_RD(I)=WAVE_LENGTH_LONG(I) SPIN3A.1175
ENDDO SPIN3A.1176
ENDIF SPIN3A.1177
! SPIN3A.1178
! BLOCK 2: SPIN3A.1179
IF (L_PRESENT(2)) THEN SPIN3A.1180
L_PRESENT_RD(2)=.TRUE. ADB1F401.965
DO I=1, N_BAND SPIN3A.1181
SOLAR_FLUX_BAND_RD(I)=SOLAR_FLUX_BAND(I) SPIN3A.1182
ENDDO SPIN3A.1183
ENDIF SPIN3A.1184
! SPIN3A.1185
! BLOCK 3: SPIN3A.1186
IF (L_PRESENT(3)) THEN SPIN3A.1187
L_PRESENT_RD(3)=.TRUE. ADB1F401.966
DO I=1, N_BAND SPIN3A.1188
RAYLEIGH_COEFFICIENT_RD(I)=RAYLEIGH_COEFFICIENT(I) SPIN3A.1189
ENDDO SPIN3A.1190
ENDIF SPIN3A.1191
! SPIN3A.1192
! BLOCK 4: SPIN3A.1193
IF (L_PRESENT(4)) THEN SPIN3A.1194
L_PRESENT_RD(4)=.TRUE. ADB1F401.967
DO I=1, N_BAND SPIN3A.1195
N_BAND_ABSORB_RD(I)=0 ADB1F405.910
DO J=1, N_BAND_ABSORB(I) SPIN3A.1197
IF (L_RETAIN_ABSORB(INDEX_ABSORB(J, I))) THEN ADB1F405.911
N_BAND_ABSORB_RD(I)=N_BAND_ABSORB_RD(I)+1 ADB1F405.912
INDEX_ABSORB_RD(N_BAND_ABSORB_RD(I), I) ADB1F405.913
& =COMPRESSED_INDEX(INDEX_ABSORB(J, I)) ADB1F405.914
ENDIF ADB1F405.915
ENDDO SPIN3A.1199
ENDDO SPIN3A.1200
ENDIF SPIN3A.1201
! SPIN3A.1202
! BLOCK 5: SPIN3A.1203
IF (L_PRESENT(5)) THEN SPIN3A.1204
L_PRESENT_RD(5)=.TRUE. ADB1F401.968
DO I=1, N_BAND SPIN3A.1205
DO J=1, N_BAND_ABSORB_RD(I) ADB1F405.916
I_SPECIES=INDEX_ABSORB_RD(J, I) SPIN3A.1207
I_INITIAL=INDEX_ABSORB_RETAIN(I_SPECIES) ADB1F405.917
I_BAND_ESFT_RD(I, I_SPECIES)=I_BAND_ESFT(I, I_INITIAL) ADB1F405.918
I_SCALE_ESFT_RD(I, I_SPECIES)=I_SCALE_ESFT(I, I_INITIAL) ADB1F405.919
I_SCALE_FNC_RD(I, I_SPECIES)=I_SCALE_FNC(I, I_INITIAL) ADB1F405.920
P_REFERENCE_RD(I_SPECIES, I)=P_REFERENCE(I_INITIAL, I) ADB1F405.921
T_REFERENCE_RD(I_SPECIES, I)=T_REFERENCE(I_INITIAL, I) ADB1F405.922
DO K=1, I_BAND_ESFT(I, I_INITIAL) ADB1F405.923
K_ESFT_RD(K, I, I_SPECIES)=K_ESFT(K, I, I_INITIAL) ADB1F405.924
W_ESFT_RD(K, I, I_SPECIES)=W_ESFT(K, I, I_INITIAL) ADB1F405.925
DO L=1, N_SCALE_VARIABLE(I_SCALE_FNC(I, I_INITIAL)) ADB1F405.926
SCALE_VECTOR_RD(L, K, I, I_SPECIES) SPIN3A.1217
& =SCALE_VECTOR(L, K, I, I_INITIAL) ADB1F405.927
ENDDO SPIN3A.1219
ENDDO SPIN3A.1220
ENDDO SPIN3A.1221
ENDDO SPIN3A.1222
ENDIF SPIN3A.1223
! SPIN3A.1224
! BLOCK 6: SPIN3A.1225
IF (L_PRESENT(6)) THEN SPIN3A.1226
L_PRESENT_RD(6)=.TRUE. ADB1F401.969
N_DEG_FIT_RD=N_DEG_FIT SPIN3A.1227
T_REF_PLANCK_RD=T_REF_PLANCK SPIN3A.1228
DO I=1, N_BAND SPIN3A.1229
DO J=0, N_DEG_FIT SPIN3A.1230
THERMAL_COEFFICIENT_RD(J, I)=THERMAL_COEFFICIENT(J, I) SPIN3A.1231
ENDDO SPIN3A.1232
ENDDO SPIN3A.1233
ENDIF SPIN3A.1234
! SPIN3A.1235
! BLOCK 7: SPIN3A.1236
! SPIN3A.1237
! OMITTED SINCE SURFACE ALBEDOS ARE PROVIDED BY THE MODEL. SPIN3A.1238
! SPIN3A.1239
! BLOCK 8: SPIN3A.1240
IF (L_PRESENT(8)) THEN SPIN3A.1241
L_PRESENT_RD(8)=.TRUE. ADB1F401.970
DO I=1, N_BAND SPIN3A.1242
N_BAND_CONTINUUM_RD(I)=N_BAND_CONTINUUM(I) SPIN3A.1243
DO J=1, N_BAND_CONTINUUM(I) SPIN3A.1244
INDEX_CONTINUUM_RD(I, J)=INDEX_CONTINUUM(I, J) SPIN3A.1245
ENDDO SPIN3A.1246
ENDDO SPIN3A.1247
! ADB1F405.928
INDEX_WATER_RD=0 ADB1F405.929
DO I=1, N_ABSORB_RETAIN ADB1F405.930
IF (INDEX_ABSORB_RETAIN(I).EQ.INDEX_WATER) THEN ADB1F405.931
INDEX_WATER_RD=I ADB1F405.932
ENDIF ADB1F405.933
ENDDO ADB1F405.934
! ADB1F405.935
ENDIF SPIN3A.1249
! SPIN3A.1250
! BLOCK 9: SPIN3A.1251
IF (L_PRESENT(9)) THEN SPIN3A.1252
L_PRESENT_RD(9)=.TRUE. ADB1F401.971
DO I=1, N_BAND SPIN3A.1253
DO J=1, N_BAND_CONTINUUM(I) SPIN3A.1254
I_CONTINUUM=INDEX_CONTINUUM(I, J) SPIN3A.1255
I_SCALE_FNC_CONT_RD(I, I_CONTINUUM) SPIN3A.1256
& =I_SCALE_FNC_CONT(I, I_CONTINUUM) SPIN3A.1257
P_REF_CONTINUUM_RD(I_CONTINUUM, I) SPIN3A.1258
& =P_REF_CONTINUUM(I_CONTINUUM, I) SPIN3A.1259
T_REF_CONTINUUM_RD(I_CONTINUUM, I) SPIN3A.1260
& =T_REF_CONTINUUM(I_CONTINUUM, I) SPIN3A.1261
K_CONTINUUM_RD(I, I_CONTINUUM) SPIN3A.1262
& =K_CONTINUUM(I, I_CONTINUUM) SPIN3A.1263
DO L=1, N_SCALE_VARIABLE(I_SCALE_FNC_CONT SPIN3A.1264
& (I, I_CONTINUUM)) SPIN3A.1265
SCALE_CONTINUUM_RD(L, I, I_CONTINUUM) SPIN3A.1266
& =SCALE_CONTINUUM(L, I, I_CONTINUUM) SPIN3A.1267
ENDDO SPIN3A.1268
ENDDO SPIN3A.1269
ENDDO SPIN3A.1270
ENDIF SPIN3A.1271
! SPIN3A.1272
! BLOCK 10: SPIN3A.1273
IF (L_PRESENT(10)) THEN SPIN3A.1274
L_PRESENT_RD(10)=.TRUE. ADB1F401.972
DO I=1, NPDR_DROP_TYPE SPIN3A.1275
IF (L_DROP_TYPE(I)) THEN SPIN3A.1276
L_DROP_TYPE_RD(I)=.TRUE. SPIN3A.1277
I_DROP_PARAMETRIZATION_RD(I)=I_DROP_PARAMETRIZATION(I) SPIN3A.1278
DROP_PARM_MIN_DIM_RD(I)=DROP_PARM_MIN_DIM(I) ADB2F404.1475
DROP_PARM_MAX_DIM_RD(I)=DROP_PARM_MAX_DIM(I) ADB2F404.1476
IF (I_DROP_PARAMETRIZATION(I) SPIN3A.1279
& .EQ.IP_SLINGO_SCHRECKER) THEN SPIN3A.1280
N_PARAMETER=6 SPIN3A.1281
ELSE IF (I_DROP_PARAMETRIZATION(I) SPIN3A.1282
& .EQ.IP_ACKERMAN_STEPHENS) THEN SPIN3A.1283
N_PARAMETER=9 SPIN3A.1284
ELSE IF (I_DROP_PARAMETRIZATION(I) ADB1F405.936
& .EQ.IP_DROP_PADE_2) THEN ADB1F405.937
N_PARAMETER=16 ADB1F405.938
ENDIF SPIN3A.1285
! SPIN3A.1286
DO J=1, N_PARAMETER SPIN3A.1287
DO K=1, N_BAND SPIN3A.1288
DROP_PARAMETER_LIST_RD(J, K, I) SPIN3A.1289
& =DROP_PARAMETER_LIST(J, K, I) SPIN3A.1290
ENDDO SPIN3A.1291
ENDDO SPIN3A.1292
ELSE SPIN3A.1293
L_DROP_TYPE_RD(I)=.FALSE. SPIN3A.1294
ENDIF SPIN3A.1295
ENDDO SPIN3A.1296
ENDIF SPIN3A.1297
! SPIN3A.1298
! BLOCK 11: SPIN3A.1299
IF (L_PRESENT(11)) THEN SPIN3A.1300
L_PRESENT_RD(11)=.TRUE. ADB1F401.973
DO I=1, N_AEROSOL_RETAIN ADB2F404.1477
I_INITIAL=INDEX_AEROSOL_RETAIN(I) ADB2F404.1478
IF (L_AEROSOL_SPECIES(I_INITIAL)) THEN ADB2F404.1479
L_AEROSOL_SPECIES_RD(I)=.TRUE. SPIN3A.1303
I_AEROSOL_PARAMETRIZATION_RD(I) SPIN3A.1304
& =I_AEROSOL_PARAMETRIZATION(I_INITIAL) ADB2F404.1480
IF (I_AEROSOL_PARAMETRIZATION(I_INITIAL) ADB2F404.1481
& .EQ.IP_AEROSOL_PARAM_DRY) THEN SPIN3A.1307
NHUMIDITY_RD(I)=0 SPIN3A.1308
DO K=1, N_BAND SPIN3A.1309
AEROSOL_ABSORPTION_RD(1, I, K) SPIN3A.1310
& =AEROSOL_ABSORPTION(1, I_INITIAL, K) ADB2F404.1482
AEROSOL_SCATTERING_RD(1, I, K) SPIN3A.1312
& =AEROSOL_SCATTERING(1, I_INITIAL, K) ADB2F404.1483
AEROSOL_ASYMMETRY_RD(1, I, K) SPIN3A.1314
& =AEROSOL_ASYMMETRY(1, I_INITIAL, K) ADB2F404.1484
ENDDO SPIN3A.1316
ELSE IF (I_AEROSOL_PARAMETRIZATION(I_INITIAL) ADB2F404.1485
& .EQ.IP_AEROSOL_PARAM_MOIST) THEN SPIN3A.1318
INDEX_WATER_RD=INDEX_WATER AWO1F403.37
NHUMIDITY_RD(I)=NHUMIDITY(I_INITIAL) ADB2F404.1486
DO J=1, NHUMIDITY(I_INITIAL) ADB2F404.1487
HUMIDITIES_RD(J, I)=HUMIDITIES(J, I_INITIAL) ADB2F404.1488
DO K=1, N_BAND SPIN3A.1322
AEROSOL_ABSORPTION_RD(J, I, K) SPIN3A.1323
& =AEROSOL_ABSORPTION(J, I_INITIAL, K) ADB2F404.1489
AEROSOL_SCATTERING_RD(J, I, K) SPIN3A.1325
& =AEROSOL_SCATTERING(J, I_INITIAL, K) ADB2F404.1490
AEROSOL_ASYMMETRY_RD(J, I, K) SPIN3A.1327
& =AEROSOL_ASYMMETRY(J, I_INITIAL, K) ADB2F404.1491
ENDDO SPIN3A.1329
ENDDO SPIN3A.1330
ENDIF SPIN3A.1331
! SPIN3A.1332
ELSE SPIN3A.1333
L_AEROSOL_SPECIES_RD(I)=.FALSE. SPIN3A.1334
ENDIF SPIN3A.1335
ENDDO SPIN3A.1336
ENDIF SPIN3A.1337
! SPIN3A.1338
! BLOCK 12: SPIN3A.1339
IF (L_PRESENT(12)) THEN SPIN3A.1340
L_PRESENT_RD(12)=.TRUE. ADB1F401.974
DO I=1, NPDR_ICE_TYPE SPIN3A.1341
IF (L_ICE_TYPE(I)) THEN SPIN3A.1342
L_ICE_TYPE_RD(I)=.TRUE. SPIN3A.1343
ICE_PARM_MIN_DIM_RD(I)=ICE_PARM_MIN_DIM(I) ADB2F404.1492
ICE_PARM_MAX_DIM_RD(I)=ICE_PARM_MAX_DIM(I) ADB2F404.1493
! SPIN3A.1344
I_ICE_PARAMETRIZATION_RD(I)=I_ICE_PARAMETRIZATION(I) SPIN3A.1345
IF (I_ICE_PARAMETRIZATION(I) SPIN3A.1346
& .EQ.IP_SLINGO_SCHRECKER_ICE) THEN SPIN3A.1347
N_PARAMETER=6 SPIN3A.1348
ELSE IF (I_ICE_PARAMETRIZATION(I) SPIN3A.1349
& .EQ.IP_SUN_SHINE_VN2_VIS) THEN SPIN3A.1353
N_PARAMETER=6 SPIN3A.1354
ELSE IF (I_ICE_PARAMETRIZATION(I) SPIN3A.1355
& .EQ.IP_SUN_SHINE_VN2_IR) THEN SPIN3A.1356
N_PARAMETER=0 SPIN3A.1357
ELSE IF (I_ICE_PARAMETRIZATION(I) ADB2F404.1494
& .EQ.IP_ICE_ADT) THEN ADB2F404.1495
N_PARAMETER=30 ADB2F404.1496
ENDIF SPIN3A.1358
! SPIN3A.1359
DO J=1, N_PARAMETER SPIN3A.1360
DO K=1, N_BAND SPIN3A.1361
ICE_PARAMETER_LIST_RD(J, K, I) SPIN3A.1362
& =ICE_PARAMETER_LIST(J, K, I) SPIN3A.1363
ENDDO SPIN3A.1364
ENDDO SPIN3A.1365
ELSE SPIN3A.1366
L_ICE_TYPE_RD(I)=.FALSE. SPIN3A.1367
ENDIF SPIN3A.1368
ENDDO SPIN3A.1369
ENDIF SPIN3A.1370
! SPIN3A.1371
! BLOCK 13: SPIN3A.1372
IF (L_PRESENT(13)) THEN SPIN3A.1373
L_PRESENT_RD(13)=.TRUE. ADB1F401.975
DO I=1, N_ABSORB SPIN3A.1374
IF (L_RETAIN_ABSORB(I)) THEN ADB1F405.939
L_DOPPLER_PRESENT_RD(COMPRESSED_INDEX(I)) ADB1F405.940
& =L_DOPPLER_PRESENT(I) ADB1F405.941
IF (L_DOPPLER_PRESENT(I)) ADB1F405.942
& DOPPLER_CORRECTION_RD(COMPRESSED_INDEX(I)) ADB1F405.943
& =DOPPLER_CORRECTION(I) ADB1F405.944
ENDIF ADB1F405.945
ENDDO SPIN3A.1379
ENDIF SPIN3A.1380
! SPIN3A.1381
! SPIN3A.1382
! BLOCK 14: ADB1F401.976
IF (L_PRESENT(14)) THEN ADB1F401.977
L_PRESENT_RD(14)=.TRUE. ADB1F401.978
DO I=1, N_BAND ADB1F401.979
N_BAND_EXCLUDE_RD(I)=N_BAND_EXCLUDE(I) ADB1F401.980
DO J=1, N_BAND_EXCLUDE(I) ADB1F401.981
INDEX_EXCLUDE_RD(J, I)=INDEX_EXCLUDE(J, I) ADB1F401.982
ENDDO ADB1F401.983
ENDDO ADB1F401.984
ENDIF ADB1F401.985
! SPIN3A.1588
! SPIN3A.1589
! SPIN3A.1590
RETURN SPIN3A.1591
END SPIN3A.1592
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SPIN3A.1593
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.106