Changeset 3607 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Dec 7, 2018 11:56:58 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
- Property svn:mergeinfo changed
r3589 r3607 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Output of radiation-related quantities migrated to radiation_model_mod. 31 ! 32 ! 3589 2018-11-30 15:09:51Z suehring 30 33 ! Remove erroneous UTF encoding 31 34 ! … … 545 548 message_string, plant_canopy, pt_surface, & 546 549 rho_surface, simulated_time, spinup_time, surface_pressure, & 547 time_since_reference_point, urban_surface 550 time_since_reference_point, urban_surface, varnamelength 548 551 549 552 USE cpulog, & … … 899 902 INTEGER(iwp) :: nwalls !< number of wall surfaces in local processor 900 903 904 !-- indices needed for RTM netcdf output subroutines 905 INTEGER(iwp), PARAMETER :: nd = 5 906 CHARACTER(LEN=6), DIMENSION(0:nd-1), PARAMETER :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /) 907 INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint_u = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /) 908 INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER :: dirint_l = (/ iup_l, isouth_l, inorth_l, iwest_l, ieast_l /) 909 INTEGER(iwp), DIMENSION(0:nd-1) :: dirstart 910 INTEGER(iwp), DIMENSION(0:nd-1) :: dirend 911 901 912 !-- indices and sizes of urban and land surface models 902 913 INTEGER(iwp), DIMENSION(:), ALLOCATABLE,TARGET :: surfl_l !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x] … … 1065 1076 REAL(wp), DIMENSION(:), ALLOCATABLE :: rt2_dist 1066 1077 1078 !-- arrays for time averages 1079 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfradnet_av !< average of net radiation to local surface including radiation from reflections 1080 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw_av !< average of sw radiation falling to local surface including radiation from reflections 1081 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw_av !< average of lw radiation falling to local surface including radiation from reflections 1082 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdir_av !< average of direct sw radiation falling to local surface 1083 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdif_av !< average of diffuse sw radiation from sky and model boundary falling to local surface 1084 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwdif_av !< average of diffuse lw radiation from sky and model boundary falling to local surface 1085 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswref_av !< average of sw radiation falling to surface from reflections 1086 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwref_av !< average of lw radiation falling to surface from reflections 1087 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw_av !< average of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection 1088 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw_av !< average of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection 1089 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in surface after last reflection 1090 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in surface after last reflection 1091 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinlw_av !< Average of pcbinlw 1092 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinsw_av !< Average of pcbinsw 1093 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswdir_av !< Average of pcbinswdir 1094 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswdif_av !< Average of pcbinswdif 1095 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswref_av !< Average of pcbinswref 1067 1096 1068 1097 … … 1208 1237 skip_time_do_radiation, time_radiation, unscheduled_radiation_calls,& 1209 1238 zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon, & 1210 nrefsteps, nsvfl, svf, & 1211 svfsurf, surfinsw, surfinlw, surfins, surfinl, surfinswdir, & 1212 surfinswdif, surfoutsw, surfoutlw, surfinlwdif, rad_sw_in_dir, & 1213 rad_sw_in_diff, rad_lw_in_diff, surfouts, surfoutl, surfoutsl, & 1214 surfoutll, idir, jdir, kdir, id, iz, iy, ix, & 1215 surf, surfl, nsurfl, pcbinswdir, pcbinswdif, pcbinsw, pcbinlw, & 1239 idir, jdir, kdir, id, iz, iy, ix, & 1216 1240 iup_u, inorth_u, isouth_u, ieast_u, iwest_u, & 1217 1241 iup_l, inorth_l, isouth_l, ieast_l, iwest_l, & … … 1219 1243 idsvf, ndsvf, idcsf, ndcsf, kdcsf, pct, & 1220 1244 radiation_interactions, startwall, startland, endland, endwall, & 1221 skyvf, skyvft, radiation_interactions_on, average_radiation , npcbl, &1222 pcbl 1245 skyvf, skyvft, radiation_interactions_on, average_radiation 1246 1223 1247 1224 1248 #if defined ( __rrtmg ) … … 1263 1287 !> Check data output for radiation model 1264 1288 !------------------------------------------------------------------------------! 1265 SUBROUTINE radiation_check_data_output( var , unit, i, ilen, k )1289 SUBROUTINE radiation_check_data_output( variable, unit, i, ilen, k ) 1266 1290 1267 1291 … … 1271 1295 IMPLICIT NONE 1272 1296 1273 CHARACTER (LEN=*) :: unit !<1274 CHARACTER (LEN=*) :: var !<1275 1276 INTEGER(iwp) :: i 1297 CHARACTER (LEN=*) :: unit !< 1298 CHARACTER (LEN=*) :: variable !< 1299 1300 INTEGER(iwp) :: i, j, k, l 1277 1301 INTEGER(iwp) :: ilen 1278 INTEGER(iwp) :: k 1279 1280 SELECT CASE ( TRIM( var ) ) 1281 1282 CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_lw_in', 'rad_lw_out', & 1283 'rad_sw_cs_hr', 'rad_sw_hr', 'rad_sw_in', 'rad_sw_out' ) 1284 IF ( .NOT. radiation .OR. radiation_scheme /= 'rrtmg' ) THEN 1285 message_string = '"output of "' // TRIM( var ) // '" requi' // & 1286 'res radiation = .TRUE. and ' // & 1287 'radiation_scheme = "rrtmg"' 1288 CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 ) 1289 ENDIF 1290 unit = 'K/h' 1291 1292 CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', & 1293 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', & 1294 'rad_sw_out*') 1295 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1296 ! Workaround for masked output (calls with i=ilen=k=0) 1297 unit = 'illegal' 1298 RETURN 1299 ENDIF 1300 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 1301 message_string = 'illegal value for data_output: "' // & 1302 TRIM( var ) // '" & only 2d-horizontal ' // & 1303 'cross sections are allowed for this value' 1304 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) 1305 ENDIF 1306 IF ( .NOT. radiation .OR. radiation_scheme /= "rrtmg" ) THEN 1307 IF ( TRIM( var ) == 'rrtm_aldif*' .OR. & 1308 TRIM( var ) == 'rrtm_aldir*' .OR. & 1309 TRIM( var ) == 'rrtm_asdif*' .OR. & 1310 TRIM( var ) == 'rrtm_asdir*' ) & 1311 THEN 1312 message_string = 'output of "' // TRIM( var ) // '" require'& 1313 // 's radiation = .TRUE. and radiation_sch'& 1314 // 'eme = "rrtmg"' 1315 CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 ) 1316 ENDIF 1317 ENDIF 1318 1319 IF ( TRIM( var ) == 'rad_net*' ) unit = 'W/m2' 1320 IF ( TRIM( var ) == 'rad_lw_in*' ) unit = 'W/m2' 1321 IF ( TRIM( var ) == 'rad_lw_out*' ) unit = 'W/m2' 1322 IF ( TRIM( var ) == 'rad_sw_in*' ) unit = 'W/m2' 1323 IF ( TRIM( var ) == 'rad_sw_out*' ) unit = 'W/m2' 1324 IF ( TRIM( var ) == 'rad_sw_in' ) unit = 'W/m2' 1325 IF ( TRIM( var ) == 'rrtm_aldif*' ) unit = '' 1326 IF ( TRIM( var ) == 'rrtm_aldir*' ) unit = '' 1327 IF ( TRIM( var ) == 'rrtm_asdif*' ) unit = '' 1328 IF ( TRIM( var ) == 'rrtm_asdir*' ) unit = '' 1329 1330 CASE ( 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' ) 1331 1332 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1333 ! Workaround for masked output (calls with i=ilen=k=0) 1334 unit = 'illegal' 1335 RETURN 1336 ENDIF 1337 1338 IF ( .NOT. radiation ) THEN 1302 CHARACTER(LEN=varnamelength) :: var !< TRIM(variable) 1303 1304 var = TRIM(variable) 1305 1306 !-- first process diractional variables 1307 IF ( var(1:12) == 'rtm_rad_net_' .OR. var(1:13) == 'rtm_rad_insw_' .OR. & 1308 var(1:13) == 'rtm_rad_inlw_' .OR. var(1:16) == 'rtm_rad_inswdir_' .OR. & 1309 var(1:16) == 'rtm_rad_inswdif_' .OR. var(1:16) == 'rtm_rad_inswref_' .OR. & 1310 var(1:16) == 'rtm_rad_inlwdif_' .OR. var(1:16) == 'rtm_rad_inlwref_' .OR. & 1311 var(1:14) == 'rtm_rad_outsw_' .OR. var(1:14) == 'rtm_rad_outlw_' .OR. & 1312 var(1:14) == 'rtm_rad_ressw_' .OR. var(1:14) == 'rtm_rad_reslw_' ) THEN 1313 IF ( .NOT. radiation ) THEN 1339 1314 message_string = 'output of "' // TRIM( var ) // '" require'& 1340 1315 // 's radiation = .TRUE.' 1341 1316 CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 ) 1342 ENDIF 1343 IF ( mrt_nlevels == 0 ) THEN 1317 ENDIF 1318 unit = 'W/m2' 1319 ELSE IF ( var(1:7) == 'rtm_svf' .OR. var(1:7) == 'rtm_dif' .OR. & 1320 var(1:9) == 'rtm_skyvf' .OR. var(1:9) == 'rtm_skyvft' ) THEN 1321 IF ( .NOT. radiation ) THEN 1344 1322 message_string = 'output of "' // TRIM( var ) // '" require'& 1345 // 's mrt_nlevels > 0' 1346 CALL message( 'check_parameters', 'PA0510', 1, 2, 0, 6, 0 ) 1347 ENDIF 1348 IF ( TRIM( var ) == 'rad_mrt_sw' .AND. .NOT. mrt_include_sw ) THEN 1349 message_string = 'output of "' // TRIM( var ) // '" require'& 1350 // 's rad_mrt_sw = .TRUE.' 1351 CALL message( 'check_parameters', 'PA0511', 1, 2, 0, 6, 0 ) 1352 ENDIF 1353 IF ( TRIM( var ) == 'rad_mrt' ) THEN 1354 unit = 'K' 1355 ELSE 1356 unit = 'W m-2' 1357 ENDIF 1358 1359 CASE DEFAULT 1360 unit = 'illegal' 1361 1362 END SELECT 1363 1323 // 's radiation = .TRUE.' 1324 CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 ) 1325 ENDIF 1326 unit = '1' 1327 ELSE 1328 !-- non-directional variables 1329 SELECT CASE ( TRIM( var ) ) 1330 CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_lw_in', 'rad_lw_out', & 1331 'rad_sw_cs_hr', 'rad_sw_hr', 'rad_sw_in', 'rad_sw_out' ) 1332 IF ( .NOT. radiation .OR. radiation_scheme /= 'rrtmg' ) THEN 1333 message_string = '"output of "' // TRIM( var ) // '" requi' // & 1334 'res radiation = .TRUE. and ' // & 1335 'radiation_scheme = "rrtmg"' 1336 CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 ) 1337 ENDIF 1338 unit = 'K/h' 1339 1340 CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', & 1341 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', & 1342 'rad_sw_out*') 1343 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1344 ! Workaround for masked output (calls with i=ilen=k=0) 1345 unit = 'illegal' 1346 RETURN 1347 ENDIF 1348 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 1349 message_string = 'illegal value for data_output: "' // & 1350 TRIM( var ) // '" & only 2d-horizontal ' // & 1351 'cross sections are allowed for this value' 1352 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) 1353 ENDIF 1354 IF ( .NOT. radiation .OR. radiation_scheme /= "rrtmg" ) THEN 1355 IF ( TRIM( var ) == 'rrtm_aldif*' .OR. & 1356 TRIM( var ) == 'rrtm_aldir*' .OR. & 1357 TRIM( var ) == 'rrtm_asdif*' .OR. & 1358 TRIM( var ) == 'rrtm_asdir*' ) & 1359 THEN 1360 message_string = 'output of "' // TRIM( var ) // '" require'& 1361 // 's radiation = .TRUE. and radiation_sch'& 1362 // 'eme = "rrtmg"' 1363 CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 ) 1364 ENDIF 1365 ENDIF 1366 1367 IF ( TRIM( var ) == 'rad_net*' ) unit = 'W/m2' 1368 IF ( TRIM( var ) == 'rad_lw_in*' ) unit = 'W/m2' 1369 IF ( TRIM( var ) == 'rad_lw_out*' ) unit = 'W/m2' 1370 IF ( TRIM( var ) == 'rad_sw_in*' ) unit = 'W/m2' 1371 IF ( TRIM( var ) == 'rad_sw_out*' ) unit = 'W/m2' 1372 IF ( TRIM( var ) == 'rad_sw_in' ) unit = 'W/m2' 1373 IF ( TRIM( var ) == 'rrtm_aldif*' ) unit = '' 1374 IF ( TRIM( var ) == 'rrtm_aldir*' ) unit = '' 1375 IF ( TRIM( var ) == 'rrtm_asdif*' ) unit = '' 1376 IF ( TRIM( var ) == 'rrtm_asdir*' ) unit = '' 1377 1378 CASE ( 'rtm_rad_pc_inlw', 'rtm_rad_pc_insw', 'rtm_rad_pc_inswdir', & 1379 'rtm_rad_pc_inswdif', 'rtm_rad_pc_inswref') 1380 IF ( .NOT. radiation ) THEN 1381 message_string = 'output of "' // TRIM( var ) // '" require'& 1382 // 's radiation = .TRUE.' 1383 CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 ) 1384 ENDIF 1385 unit = 'W' 1386 1387 CASE ( 'rtm_mrt', 'rtm_mrt_sw', 'rtm_mrt_lw' ) 1388 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1389 ! Workaround for masked output (calls with i=ilen=k=0) 1390 unit = 'illegal' 1391 RETURN 1392 ENDIF 1393 1394 IF ( .NOT. radiation ) THEN 1395 message_string = 'output of "' // TRIM( var ) // '" require'& 1396 // 's radiation = .TRUE.' 1397 CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 ) 1398 ENDIF 1399 IF ( mrt_nlevels == 0 ) THEN 1400 message_string = 'output of "' // TRIM( var ) // '" require'& 1401 // 's mrt_nlevels > 0' 1402 CALL message( 'check_parameters', 'PA0510', 1, 2, 0, 6, 0 ) 1403 ENDIF 1404 IF ( TRIM( var ) == 'rtm_mrt_sw' .AND. .NOT. mrt_include_sw ) THEN 1405 message_string = 'output of "' // TRIM( var ) // '" require'& 1406 // 's rtm_mrt_sw = .TRUE.' 1407 CALL message( 'check_parameters', 'PA0511', 1, 2, 0, 6, 0 ) 1408 ENDIF 1409 IF ( TRIM( var ) == 'rtm_mrt' ) THEN 1410 unit = 'K' 1411 ELSE 1412 unit = 'W m-2' 1413 ENDIF 1414 1415 CASE DEFAULT 1416 unit = 'illegal' 1417 1418 END SELECT 1419 ENDIF 1364 1420 1365 1421 END SUBROUTINE radiation_check_data_output … … 5826 5882 endwall = nsurfl 5827 5883 nwalls = endwall - startwall + 1 5884 dirstart = (/ startland, startwall, startwall, startwall, startwall /) 5885 dirend = (/ endland, endwall, endwall, endwall, endwall /) 5828 5886 5829 5887 !-- fill gridpcbl and pcbl … … 8656 8714 INTEGER(iwp) :: l, m !< index of current surface element 8657 8715 8716 INTEGER(iwp) :: ids, idsint_u, idsint_l, isurf 8717 CHARACTER(LEN=varnamelength) :: var 8718 8719 !-- find the real name of the variable 8720 ids = -1 8721 l = -1 8722 var = TRIM(variable) 8723 DO i = 0, nd-1 8724 k = len(TRIM(var)) 8725 j = len(TRIM(dirname(i))) 8726 IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) ) THEN 8727 ids = i 8728 idsint_u = dirint_u(ids) 8729 idsint_l = dirint_l(ids) 8730 var = var(:k-j) 8731 EXIT 8732 ENDIF 8733 ENDDO 8734 IF ( ids == -1 ) THEN 8735 var = TRIM(variable) 8736 ENDIF 8737 8658 8738 IF ( mode == 'allocate' ) THEN 8659 8739 8660 SELECT CASE ( TRIM( var iable) )8661 8740 SELECT CASE ( TRIM( var ) ) 8741 !-- block of large scale (e.g. RRTMG) radiation output variables 8662 8742 CASE ( 'rad_net*' ) 8663 8743 IF ( .NOT. ALLOCATED( rad_net_av ) ) THEN … … 8738 8818 rad_sw_hr_av = 0.0_wp 8739 8819 8740 CASE ( 'rad_mrt_sw' ) 8820 !-- block of RTM output variables 8821 CASE ( 'rtm_rad_net' ) 8822 !-- array of complete radiation balance 8823 IF ( .NOT. ALLOCATED(surfradnet_av) ) THEN 8824 ALLOCATE( surfradnet_av(nsurfl) ) 8825 surfradnet_av = 0.0_wp 8826 ENDIF 8827 8828 CASE ( 'rtm_rad_insw' ) 8829 !-- array of sw radiation falling to surface after i-th reflection 8830 IF ( .NOT. ALLOCATED(surfinsw_av) ) THEN 8831 ALLOCATE( surfinsw_av(nsurfl) ) 8832 surfinsw_av = 0.0_wp 8833 ENDIF 8834 8835 CASE ( 'rtm_rad_inlw' ) 8836 !-- array of lw radiation falling to surface after i-th reflection 8837 IF ( .NOT. ALLOCATED(surfinlw_av) ) THEN 8838 ALLOCATE( surfinlw_av(nsurfl) ) 8839 surfinlw_av = 0.0_wp 8840 ENDIF 8841 8842 CASE ( 'rtm_rad_inswdir' ) 8843 !-- array of direct sw radiation falling to surface from sun 8844 IF ( .NOT. ALLOCATED(surfinswdir_av) ) THEN 8845 ALLOCATE( surfinswdir_av(nsurfl) ) 8846 surfinswdir_av = 0.0_wp 8847 ENDIF 8848 8849 CASE ( 'rtm_rad_inswdif' ) 8850 !-- array of difusion sw radiation falling to surface from sky and borders of the domain 8851 IF ( .NOT. ALLOCATED(surfinswdif_av) ) THEN 8852 ALLOCATE( surfinswdif_av(nsurfl) ) 8853 surfinswdif_av = 0.0_wp 8854 ENDIF 8855 8856 CASE ( 'rtm_rad_inswref' ) 8857 !-- array of sw radiation falling to surface from reflections 8858 IF ( .NOT. ALLOCATED(surfinswref_av) ) THEN 8859 ALLOCATE( surfinswref_av(nsurfl) ) 8860 surfinswref_av = 0.0_wp 8861 ENDIF 8862 8863 CASE ( 'rtm_rad_inlwdif' ) 8864 !-- array of sw radiation falling to surface after i-th reflection 8865 IF ( .NOT. ALLOCATED(surfinlwdif_av) ) THEN 8866 ALLOCATE( surfinlwdif_av(nsurfl) ) 8867 surfinlwdif_av = 0.0_wp 8868 ENDIF 8869 8870 CASE ( 'rtm_rad_inlwref' ) 8871 !-- array of lw radiation falling to surface from reflections 8872 IF ( .NOT. ALLOCATED(surfinlwref_av) ) THEN 8873 ALLOCATE( surfinlwref_av(nsurfl) ) 8874 surfinlwref_av = 0.0_wp 8875 ENDIF 8876 8877 CASE ( 'rtm_rad_outsw' ) 8878 !-- array of sw radiation emitted from surface after i-th reflection 8879 IF ( .NOT. ALLOCATED(surfoutsw_av) ) THEN 8880 ALLOCATE( surfoutsw_av(nsurfl) ) 8881 surfoutsw_av = 0.0_wp 8882 ENDIF 8883 8884 CASE ( 'rtm_rad_outlw' ) 8885 !-- array of lw radiation emitted from surface after i-th reflection 8886 IF ( .NOT. ALLOCATED(surfoutlw_av) ) THEN 8887 ALLOCATE( surfoutlw_av(nsurfl) ) 8888 surfoutlw_av = 0.0_wp 8889 ENDIF 8890 CASE ( 'rtm_rad_ressw' ) 8891 !-- array of residua of sw radiation absorbed in surface after last reflection 8892 IF ( .NOT. ALLOCATED(surfins_av) ) THEN 8893 ALLOCATE( surfins_av(nsurfl) ) 8894 surfins_av = 0.0_wp 8895 ENDIF 8896 8897 CASE ( 'rtm_rad_reslw' ) 8898 !-- array of residua of lw radiation absorbed in surface after last reflection 8899 IF ( .NOT. ALLOCATED(surfinl_av) ) THEN 8900 ALLOCATE( surfinl_av(nsurfl) ) 8901 surfinl_av = 0.0_wp 8902 ENDIF 8903 8904 CASE ( 'rtm_rad_pc_inlw' ) 8905 !-- array of of lw radiation absorbed in plant canopy 8906 IF ( .NOT. ALLOCATED(pcbinlw_av) ) THEN 8907 ALLOCATE( pcbinlw_av(1:npcbl) ) 8908 pcbinlw_av = 0.0_wp 8909 ENDIF 8910 8911 CASE ( 'rtm_rad_pc_insw' ) 8912 !-- array of of sw radiation absorbed in plant canopy 8913 IF ( .NOT. ALLOCATED(pcbinsw_av) ) THEN 8914 ALLOCATE( pcbinsw_av(1:npcbl) ) 8915 pcbinsw_av = 0.0_wp 8916 ENDIF 8917 8918 CASE ( 'rtm_rad_pc_inswdir' ) 8919 !-- array of of direct sw radiation absorbed in plant canopy 8920 IF ( .NOT. ALLOCATED(pcbinswdir_av) ) THEN 8921 ALLOCATE( pcbinswdir_av(1:npcbl) ) 8922 pcbinswdir_av = 0.0_wp 8923 ENDIF 8924 8925 CASE ( 'rtm_rad_pc_inswdif' ) 8926 !-- array of of diffuse sw radiation absorbed in plant canopy 8927 IF ( .NOT. ALLOCATED(pcbinswdif_av) ) THEN 8928 ALLOCATE( pcbinswdif_av(1:npcbl) ) 8929 pcbinswdif_av = 0.0_wp 8930 ENDIF 8931 8932 CASE ( 'rtm_rad_pc_inswref' ) 8933 !-- array of of reflected sw radiation absorbed in plant canopy 8934 IF ( .NOT. ALLOCATED(pcbinswref_av) ) THEN 8935 ALLOCATE( pcbinswref_av(1:npcbl) ) 8936 pcbinswref_av = 0.0_wp 8937 ENDIF 8938 8939 CASE ( 'rtm_mrt_sw' ) 8741 8940 IF ( .NOT. ALLOCATED( mrtinsw_av ) ) THEN 8742 8941 ALLOCATE( mrtinsw_av(nmrtbl) ) … … 8744 8943 mrtinsw_av = 0.0_wp 8745 8944 8746 CASE ( 'r ad_mrt_lw' )8945 CASE ( 'rtm_mrt_lw' ) 8747 8946 IF ( .NOT. ALLOCATED( mrtinlw_av ) ) THEN 8748 8947 ALLOCATE( mrtinlw_av(nmrtbl) ) … … 8750 8949 mrtinlw_av = 0.0_wp 8751 8950 8752 CASE ( 'r ad_mrt' )8951 CASE ( 'rtm_mrt' ) 8753 8952 IF ( .NOT. ALLOCATED( mrt_av ) ) THEN 8754 8953 ALLOCATE( mrt_av(nmrtbl) ) … … 8763 8962 ELSEIF ( mode == 'sum' ) THEN 8764 8963 8765 SELECT CASE ( TRIM( var iable) )8766 8964 SELECT CASE ( TRIM( var ) ) 8965 !-- block of large scale (e.g. RRTMG) radiation output variables 8767 8966 CASE ( 'rad_net*' ) 8768 8967 IF ( ALLOCATED( rad_net_av ) ) THEN … … 8971 9170 ENDIF 8972 9171 9172 !-- block of RTM output variables 9173 CASE ( 'rtm_rad_net' ) 9174 !-- array of complete radiation balance 9175 DO isurf = dirstart(ids), dirend(ids) 9176 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9177 surfradnet_av(isurf) = surfinsw(isurf) - surfoutsw(isurf) + surfinlw(isurf) - surfoutlw(isurf) 9178 ENDIF 9179 ENDDO 9180 9181 CASE ( 'rtm_rad_insw' ) 9182 !-- array of sw radiation falling to surface after i-th reflection 9183 DO isurf = dirstart(ids), dirend(ids) 9184 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9185 surfinsw_av(isurf) = surfinsw_av(isurf) + surfinsw(isurf) 9186 ENDIF 9187 ENDDO 9188 9189 CASE ( 'rtm_rad_inlw' ) 9190 !-- array of lw radiation falling to surface after i-th reflection 9191 DO isurf = dirstart(ids), dirend(ids) 9192 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9193 surfinlw_av(isurf) = surfinlw_av(isurf) + surfinlw(isurf) 9194 ENDIF 9195 ENDDO 9196 9197 CASE ( 'rtm_rad_inswdir' ) 9198 !-- array of direct sw radiation falling to surface from sun 9199 DO isurf = dirstart(ids), dirend(ids) 9200 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9201 surfinswdir_av(isurf) = surfinswdir_av(isurf) + surfinswdir(isurf) 9202 ENDIF 9203 ENDDO 9204 9205 CASE ( 'rtm_rad_inswdif' ) 9206 !-- array of difusion sw radiation falling to surface from sky and borders of the domain 9207 DO isurf = dirstart(ids), dirend(ids) 9208 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9209 surfinswdif_av(isurf) = surfinswdif_av(isurf) + surfinswdif(isurf) 9210 ENDIF 9211 ENDDO 9212 9213 CASE ( 'rtm_rad_inswref' ) 9214 !-- array of sw radiation falling to surface from reflections 9215 DO isurf = dirstart(ids), dirend(ids) 9216 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9217 surfinswref_av(isurf) = surfinswref_av(isurf) + surfinsw(isurf) - & 9218 surfinswdir(isurf) - surfinswdif(isurf) 9219 ENDIF 9220 ENDDO 9221 9222 9223 CASE ( 'rtm_rad_inlwdif' ) 9224 !-- array of sw radiation falling to surface after i-th reflection 9225 DO isurf = dirstart(ids), dirend(ids) 9226 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9227 surfinlwdif_av(isurf) = surfinlwdif_av(isurf) + surfinlwdif(isurf) 9228 ENDIF 9229 ENDDO 9230 ! 9231 CASE ( 'rtm_rad_inlwref' ) 9232 !-- array of lw radiation falling to surface from reflections 9233 DO isurf = dirstart(ids), dirend(ids) 9234 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9235 surfinlwref_av(isurf) = surfinlwref_av(isurf) + & 9236 surfinlw(isurf) - surfinlwdif(isurf) 9237 ENDIF 9238 ENDDO 9239 9240 CASE ( 'rtm_rad_outsw' ) 9241 !-- array of sw radiation emitted from surface after i-th reflection 9242 DO isurf = dirstart(ids), dirend(ids) 9243 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9244 surfoutsw_av(isurf) = surfoutsw_av(isurf) + surfoutsw(isurf) 9245 ENDIF 9246 ENDDO 9247 9248 CASE ( 'rtm_rad_outlw' ) 9249 !-- array of lw radiation emitted from surface after i-th reflection 9250 DO isurf = dirstart(ids), dirend(ids) 9251 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9252 surfoutlw_av(isurf) = surfoutlw_av(isurf) + surfoutlw(isurf) 9253 ENDIF 9254 ENDDO 9255 9256 CASE ( 'rtm_rad_ressw' ) 9257 !-- array of residua of sw radiation absorbed in surface after last reflection 9258 DO isurf = dirstart(ids), dirend(ids) 9259 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9260 surfins_av(isurf) = surfins_av(isurf) + surfins(isurf) 9261 ENDIF 9262 ENDDO 9263 9264 CASE ( 'rtm_rad_reslw' ) 9265 !-- array of residua of lw radiation absorbed in surface after last reflection 9266 DO isurf = dirstart(ids), dirend(ids) 9267 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9268 surfinl_av(isurf) = surfinl_av(isurf) + surfinl(isurf) 9269 ENDIF 9270 ENDDO 9271 9272 CASE ( 'rtm_rad_pc_inlw' ) 9273 DO l = 1, npcbl 9274 pcbinlw_av(l) = pcbinlw_av(l) + pcbinlw(l) 9275 ENDDO 9276 9277 CASE ( 'rtm_rad_pc_insw' ) 9278 DO l = 1, npcbl 9279 pcbinsw_av(l) = pcbinsw_av(l) + pcbinsw(l) 9280 ENDDO 9281 9282 CASE ( 'rtm_rad_pc_inswdir' ) 9283 DO l = 1, npcbl 9284 pcbinswdir_av(l) = pcbinswdir_av(l) + pcbinswdir(l) 9285 ENDDO 9286 9287 CASE ( 'rtm_rad_pc_inswdif' ) 9288 DO l = 1, npcbl 9289 pcbinswdif_av(l) = pcbinswdif_av(l) + pcbinswdif(l) 9290 ENDDO 9291 9292 CASE ( 'rtm_rad_pc_inswref' ) 9293 DO l = 1, npcbl 9294 pcbinswref_av(l) = pcbinswref_av(l) + pcbinsw(l) - pcbinswdir(l) - pcbinswdif(l) 9295 ENDDO 9296 8973 9297 CASE ( 'rad_mrt_sw' ) 8974 9298 IF ( ALLOCATED( mrtinsw_av ) ) THEN … … 8993 9317 ELSEIF ( mode == 'average' ) THEN 8994 9318 8995 SELECT CASE ( TRIM( var iable) )8996 9319 SELECT CASE ( TRIM( var ) ) 9320 !-- block of large scale (e.g. RRTMG) radiation output variables 8997 9321 CASE ( 'rad_net*' ) 8998 9322 IF ( ALLOCATED( rad_net_av ) ) THEN … … 9141 9465 ENDIF 9142 9466 9143 CASE ( 'rad_mrt_sw' ) 9144 IF ( ALLOCATED( mrtinsw_av ) ) THEN 9145 mrtinsw_av(:) = mrtinsw_av(:) / REAL( average_count_3d, KIND=wp ) 9146 ENDIF 9467 !-- block of RTM output variables 9468 CASE ( 'rtm_rad_net' ) 9469 !-- array of complete radiation balance 9470 DO isurf = dirstart(ids), dirend(ids) 9471 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9472 surfradnet_av(isurf) = surfinsw_av(isurf) / REAL( average_count_3d, kind=wp ) 9473 ENDIF 9474 ENDDO 9475 9476 CASE ( 'rtm_rad_insw' ) 9477 !-- array of sw radiation falling to surface after i-th reflection 9478 DO isurf = dirstart(ids), dirend(ids) 9479 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9480 surfinsw_av(isurf) = surfinsw_av(isurf) / REAL( average_count_3d, kind=wp ) 9481 ENDIF 9482 ENDDO 9483 9484 CASE ( 'rtm_rad_inlw' ) 9485 !-- array of lw radiation falling to surface after i-th reflection 9486 DO isurf = dirstart(ids), dirend(ids) 9487 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9488 surfinlw_av(isurf) = surfinlw_av(isurf) / REAL( average_count_3d, kind=wp ) 9489 ENDIF 9490 ENDDO 9491 9492 CASE ( 'rtm_rad_inswdir' ) 9493 !-- array of direct sw radiation falling to surface from sun 9494 DO isurf = dirstart(ids), dirend(ids) 9495 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9496 surfinswdir_av(isurf) = surfinswdir_av(isurf) / REAL( average_count_3d, kind=wp ) 9497 ENDIF 9498 ENDDO 9499 9500 CASE ( 'rtm_rad_inswdif' ) 9501 !-- array of difusion sw radiation falling to surface from sky and borders of the domain 9502 DO isurf = dirstart(ids), dirend(ids) 9503 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9504 surfinswdif_av(isurf) = surfinswdif_av(isurf) / REAL( average_count_3d, kind=wp ) 9505 ENDIF 9506 ENDDO 9507 9508 CASE ( 'rtm_rad_inswref' ) 9509 !-- array of sw radiation falling to surface from reflections 9510 DO isurf = dirstart(ids), dirend(ids) 9511 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9512 surfinswref_av(isurf) = surfinswref_av(isurf) / REAL( average_count_3d, kind=wp ) 9513 ENDIF 9514 ENDDO 9515 9516 CASE ( 'rtm_rad_inlwdif' ) 9517 !-- array of sw radiation falling to surface after i-th reflection 9518 DO isurf = dirstart(ids), dirend(ids) 9519 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9520 surfinlwdif_av(isurf) = surfinlwdif_av(isurf) / REAL( average_count_3d, kind=wp ) 9521 ENDIF 9522 ENDDO 9523 9524 CASE ( 'rtm_rad_inlwref' ) 9525 !-- array of lw radiation falling to surface from reflections 9526 DO isurf = dirstart(ids), dirend(ids) 9527 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9528 surfinlwref_av(isurf) = surfinlwref_av(isurf) / REAL( average_count_3d, kind=wp ) 9529 ENDIF 9530 ENDDO 9531 9532 CASE ( 'rtm_rad_outsw' ) 9533 !-- array of sw radiation emitted from surface after i-th reflection 9534 DO isurf = dirstart(ids), dirend(ids) 9535 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9536 surfoutsw_av(isurf) = surfoutsw_av(isurf) / REAL( average_count_3d, kind=wp ) 9537 ENDIF 9538 ENDDO 9539 9540 CASE ( 'rtm_rad_outlw' ) 9541 !-- array of lw radiation emitted from surface after i-th reflection 9542 DO isurf = dirstart(ids), dirend(ids) 9543 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9544 surfoutlw_av(isurf) = surfoutlw_av(isurf) / REAL( average_count_3d, kind=wp ) 9545 ENDIF 9546 ENDDO 9547 9548 CASE ( 'rtm_rad_ressw' ) 9549 !-- array of residua of sw radiation absorbed in surface after last reflection 9550 DO isurf = dirstart(ids), dirend(ids) 9551 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9552 surfins_av(isurf) = surfins_av(isurf) / REAL( average_count_3d, kind=wp ) 9553 ENDIF 9554 ENDDO 9555 9556 CASE ( 'rtm_rad_reslw' ) 9557 !-- array of residua of lw radiation absorbed in surface after last reflection 9558 DO isurf = dirstart(ids), dirend(ids) 9559 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 9560 surfinl_av(isurf) = surfinl_av(isurf) / REAL( average_count_3d, kind=wp ) 9561 ENDIF 9562 ENDDO 9563 9564 CASE ( 'rtm_rad_pc_inlw' ) 9565 DO l = 1, npcbl 9566 pcbinlw_av(:) = pcbinlw_av(:) / REAL( average_count_3d, kind=wp ) 9567 ENDDO 9568 9569 CASE ( 'rtm_rad_pc_insw' ) 9570 DO l = 1, npcbl 9571 pcbinsw_av(:) = pcbinsw_av(:) / REAL( average_count_3d, kind=wp ) 9572 ENDDO 9573 9574 CASE ( 'rtm_rad_pc_inswdir' ) 9575 DO l = 1, npcbl 9576 pcbinswdir_av(:) = pcbinswdir_av(:) / REAL( average_count_3d, kind=wp ) 9577 ENDDO 9578 9579 CASE ( 'rtm_rad_pc_inswdif' ) 9580 DO l = 1, npcbl 9581 pcbinswdif_av(:) = pcbinswdif_av(:) / REAL( average_count_3d, kind=wp ) 9582 ENDDO 9583 9584 CASE ( 'rtm_rad_pc_inswref' ) 9585 DO l = 1, npcbl 9586 pcbinswref_av(:) = pcbinswref_av(:) / REAL( average_count_3d, kind=wp ) 9587 ENDDO 9147 9588 9148 9589 CASE ( 'rad_mrt_lw' ) … … 9170 9611 !> It is called out from subroutine netcdf. 9171 9612 !------------------------------------------------------------------------------! 9172 SUBROUTINE radiation_define_netcdf_grid( var , found, grid_x, grid_y, grid_z )9613 SUBROUTINE radiation_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z ) 9173 9614 9174 9615 IMPLICIT NONE 9175 9616 9176 CHARACTER (LEN=*), INTENT(IN) :: var !<9617 CHARACTER (LEN=*), INTENT(IN) :: variable !< 9177 9618 LOGICAL, INTENT(OUT) :: found !< 9178 9619 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< … … 9180 9621 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 9181 9622 9623 CHARACTER (len=varnamelength) :: var 9624 9182 9625 found = .TRUE. 9183 9626 9184 9627 ! 9185 9628 !-- Check for the grid 9186 SELECT CASE ( TRIM( var ) ) 9187 9188 CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_sw_cs_hr', 'rad_sw_hr', & 9189 'rad_lw_cs_hr_xy', 'rad_lw_hr_xy', 'rad_sw_cs_hr_xy', & 9190 'rad_sw_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_hr_xz', & 9191 'rad_sw_cs_hr_xz', 'rad_sw_hr_xz', 'rad_lw_cs_hr_yz', & 9192 'rad_lw_hr_yz', 'rad_sw_cs_hr_yz', 'rad_sw_hr_yz', & 9193 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' ) 9194 grid_x = 'x' 9195 grid_y = 'y' 9196 grid_z = 'zu' 9197 9198 CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out', & 9199 'rad_lw_in_xy', 'rad_lw_out_xy', 'rad_sw_in_xy','rad_sw_out_xy', & 9200 'rad_lw_in_xz', 'rad_lw_out_xz', 'rad_sw_in_xz','rad_sw_out_xz', & 9201 'rad_lw_in_yz', 'rad_lw_out_yz', 'rad_sw_in_yz','rad_sw_out_yz' ) 9202 grid_x = 'x' 9203 grid_y = 'y' 9204 grid_z = 'zw' 9205 9206 9207 CASE DEFAULT 9208 found = .FALSE. 9209 grid_x = 'none' 9210 grid_y = 'none' 9211 grid_z = 'none' 9212 9213 END SELECT 9629 var = TRIM(variable) 9630 !-- RTM directional variables 9631 IF ( var(1:12) == 'rtm_rad_net_' .OR. var(1:13) == 'rtm_rad_insw_' .OR. & 9632 var(1:13) == 'rtm_rad_inlw_' .OR. var(1:16) == 'rtm_rad_inswdir_' .OR. & 9633 var(1:16) == 'rtm_rad_inswdif_' .OR. var(1:16) == 'rtm_rad_inswref_' .OR. & 9634 var(1:16) == 'rtm_rad_inlwdif_' .OR. var(1:16) == 'rtm_rad_inlwref_' .OR. & 9635 var(1:14) == 'rtm_rad_outsw_' .OR. var(1:14) == 'rtm_rad_outlw_' .OR. & 9636 var(1:14) == 'rtm_rad_ressw_' .OR. var(1:14) == 'rtm_rad_reslw_' .OR. & 9637 var == 'rtm_rad_pc_inlw' .OR. & 9638 var == 'rtm_rad_pc_insw' .OR. var == 'rtm_rad_pc_inswdir' .OR. & 9639 var == 'rtm_rad_pc_inswdif' .OR. var == 'rtm_rad_pc_inswref' .OR. & 9640 var(1:7) == 'rtm_svf' .OR. var(1:7) == 'rtm_dif' .OR. & 9641 var(1:9) == 'rtm_skyvf' .OR. var(1:10) == 'rtm_skyvft' .OR. & 9642 var == 'rtm_mrt' .OR. var == 'rtm_mrt_sw' .OR. var == 'rtm_mrt_lw' ) THEN 9643 9644 found = .TRUE. 9645 grid_x = 'x' 9646 grid_y = 'y' 9647 grid_z = 'zu' 9648 ELSE 9649 9650 SELECT CASE ( TRIM( var ) ) 9651 9652 CASE ( 'rad_lw_cs_hr', 'rad_lw_hr', 'rad_sw_cs_hr', 'rad_sw_hr', & 9653 'rad_lw_cs_hr_xy', 'rad_lw_hr_xy', 'rad_sw_cs_hr_xy', & 9654 'rad_sw_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_hr_xz', & 9655 'rad_sw_cs_hr_xz', 'rad_sw_hr_xz', 'rad_lw_cs_hr_yz', & 9656 'rad_lw_hr_yz', 'rad_sw_cs_hr_yz', 'rad_sw_hr_yz', & 9657 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' ) 9658 grid_x = 'x' 9659 grid_y = 'y' 9660 grid_z = 'zu' 9661 9662 CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_sw_in', 'rad_sw_out', & 9663 'rad_lw_in_xy', 'rad_lw_out_xy', 'rad_sw_in_xy','rad_sw_out_xy', & 9664 'rad_lw_in_xz', 'rad_lw_out_xz', 'rad_sw_in_xz','rad_sw_out_xz', & 9665 'rad_lw_in_yz', 'rad_lw_out_yz', 'rad_sw_in_yz','rad_sw_out_yz' ) 9666 grid_x = 'x' 9667 grid_y = 'y' 9668 grid_z = 'zw' 9669 9670 9671 CASE DEFAULT 9672 found = .FALSE. 9673 grid_x = 'none' 9674 grid_y = 'none' 9675 grid_z = 'none' 9676 9677 END SELECT 9678 ENDIF 9214 9679 9215 9680 END SUBROUTINE radiation_define_netcdf_grid … … 9649 10114 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 9650 10115 10116 CHARACTER (len=varnamelength) :: var, surfid 10117 INTEGER(iwp) :: ids,idsint_u,idsint_l,isurf,isvf,isurfs,isurflt,ipcgb 10118 INTEGER(iwp) :: is, js, ks, istat 10119 9651 10120 found = .TRUE. 9652 10121 9653 9654 SELECT CASE ( TRIM( variable ) ) 9655 10122 ids = -1 10123 var = TRIM(variable) 10124 DO i = 0, nd-1 10125 k = len(TRIM(var)) 10126 j = len(TRIM(dirname(i))) 10127 IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) ) THEN 10128 ids = i 10129 idsint_u = dirint_u(ids) 10130 idsint_l = dirint_l(ids) 10131 var = var(:k-j) 10132 EXIT 10133 ENDIF 10134 ENDDO 10135 IF ( ids == -1 ) THEN 10136 var = TRIM(variable) 10137 ENDIF 10138 10139 IF ( (var(1:8) == 'rtm_svf_' .OR. var(1:8) == 'rtm_dif_') .AND. len(TRIM(var)) >= 13 ) THEN 10140 !-- svf values to particular surface 10141 surfid = var(9:) 10142 i = index(surfid,'_') 10143 j = index(surfid(i+1:),'_') 10144 READ(surfid(1:i-1),*, iostat=istat ) is 10145 IF ( istat == 0 ) THEN 10146 READ(surfid(i+1:i+j-1),*, iostat=istat ) js 10147 ENDIF 10148 IF ( istat == 0 ) THEN 10149 READ(surfid(i+j+1:),*, iostat=istat ) ks 10150 ENDIF 10151 IF ( istat == 0 ) THEN 10152 var = var(1:7) 10153 ENDIF 10154 ENDIF 10155 10156 local_pf = fill_value 10157 10158 SELECT CASE ( TRIM( var ) ) 10159 !-- block of large scale radiation model (e.g. RRTMG) output variables 9656 10160 CASE ( 'rad_sw_in' ) 9657 10161 IF ( av == 0 ) THEN … … 9838 10342 ENDIF 9839 10343 9840 CASE ( 'rad_mrt_sw' ) 10344 !-- block of RTM output variables 10345 !-- variables are intended mainly for debugging and detailed analyse purposes 10346 CASE ( 'rtm_skyvf' ) 10347 !-- sky view factor 10348 DO isurf = dirstart(ids), dirend(ids) 10349 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10350 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvf(isurf) 10351 ENDIF 10352 ENDDO 10353 10354 CASE ( 'rtm_skyvft' ) 10355 !-- sky view factor 10356 DO isurf = dirstart(ids), dirend(ids) 10357 IF ( surfl(id,isurf) == ids ) THEN 10358 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = skyvft(isurf) 10359 ENDIF 10360 ENDDO 10361 10362 CASE ( 'rtm_svf', 'rtm_dif' ) 10363 !-- shape view factors or iradiance factors to selected surface 10364 IF ( TRIM(var)=='rtm_svf' ) THEN 10365 k = 1 10366 ELSE 10367 k = 2 10368 ENDIF 10369 DO isvf = 1, nsvfl 10370 isurflt = svfsurf(1, isvf) 10371 isurfs = svfsurf(2, isvf) 10372 10373 IF ( surf(ix,isurfs) == is .AND. surf(iy,isurfs) == js .AND. surf(iz,isurfs) == ks .AND. & 10374 (surf(id,isurfs) == idsint_u .OR. surfl(id,isurf) == idsint_l ) ) THEN 10375 !-- correct source surface 10376 local_pf(surfl(ix,isurflt),surfl(iy,isurflt),surfl(iz,isurflt)) = svf(k,isvf) 10377 ENDIF 10378 ENDDO 10379 10380 CASE ( 'rtm_rad_net' ) 10381 !-- array of complete radiation balance 10382 DO isurf = dirstart(ids), dirend(ids) 10383 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10384 IF ( av == 0 ) THEN 10385 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = & 10386 surfinsw(isurf) - surfoutsw(isurf) + surfinlw(isurf) - surfoutlw(isurf) 10387 ELSE 10388 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfradnet_av(isurf) 10389 ENDIF 10390 ENDIF 10391 ENDDO 10392 10393 CASE ( 'rtm_rad_insw' ) 10394 !-- array of sw radiation falling to surface after i-th reflection 10395 DO isurf = dirstart(ids), dirend(ids) 10396 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10397 IF ( av == 0 ) THEN 10398 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw(isurf) 10399 ELSE 10400 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinsw_av(isurf) 10401 ENDIF 10402 ENDIF 10403 ENDDO 10404 10405 CASE ( 'rtm_rad_inlw' ) 10406 !-- array of lw radiation falling to surface after i-th reflection 10407 DO isurf = dirstart(ids), dirend(ids) 10408 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10409 IF ( av == 0 ) THEN 10410 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf) 10411 ELSE 10412 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw_av(isurf) 10413 ENDIF 10414 ENDIF 10415 ENDDO 10416 10417 CASE ( 'rtm_rad_inswdir' ) 10418 !-- array of direct sw radiation falling to surface from sun 10419 DO isurf = dirstart(ids), dirend(ids) 10420 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10421 IF ( av == 0 ) THEN 10422 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir(isurf) 10423 ELSE 10424 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdir_av(isurf) 10425 ENDIF 10426 ENDIF 10427 ENDDO 10428 10429 CASE ( 'rtm_rad_inswdif' ) 10430 !-- array of difusion sw radiation falling to surface from sky and borders of the domain 10431 DO isurf = dirstart(ids), dirend(ids) 10432 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10433 IF ( av == 0 ) THEN 10434 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif(isurf) 10435 ELSE 10436 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswdif_av(isurf) 10437 ENDIF 10438 ENDIF 10439 ENDDO 10440 10441 CASE ( 'rtm_rad_inswref' ) 10442 !-- array of sw radiation falling to surface from reflections 10443 DO isurf = dirstart(ids), dirend(ids) 10444 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10445 IF ( av == 0 ) THEN 10446 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = & 10447 surfinsw(isurf) - surfinswdir(isurf) - surfinswdif(isurf) 10448 ELSE 10449 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinswref_av(isurf) 10450 ENDIF 10451 ENDIF 10452 ENDDO 10453 10454 CASE ( 'rtm_rad_inlwdif' ) 10455 !-- array of difusion lw radiation falling to surface from sky and borders of the domain 10456 DO isurf = dirstart(ids), dirend(ids) 10457 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10458 IF ( av == 0 ) THEN 10459 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif(isurf) 10460 ELSE 10461 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwdif_av(isurf) 10462 ENDIF 10463 ENDIF 10464 ENDDO 10465 10466 CASE ( 'rtm_rad_inlwref' ) 10467 !-- array of lw radiation falling to surface from reflections 10468 DO isurf = dirstart(ids), dirend(ids) 10469 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10470 IF ( av == 0 ) THEN 10471 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlw(isurf) - surfinlwdif(isurf) 10472 ELSE 10473 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinlwref_av(isurf) 10474 ENDIF 10475 ENDIF 10476 ENDDO 10477 10478 CASE ( 'rtm_rad_outsw' ) 10479 !-- array of sw radiation emitted from surface after i-th reflection 10480 DO isurf = dirstart(ids), dirend(ids) 10481 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10482 IF ( av == 0 ) THEN 10483 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw(isurf) 10484 ELSE 10485 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutsw_av(isurf) 10486 ENDIF 10487 ENDIF 10488 ENDDO 10489 10490 CASE ( 'rtm_rad_outlw' ) 10491 !-- array of lw radiation emitted from surface after i-th reflection 10492 DO isurf = dirstart(ids), dirend(ids) 10493 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10494 IF ( av == 0 ) THEN 10495 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw(isurf) 10496 ELSE 10497 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfoutlw_av(isurf) 10498 ENDIF 10499 ENDIF 10500 ENDDO 10501 10502 CASE ( 'rtm_rad_ressw' ) 10503 !-- average of array of residua of sw radiation absorbed in surface after last reflection 10504 DO isurf = dirstart(ids), dirend(ids) 10505 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10506 IF ( av == 0 ) THEN 10507 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins(isurf) 10508 ELSE 10509 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfins_av(isurf) 10510 ENDIF 10511 ENDIF 10512 ENDDO 10513 10514 CASE ( 'rtm_rad_reslw' ) 10515 !-- average of array of residua of lw radiation absorbed in surface after last reflection 10516 DO isurf = dirstart(ids), dirend(ids) 10517 IF ( surfl(id,isurf) == idsint_u .OR. surfl(id,isurf) == idsint_l ) THEN 10518 IF ( av == 0 ) THEN 10519 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl(isurf) 10520 ELSE 10521 local_pf(surfl(ix,isurf),surfl(iy,isurf),surfl(iz,isurf)) = surfinl_av(isurf) 10522 ENDIF 10523 ENDIF 10524 ENDDO 10525 10526 CASE ( 'rtm_rad_pc_inlw' ) 10527 !-- array of lw radiation absorbed by plant canopy 10528 DO ipcgb = 1, npcbl 10529 IF ( av == 0 ) THEN 10530 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw(ipcgb) 10531 ELSE 10532 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinlw_av(ipcgb) 10533 ENDIF 10534 ENDDO 10535 10536 CASE ( 'rtm_rad_pc_insw' ) 10537 !-- array of sw radiation absorbed by plant canopy 10538 DO ipcgb = 1, npcbl 10539 IF ( av == 0 ) THEN 10540 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw(ipcgb) 10541 ELSE 10542 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinsw_av(ipcgb) 10543 ENDIF 10544 ENDDO 10545 10546 CASE ( 'rtm_rad_pc_inswdir' ) 10547 !-- array of direct sw radiation absorbed by plant canopy 10548 DO ipcgb = 1, npcbl 10549 IF ( av == 0 ) THEN 10550 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir(ipcgb) 10551 ELSE 10552 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdir_av(ipcgb) 10553 ENDIF 10554 ENDDO 10555 10556 CASE ( 'rtm_rad_pc_inswdif' ) 10557 !-- array of diffuse sw radiation absorbed by plant canopy 10558 DO ipcgb = 1, npcbl 10559 IF ( av == 0 ) THEN 10560 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif(ipcgb) 10561 ELSE 10562 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswdif_av(ipcgb) 10563 ENDIF 10564 ENDDO 10565 10566 CASE ( 'rtm_rad_pc_inswref' ) 10567 !-- array of reflected sw radiation absorbed by plant canopy 10568 DO ipcgb = 1, npcbl 10569 IF ( av == 0 ) THEN 10570 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = & 10571 pcbinsw(ipcgb) - pcbinswdir(ipcgb) - pcbinswdif(ipcgb) 10572 ELSE 10573 local_pf(pcbl(ix,ipcgb),pcbl(iy,ipcgb),pcbl(iz,ipcgb)) = pcbinswref_av(ipcgb) 10574 ENDIF 10575 ENDDO 10576 10577 CASE ( 'rtm_mrt_sw' ) 9841 10578 local_pf = REAL( fill_value, KIND = wp ) 9842 10579 IF ( av == 0 ) THEN 9843 10580 DO l = 1, nmrtbl 9844 i = mrtbl(ix,l) 9845 j = mrtbl(iy,l) 9846 k = mrtbl(iz,l) 9847 local_pf(i,j,k) = mrtinsw(l) 10581 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw(l) 9848 10582 ENDDO 9849 10583 ELSE 9850 10584 IF ( ALLOCATED( mrtinsw_av ) ) THEN 9851 10585 DO l = 1, nmrtbl 9852 i = mrtbl(ix,l) 9853 j = mrtbl(iy,l) 9854 k = mrtbl(iz,l) 9855 local_pf(i,j,k) = mrtinsw_av(l) 10586 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinsw_av(l) 9856 10587 ENDDO 9857 10588 ENDIF 9858 10589 ENDIF 9859 10590 9860 CASE ( 'r ad_mrt_lw' )10591 CASE ( 'rtm_mrt_lw' ) 9861 10592 local_pf = REAL( fill_value, KIND = wp ) 9862 10593 IF ( av == 0 ) THEN 9863 10594 DO l = 1, nmrtbl 9864 i = mrtbl(ix,l) 9865 j = mrtbl(iy,l) 9866 k = mrtbl(iz,l) 9867 local_pf(i,j,k) = mrtinlw(l) 10595 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw(l) 9868 10596 ENDDO 9869 10597 ELSE 9870 10598 IF ( ALLOCATED( mrtinlw_av ) ) THEN 9871 10599 DO l = 1, nmrtbl 9872 i = mrtbl(ix,l) 9873 j = mrtbl(iy,l) 9874 k = mrtbl(iz,l) 9875 local_pf(i,j,k) = mrtinlw_av(l) 10600 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrtinlw_av(l) 9876 10601 ENDDO 9877 10602 ENDIF 9878 10603 ENDIF 9879 10604 9880 CASE ( 'r ad_mrt' )10605 CASE ( 'rtm_mrt' ) 9881 10606 local_pf = REAL( fill_value, KIND = wp ) 9882 10607 IF ( av == 0 ) THEN 9883 10608 DO l = 1, nmrtbl 9884 i = mrtbl(ix,l) 9885 j = mrtbl(iy,l) 9886 k = mrtbl(iz,l) 9887 local_pf(i,j,k) = mrt(l) 10609 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt(l) 9888 10610 ENDDO 9889 10611 ELSE 9890 10612 IF ( ALLOCATED( mrt_av ) ) THEN 9891 10613 DO l = 1, nmrtbl 9892 i = mrtbl(ix,l) 9893 j = mrtbl(iy,l) 9894 k = mrtbl(iz,l) 9895 local_pf(i,j,k) = mrt_av(l) 10614 local_pf(mrtbl(ix,l),mrtbl(iy,l),mrtbl(iz,l)) = mrt_av(l) 9896 10615 ENDDO 9897 10616 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
