Changeset 3554 for palm/trunk/SOURCE/data_output_2d.f90
- Timestamp:
- Nov 22, 2018 11:24:52 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_2d.f90 (modified) (29 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_2d.f90
r3525 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - add variable description 28 ! - rename variable 'if' into 'ivar' 29 ! - removed namelist LOCAL 30 ! - removed variable rtext 31 ! 32 ! 3525 2018-11-14 16:06:14Z kanani 27 33 ! Changes related to clean-up of biometeorology (dom_dwd_user) 28 34 ! … … 337 343 IMPLICIT NONE 338 344 339 CHARACTER (LEN=2) :: do2d_mode !< 340 CHARACTER (LEN=2) :: mode !< 341 CHARACTER (LEN=4) :: grid !< 342 CHARACTER (LEN=50) :: rtext !< 345 CHARACTER (LEN=2) :: do2d_mode !< output mode of variable ('xy', 'xz', 'yz') 346 CHARACTER (LEN=2) :: mode !< mode with which the routine is called ('xy', 'xz', 'yz') 347 CHARACTER (LEN=4) :: grid !< string defining the vertical grid 343 348 344 INTEGER(iwp) :: av !< 345 INTEGER(iwp) :: ngp !< 346 INTEGER(iwp) :: file_id !< 349 INTEGER(iwp) :: av !< flag for (non-)average output 350 INTEGER(iwp) :: ngp !< number of grid points of an output slice 351 INTEGER(iwp) :: file_id !< id of output files 347 352 INTEGER(iwp) :: flag_nr !< number of masking flag 348 INTEGER(iwp) :: i !< 349 INTEGER(iwp) :: i f !<350 INTEGER(iwp) :: is !< 351 INTEGER(iwp) :: i is !<352 INTEGER(iwp) :: j !< 353 INTEGER(iwp) :: k !< 354 INTEGER(iwp) :: l !< 355 INTEGER(iwp) :: layer_xy !< 356 INTEGER(iwp) :: m !< 357 INTEGER(iwp) :: n !< 358 INTEGER(iwp) :: nis !< 359 INTEGER(iwp) :: ns !< 353 INTEGER(iwp) :: i !< loop index 354 INTEGER(iwp) :: iis !< vertical index of a xy slice in array 'local_2d_sections' 355 INTEGER(iwp) :: is !< slice index 356 INTEGER(iwp) :: ivar !< variable index 357 INTEGER(iwp) :: j !< loop index 358 INTEGER(iwp) :: k !< loop index 359 INTEGER(iwp) :: l !< loop index 360 INTEGER(iwp) :: layer_xy !< vertical index of a xy slice in array 'local_pf' 361 INTEGER(iwp) :: m !< loop index 362 INTEGER(iwp) :: n !< loop index 363 INTEGER(iwp) :: nis !< number of vertical slices to be written via parallel NetCDF output 364 INTEGER(iwp) :: ns !< number of output slices 360 365 INTEGER(iwp) :: nzb_do !< lower limit of the data field (usually nzb) 361 366 INTEGER(iwp) :: nzt_do !< upper limit of the data field (usually nzt+1) 362 INTEGER(iwp) :: s_ind !< 363 INTEGER(iwp) :: sender !< 364 INTEGER(iwp) :: ind(4) !< 367 INTEGER(iwp) :: s_ind !< index of slice types (xy=1, xz=2, yz=3) 368 INTEGER(iwp) :: sender !< PE id of sending PE 369 INTEGER(iwp) :: ind(4) !< index limits (lower/upper bounds) of array 'local_2d' 370 371 LOGICAL :: found !< true if output variable was found 372 LOGICAL :: resorted !< true if variable is resorted 373 LOGICAL :: two_d !< true if variable is only two dimensional 374 375 REAL(wp) :: mean_r !< mean particle radius 376 REAL(wp) :: s_r2 !< sum( particle-radius**2 ) 377 REAL(wp) :: s_r3 !< sum( particle-radius**3 ) 365 378 366 LOGICAL :: found !< 367 LOGICAL :: resorted !< 368 LOGICAL :: two_d !< 369 370 REAL(wp) :: mean_r !< 371 REAL(wp) :: s_r2 !< 372 REAL(wp) :: s_r3 !< 373 374 REAL(wp), DIMENSION(:), ALLOCATABLE :: level_z !< 375 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !< 376 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !< 377 378 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< 379 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !< 380 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections_l !< 379 REAL(wp), DIMENSION(:), ALLOCATABLE :: level_z !< z levels for output array 380 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !< local 2-dimensional array containing output values 381 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !< local 2-dimensional array containing output values 382 383 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array 384 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !< local array containing values at all slices 385 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections_l !< local array containing values at all slices 381 386 382 387 #if defined( __parallel ) 383 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !< 384 #endif 385 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< 386 387 NAMELIST /LOCAL/ rtext 388 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !< same as local_2d 389 #endif 390 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which shall be output 388 391 389 392 ! … … 543 546 !-- Loop of all variables to be written. 544 547 !-- Output dimensions chosen 545 i f= 1546 l = MAX( 2, LEN_TRIM( do2d(av,i f) ) )547 do2d_mode = do2d(av,i f)(l-1:l)548 549 DO WHILE ( do2d(av,i f)(1:1) /= ' ' )548 ivar = 1 549 l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) ) 550 do2d_mode = do2d(av,ivar)(l-1:l) 551 552 DO WHILE ( do2d(av,ivar)(1:1) /= ' ' ) 550 553 551 554 IF ( do2d_mode == mode ) THEN … … 567 570 !-- Store the array chosen on the temporary array. 568 571 resorted = .FALSE. 569 SELECT CASE ( TRIM( do2d(av,i f) ) )572 SELECT CASE ( TRIM( do2d(av,ivar) ) ) 570 573 CASE ( 'e_xy', 'e_xz', 'e_yz' ) 571 574 IF ( av == 0 ) THEN … … 1135 1138 !-- Substitute the values generated by "mirror" boundary condition 1136 1139 !-- at the bottom boundary by the real surface values. 1137 IF ( do2d(av,i f) == 'u_xz' .OR. do2d(av,if) == 'u_yz' ) THEN1140 IF ( do2d(av,ivar) == 'u_xz' .OR. do2d(av,ivar) == 'u_yz' ) THEN 1138 1141 IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp 1139 1142 ENDIF … … 1186 1189 !-- Substitute the values generated by "mirror" boundary condition 1187 1190 !-- at the bottom boundary by the real surface values. 1188 IF ( do2d(av,i f) == 'v_xz' .OR. do2d(av,if) == 'v_yz' ) THEN1191 IF ( do2d(av,ivar) == 'v_xz' .OR. do2d(av,ivar) == 'v_yz' ) THEN 1189 1192 IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp 1190 1193 ENDIF … … 1316 1319 !-- Quantities of other modules 1317 1320 IF ( .NOT. found .AND. bulk_cloud_model ) THEN 1318 CALL bcm_data_output_2d( av, do2d(av,i f), found, grid, mode,&1321 CALL bcm_data_output_2d( av, do2d(av,ivar), found, grid, mode,& 1319 1322 local_pf, two_d, nzb_do, nzt_do ) 1320 1323 ENDIF 1321 1324 1322 1325 IF ( .NOT. found .AND. gust_module_enabled ) THEN 1323 CALL gust_data_output_2d( av, do2d(av,i f), found, grid, &1326 CALL gust_data_output_2d( av, do2d(av,ivar), found, grid, & 1324 1327 local_pf, two_d, nzb_do, nzt_do ) 1325 1328 ENDIF … … 1327 1330 IF ( .NOT. found .AND. biometeorology & 1328 1331 .AND. mode == 'xy' ) THEN 1329 CALL bio_data_output_2d( av, do2d(av,i f), found, grid, &1332 CALL bio_data_output_2d( av, do2d(av,ivar), found, grid, & 1330 1333 local_pf, two_d, nzb_do, nzt_do, & 1331 1334 fill_value ) … … 1333 1336 1334 1337 IF ( .NOT. found .AND. land_surface ) THEN 1335 CALL lsm_data_output_2d( av, do2d(av,i f), found, grid, mode,&1338 CALL lsm_data_output_2d( av, do2d(av,ivar), found, grid, mode,& 1336 1339 local_pf, two_d, nzb_do, nzt_do ) 1337 1340 ENDIF 1338 1341 1339 1342 IF ( .NOT. found .AND. ocean_mode ) THEN 1340 CALL ocean_data_output_2d( av, do2d(av,i f), found, grid, &1343 CALL ocean_data_output_2d( av, do2d(av,ivar), found, grid, & 1341 1344 mode, local_pf, nzb_do, nzt_do ) 1342 1345 ENDIF 1343 1346 1344 1347 IF ( .NOT. found .AND. radiation ) THEN 1345 CALL radiation_data_output_2d( av, do2d(av,i f), found, grid,&1348 CALL radiation_data_output_2d( av, do2d(av,ivar), found, grid,& 1346 1349 mode, local_pf, two_d, & 1347 1350 nzb_do, nzt_do ) … … 1349 1352 1350 1353 IF ( .NOT. found .AND. salsa ) THEN 1351 CALL salsa_data_output_2d( av, do2d(av,i f), found, grid, &1354 CALL salsa_data_output_2d( av, do2d(av,ivar), found, grid, & 1352 1355 mode, local_pf, two_d ) 1353 1356 ENDIF 1354 1357 1355 1358 IF ( .NOT. found .AND. uv_exposure ) THEN 1356 CALL uvem_data_output_2d( av, do2d(av,i f), found, grid, &1359 CALL uvem_data_output_2d( av, do2d(av,ivar), found, grid, & 1357 1360 local_pf, two_d, nzb_do, nzt_do ) 1358 1361 ENDIF 1359 1362 1360 1363 IF ( .NOT. found .AND. air_chemistry ) THEN 1361 CALL chem_data_output_2d( av, do2d(av,i f), found, grid, mode, &1364 CALL chem_data_output_2d( av, do2d(av,ivar), found, grid, mode, & 1362 1365 local_pf, two_d, nzb_do, nzt_do, fill_value ) 1363 1366 ENDIF … … 1365 1368 !-- User defined quantities 1366 1369 IF ( .NOT. found ) THEN 1367 CALL user_data_output_2d( av, do2d(av,i f), found, grid, &1370 CALL user_data_output_2d( av, do2d(av,ivar), found, grid, & 1368 1371 local_pf, two_d, nzb_do, nzt_do ) 1369 1372 ENDIF … … 1383 1386 IF ( .NOT. found ) THEN 1384 1387 message_string = 'no output provided for: ' // & 1385 TRIM( do2d(av,i f) )1388 TRIM( do2d(av,ivar) ) 1386 1389 CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 ) 1387 1390 ENDIF … … 1556 1559 IF ( two_d ) THEN 1557 1560 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 1558 id_var_do2d(av,i f), &1561 id_var_do2d(av,ivar), & 1559 1562 total_2d(0:nx,0:ny), & 1560 1563 start = (/ 1, 1, 1, do2d_xy_time_count(av) /), & … … 1562 1565 ELSE 1563 1566 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 1564 id_var_do2d(av,i f), &1567 id_var_do2d(av,ivar), & 1565 1568 total_2d(0:nx,0:ny), & 1566 1569 start = (/ 1, 1, is, do2d_xy_time_count(av) /), & … … 1594 1597 IF ( two_d ) THEN 1595 1598 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 1596 id_var_do2d(av,i f), &1599 id_var_do2d(av,ivar), & 1597 1600 local_2d(nxl:nxr,nys:nyn), & 1598 1601 start = (/ 1, 1, 1, do2d_xy_time_count(av) /), & … … 1600 1603 ELSE 1601 1604 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 1602 id_var_do2d(av,i f), &1605 id_var_do2d(av,ivar), & 1603 1606 local_2d(nxl:nxr,nys:nyn), & 1604 1607 start = (/ 1, 1, is, do2d_xy_time_count(av) /), & … … 1786 1789 #if defined( __netcdf ) 1787 1790 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 1788 id_var_do2d(av,i f), &1791 id_var_do2d(av,ivar), & 1789 1792 total_2d(0:nx,nzb_do:nzt_do), & 1790 1793 start = (/ 1, is, 1, do2d_xz_time_count(av) /), & … … 1827 1830 #if defined( __netcdf ) 1828 1831 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 1829 id_var_do2d(av,i f), &1832 id_var_do2d(av,ivar), & 1830 1833 local_2d(nxl:nxr,nzb_do:nzt_do), & 1831 1834 start = (/ 1, is, 1, do2d_xz_time_count(av) /), & … … 2004 2007 #if defined( __netcdf ) 2005 2008 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 2006 id_var_do2d(av,i f), &2009 id_var_do2d(av,ivar), & 2007 2010 total_2d(0:ny,nzb_do:nzt_do), & 2008 2011 start = (/ is, 1, 1, do2d_yz_time_count(av) /), & … … 2045 2048 #if defined( __netcdf ) 2046 2049 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 2047 id_var_do2d(av,i f), &2050 id_var_do2d(av,ivar), & 2048 2051 local_2d(nys:nyn,nzb_do:nzt_do), & 2049 2052 start = (/ is, 1, 1, do2d_xz_time_count(av) /), & … … 2079 2082 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 2080 2083 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), & 2081 ! id_var_do2d(av,i f), &2084 ! id_var_do2d(av,ivar), & 2082 2085 ! local_2d_sections(nxl:nxr+1, & 2083 2086 ! nys:nyn,1:nis), & … … 2089 2092 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 2090 2093 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), & 2091 ! id_var_do2d(av,i f), &2094 ! id_var_do2d(av,ivar), & 2092 2095 ! local_2d_sections(nxl:nxr, & 2093 2096 ! nys:nyn+1,1:nis), & … … 2099 2102 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 2100 2103 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), & 2101 ! id_var_do2d(av,i f), &2104 ! id_var_do2d(av,ivar), & 2102 2105 ! local_2d_sections(nxl:nxr+1, & 2103 2106 ! nys:nyn+1,1:nis), & … … 2109 2112 ! ELSE 2110 2113 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 2111 id_var_do2d(av,i f), &2114 id_var_do2d(av,ivar), & 2112 2115 local_2d_sections(nxl:nxr, & 2113 2116 nys:nyn,1:nis), & … … 2151 2154 ! IF ( nxr == nx ) THEN 2152 2155 ! nc_stat = NF90_PUT_VAR( id_set_xz(av), & 2153 ! id_var_do2d(av,i f), &2156 ! id_var_do2d(av,ivar), & 2154 2157 ! local_2d_sections(nxl:nxr+1,1:ns, & 2155 2158 ! nzb_do:nzt_do), & … … 2160 2163 ! ELSE 2161 2164 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 2162 id_var_do2d(av,i f), &2165 id_var_do2d(av,ivar), & 2163 2166 local_2d_sections(nxl:nxr,1:ns, & 2164 2167 nzb_do:nzt_do), & … … 2201 2204 ! IF ( nyn == ny ) THEN 2202 2205 ! nc_stat = NF90_PUT_VAR( id_set_yz(av), & 2203 ! id_var_do2d(av,i f), &2206 ! id_var_do2d(av,ivar), & 2204 2207 ! local_2d_sections(1:ns, & 2205 2208 ! nys:nyn+1,nzb_do:nzt_do), & … … 2210 2213 ! ELSE 2211 2214 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 2212 id_var_do2d(av,i f), &2215 id_var_do2d(av,ivar), & 2213 2216 local_2d_sections(1:ns,nys:nyn, & 2214 2217 nzb_do:nzt_do), & … … 2231 2234 ENDIF 2232 2235 2233 i f = if+ 12234 l = MAX( 2, LEN_TRIM( do2d(av,i f) ) )2235 do2d_mode = do2d(av,i f)(l-1:l)2236 ivar = ivar + 1 2237 l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) ) 2238 do2d_mode = do2d(av,ivar)(l-1:l) 2236 2239 2237 2240 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
