Changeset 3554 for palm/trunk
- Timestamp:
- Nov 22, 2018 11:24:52 AM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 7 edited
-
data_output_2d.f90 (modified) (29 diffs)
-
data_output_3d.f90 (modified) (19 diffs)
-
data_output_mask.f90 (modified) (2 diffs)
-
data_output_profiles.f90 (modified) (2 diffs)
-
init_masks.f90 (modified) (2 diffs)
-
posix_calls_from_fortran.f90 (modified) (3 diffs)
-
subsidence_mod.f90 (modified) (7 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 -
palm/trunk/SOURCE/data_output_3d.f90
r3525 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add variable description; rename variable 'if' into 'ivar' 28 ! 29 ! 3525 2018-11-14 16:06:14Z kanani 27 30 ! Changes related to clean-up of biometeorology (dom_dwd_user) 28 31 ! … … 310 313 IMPLICIT NONE 311 314 312 INTEGER(iwp) :: av !< 315 INTEGER(iwp) :: av !< flag for (non-)average output 313 316 INTEGER(iwp) :: flag_nr !< number of masking flag 314 INTEGER(iwp) :: i !< 315 INTEGER(iwp) :: i f !<316 INTEGER(iwp) :: j !< 317 INTEGER(iwp) :: k !< 318 INTEGER(iwp) :: n !< 317 INTEGER(iwp) :: i !< loop index 318 INTEGER(iwp) :: ivar !< variable index 319 INTEGER(iwp) :: j !< loop index 320 INTEGER(iwp) :: k !< loop index 321 INTEGER(iwp) :: n !< loop index 319 322 INTEGER(iwp) :: nzb_do !< vertical lower limit for data output 320 323 INTEGER(iwp) :: nzt_do !< vertical upper limit for data output 321 324 322 LOGICAL :: found !< 323 LOGICAL :: resorted !< 324 325 REAL(wp) :: mean_r !< 326 REAL(wp) :: s_r2 !< 327 REAL(wp) :: s_r3 !< 328 329 REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< 330 331 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< 325 LOGICAL :: found !< true if output variable was found 326 LOGICAL :: resorted !< true if variable is resorted 327 328 REAL(wp) :: mean_r !< mean particle radius 329 REAL(wp) :: s_r2 !< sum( particle-radius**2 ) 330 REAL(wp) :: s_r3 !< sum( particle-radius**3 ) 331 332 REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array 333 334 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer to array which shall be output 332 335 333 336 CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string … … 387 390 ! 388 391 !-- Loop over all variables to be written. 389 i f= 1390 391 DO WHILE ( do3d(av,i f)(1:1) /= ' ' )392 ivar = 1 393 394 DO WHILE ( do3d(av,ivar)(1:1) /= ' ' ) 392 395 393 396 ! … … 395 398 !-- surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ). 396 399 !-- Store the array chosen on the temporary array. 397 trimvar = TRIM( do3d(av,i f) )400 trimvar = TRIM( do3d(av,ivar) ) 398 401 IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN 399 402 trimvar = 'usm_output' … … 711 714 !-- Block of urban surface model outputs 712 715 CASE ( 'usm_output' ) 713 CALL usm_data_output_3d( av, do3d(av,i f), found, local_pf, &716 CALL usm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 714 717 nzb_do, nzt_do ) 715 718 … … 719 722 !-- Quantities of other modules 720 723 IF ( .NOT. found .AND. bulk_cloud_model ) THEN 721 CALL bcm_data_output_3d( av, do3d(av,i f), found, local_pf, &724 CALL bcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 722 725 nzb_do, nzt_do ) 723 726 resorted = .TRUE. … … 725 728 726 729 IF ( .NOT. found .AND. air_chemistry ) THEN 727 CALL chem_data_output_3d( av, do3d(av,i f), found, &730 CALL chem_data_output_3d( av, do3d(av,ivar), found, & 728 731 local_pf, fill_value, nzb_do, nzt_do ) 729 732 resorted = .TRUE. … … 731 734 732 735 IF ( .NOT. found .AND. gust_module_enabled ) THEN 733 CALL gust_data_output_3d( av, do3d(av,i f), found, local_pf, &736 CALL gust_data_output_3d( av, do3d(av,ivar), found, local_pf, & 734 737 nzb_do, nzt_do ) 735 738 resorted = .TRUE. … … 746 749 local_pf = fill_value 747 750 748 CALL lsm_data_output_3d( av, do3d(av,i f), found, local_pf )751 CALL lsm_data_output_3d( av, do3d(av,ivar), found, local_pf ) 749 752 resorted = .TRUE. 750 753 … … 762 765 763 766 IF ( .NOT. found .AND. ocean_mode ) THEN 764 CALL ocean_data_output_3d( av, do3d(av,i f), found, local_pf, &767 CALL ocean_data_output_3d( av, do3d(av,ivar), found, local_pf, & 765 768 nzb_do, nzt_do ) 766 769 resorted = .TRUE. … … 768 771 769 772 IF ( .NOT. found .AND. plant_canopy ) THEN 770 CALL pcm_data_output_3d( av, do3d(av,i f), found, local_pf, &773 CALL pcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 771 774 fill_value, nzb_do, nzt_do ) 772 775 resorted = .TRUE. … … 774 777 775 778 IF ( .NOT. found .AND. radiation ) THEN 776 CALL radiation_data_output_3d( av, do3d(av,i f), found, &779 CALL radiation_data_output_3d( av, do3d(av,ivar), found, & 777 780 local_pf, nzb_do, nzt_do ) 778 781 resorted = .TRUE. … … 780 783 781 784 IF ( .NOT. found ) THEN 782 CALL tcm_data_output_3d( av, do3d(av,i f), found, local_pf, &785 CALL tcm_data_output_3d( av, do3d(av,ivar), found, local_pf, & 783 786 nzb_do, nzt_do ) 784 787 resorted = .TRUE. … … 788 791 !-- SALSA output 789 792 IF ( .NOT. found .AND. salsa ) THEN 790 CALL salsa_data_output_3d( av, do3d(av,i f), found, local_pf )793 CALL salsa_data_output_3d( av, do3d(av,ivar), found, local_pf ) 791 794 resorted = .TRUE. 792 795 ENDIF 793 796 794 797 IF ( .NOT. found .AND. biometeorology ) THEN 795 CALL bio_data_output_3d( av, do3d(av,i f), found, local_pf, &798 CALL bio_data_output_3d( av, do3d(av,ivar), found, local_pf, & 796 799 nzb_do, nzt_do ) 797 800 ENDIF … … 800 803 !-- User defined quantities 801 804 IF ( .NOT. found ) THEN 802 CALL user_data_output_3d( av, do3d(av,i f), found, local_pf, &805 CALL user_data_output_3d( av, do3d(av,ivar), found, local_pf, & 803 806 nzb_do, nzt_do ) 804 807 resorted = .TRUE. … … 807 810 IF ( .NOT. found ) THEN 808 811 message_string = 'no output available for: ' // & 809 TRIM( do3d(av,i f) )812 TRIM( do3d(av,ivar) ) 810 813 CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 ) 811 814 ENDIF … … 855 858 !-- Parallel output in netCDF4/HDF5 format. 856 859 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 857 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &860 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 858 861 ! local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do), & 859 862 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 860 863 ! count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) ) 861 864 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 862 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &865 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 863 866 ! local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do), & 864 867 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 865 868 ! count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) ) 866 869 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 867 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &870 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 868 871 ! local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do ), & 869 872 ! start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & 870 873 ! count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) ) 871 874 ! ELSE 872 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &875 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 873 876 local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), & 874 877 start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), & … … 880 883 #else 881 884 #if defined( __netcdf ) 882 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,i f), &885 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,ivar), & 883 886 local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do), & 884 887 start = (/ 1, 1, 1, do3d_time_count(av) /), & … … 888 891 #endif 889 892 890 i f = if+ 1893 ivar = ivar + 1 891 894 892 895 ! -
palm/trunk/SOURCE/data_output_mask.f90
r3467 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add variable description 28 ! 29 ! 3467 2018-10-30 19:05:21Z suehring 27 30 ! Implementation of a new aerosol module salsa. 28 31 ! … … 199 202 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 200 203 201 INTEGER(iwp) :: av !< 202 INTEGER(iwp) :: ngp !< 203 INTEGER(iwp) :: i !< 204 INTEGER(iwp) :: ivar !< 205 INTEGER(iwp) :: j !< 206 INTEGER(iwp) :: k !< 207 INTEGER(iwp) :: kk !< 208 INTEGER(iwp) :: n !< 209 INTEGER(iwp) :: netcdf_data_format_save !< 210 INTEGER(iwp) :: sender !< 204 INTEGER(iwp) :: av !< flag for (non-)average output 205 INTEGER(iwp) :: ngp !< number of grid points of an output slice 206 INTEGER(iwp) :: i !< loop index 207 INTEGER(iwp) :: ivar !< variable index 208 INTEGER(iwp) :: j !< loop index 209 INTEGER(iwp) :: k !< loop index 210 INTEGER(iwp) :: kk !< vertical index 211 INTEGER(iwp) :: n !< loop index 212 INTEGER(iwp) :: netcdf_data_format_save !< value of netcdf_data_format 213 INTEGER(iwp) :: sender !< PE id of sending PE 211 214 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 212 INTEGER(iwp) :: ind(6) !< 213 214 LOGICAL :: found !<215 LOGICAL :: resorted !<216 217 REAL(wp) :: mean_r !<218 REAL(wp) :: s_r2 !<219 REAL(wp) :: s_r3 !<215 INTEGER(iwp) :: ind(6) !< index limits (lower/upper bounds) of array 'local_2d' 216 217 LOGICAL :: found !< true if output variable was found 218 LOGICAL :: resorted !< true if variable is resorted 219 220 REAL(wp) :: mean_r !< mean particle radius 221 REAL(wp) :: s_r2 !< sum( particle-radius**2 ) 222 REAL(wp) :: s_r3 !< sum( particle-radius**3 ) 220 223 221 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< 224 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array 222 225 #if defined( __parallel ) 223 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: total_pf !< 226 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: total_pf !< collected output array 224 227 #endif 225 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< 228 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which shall be output 226 229 227 230 ! -
palm/trunk/SOURCE/data_output_profiles.f90
r3241 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add variable description 28 ! 29 ! 3241 2018-09-12 15:02:00Z raasch 27 30 ! unused format statements removed 28 31 ! … … 126 129 127 130 128 INTEGER(iwp) :: i !< 129 INTEGER(iwp) :: sr !< 131 INTEGER(iwp) :: i !< loop index 132 INTEGER(iwp) :: sr !< statistic region index 130 133 131 134 ! -
palm/trunk/SOURCE/init_masks.f90
r3512 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add variable description 28 ! 29 ! 3512 2018-11-09 18:09:51Z gronemeier 27 30 ! Bugfix: do not output ghost points if mask_x/y_loop is not specified 28 31 ! … … 196 199 IMPLICIT NONE 197 200 198 CHARACTER (LEN=varnamelength) :: var !< 199 CHARACTER (LEN=7) :: unit !<201 CHARACTER (LEN=varnamelength) :: var !< contains variable name 202 CHARACTER (LEN=7) :: unit !< contains unit of variable 200 203 201 CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) :: do_mask !< 202 CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) :: do_mask_user !< 204 CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) :: do_mask !< list of output variables 205 CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) :: do_mask_user !< list of user-specified output variables 203 206 204 207 INTEGER(iwp) :: count !< counting masking indices along a dimension 205 INTEGER(iwp) :: i !< 206 INTEGER(iwp) :: ilen !< 207 INTEGER(iwp) :: ind(6) !< 208 INTEGER(iwp) :: ind_array(1) !< 209 INTEGER(iwp) :: j !< 210 INTEGER(iwp) :: k !< 208 INTEGER(iwp) :: i !< loop index 209 INTEGER(iwp) :: ilen !< length of string saved in 'do_mask' 210 INTEGER(iwp) :: ind(6) !< index limits (lower/upper bounds) of output array 211 INTEGER(iwp) :: ind_array(1) !< array index 212 INTEGER(iwp) :: j !< loop index 213 INTEGER(iwp) :: k !< loop index 211 214 INTEGER(iwp) :: m !< mask index 212 INTEGER(iwp) :: n !< 213 INTEGER(iwp) :: sender !< 215 INTEGER(iwp) :: n !< loop index 216 INTEGER(iwp) :: sender !< PE id of sending PE 214 217 215 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: tmp_array !< 216 217 LOGICAL :: found !< 218 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: tmp_array !< temporary 1D array 219 220 LOGICAL :: found !< true if variable is found 218 221 219 222 ! -
palm/trunk/SOURCE/posix_calls_from_fortran.f90
r2718 r3554 25 25 ! ----------------- 26 26 ! $Id: posix_calls_from_fortran.f90 2696 2017-12-14 17:12:51Z kanani $ 27 ! add variable description 28 ! 29 ! 2696 2017-12-14 17:12:51Z kanani 27 30 ! Corrected "Former revisions" section 28 31 ! … … 50 53 51 54 INTERFACE 52 55 ! 56 !-- Sleep function from C library 53 57 FUNCTION fsleep( seconds ) BIND( C, NAME='sleep' ) 54 58 IMPORT … … 73 77 !> Wait a specified amount of seconds 74 78 !------------------------------------------------------------------------------! 75 79 SUBROUTINE fortran_sleep( seconds ) 76 80 77 INTEGER, INTENT(IN) :: seconds81 INTEGER, INTENT(IN) :: seconds !< seconds to wait 78 82 79 INTEGER(c_int) :: seconds_in_c80 INTEGER(c_int) :: sleep_return_value83 INTEGER(c_int) :: seconds_in_c !< same as seconds 84 INTEGER(c_int) :: sleep_return_value !< returned value to sleep 81 85 82 86 seconds_in_c = seconds 83 87 84 88 sleep_return_value = fsleep( seconds_in_c ) 85 89 86 90 END SUBROUTINE fortran_sleep 87 91 88 92 END MODULE posix_calls_from_fortran 89 -
palm/trunk/SOURCE/subsidence_mod.f90
r3302 r3554 25 25 ! ----------------- 26 26 ! $Id$ 27 ! add subroutine and variable description 28 ! 29 ! 3302 2018-10-03 02:39:40Z raasch 27 30 ! small message change 28 31 ! … … 124 127 ! Description: 125 128 ! ------------ 126 !> @todo Missing subroutine description.129 !> Initialize vertical subsidence velocity w_subs. 127 130 !------------------------------------------------------------------------------! 128 131 SUBROUTINE init_w_subsidence … … 142 145 IMPLICIT NONE 143 146 144 INTEGER(iwp) :: i !< 145 INTEGER(iwp) :: k !< 146 147 REAL(wp) :: gradient !< 148 REAL(wp) :: ws_surface !< 147 INTEGER(iwp) :: i !< loop index 148 INTEGER(iwp) :: k !< loop index 149 150 REAL(wp) :: gradient !< vertical gradient of subsidence velocity 151 REAL(wp) :: ws_surface !< subsidence velocity at the surface 149 152 150 153 IF ( .NOT. ALLOCATED( w_subs ) ) THEN … … 201 204 ! Description: 202 205 ! ------------ 203 !> @todo Missing subroutine description.206 !> Add effect of large-scale subsidence to variable. 204 207 !------------------------------------------------------------------------------! 205 208 SUBROUTINE subsidence( tendency, var, var_init, ls_index ) … … 223 226 IMPLICIT NONE 224 227 225 INTEGER(iwp) :: i !<226 INTEGER(iwp) :: j !<227 INTEGER(iwp) :: k !<228 INTEGER(iwp) :: ls_index !< 229 230 REAL(wp) :: tmp_tend !< 231 REAL(wp) :: tmp_grad !< 228 INTEGER(iwp) :: i !< loop index 229 INTEGER(iwp) :: j !< loop index 230 INTEGER(iwp) :: k !< loop index 231 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l 232 233 REAL(wp) :: tmp_tend !< temporary tendency 234 REAL(wp) :: tmp_grad !< temporary gradient 232 235 233 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< 234 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< 235 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< 236 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< 236 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence 237 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var 238 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var 239 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var 237 240 238 241 var_mod = var_init … … 316 319 ! Description: 317 320 ! ------------ 318 !> @todo Missing subroutine description.321 !> Add effect of large-scale subsidence to variable. 319 322 !------------------------------------------------------------------------------! 320 323 SUBROUTINE subsidence_ij( i, j, tendency, var, var_init, ls_index ) … … 337 340 IMPLICIT NONE 338 341 339 INTEGER(iwp) :: i !<340 INTEGER(iwp) :: j !<341 INTEGER(iwp) :: k !<342 INTEGER(iwp) :: ls_index !< 343 344 REAL(wp) :: tmp_tend !< 345 REAL(wp) :: tmp_grad !< 342 INTEGER(iwp) :: i !< loop variable 343 INTEGER(iwp) :: j !< loop variable 344 INTEGER(iwp) :: k !< loop variable 345 INTEGER(iwp) :: ls_index !< index of large-scale subsidence in sums_ls_l 346 347 REAL(wp) :: tmp_tend !< temporary tendency 348 REAL(wp) :: tmp_grad !< temporary gradient 346 349 347 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< 348 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< 349 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< 350 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< 350 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !< variable where to add subsidence 351 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: tendency !< tendency of var 352 REAL(wp), DIMENSION(nzb:nzt+1) :: var_init !< initialization profile of var 353 REAL(wp), DIMENSION(nzb:nzt+1) :: var_mod !< modified profile of var 351 354 352 355 var_mod = var_init
Note: See TracChangeset
for help on using the changeset viewer.
