Changeset 2696 for palm/trunk/SOURCE/surface_mod.f90
- Timestamp:
- Dec 14, 2017 5:12:51 PM (6 years ago)
- Location:
- palm/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk
-
palm/trunk/SOURCE
-
palm/trunk/SOURCE/surface_mod.f90
r2688 r2696 1 1 !> @file surface_mod.f90 2 2 !------------------------------------------------------------------------------! 3 ! This file is part of PALM.3 ! This file is part of the PALM model system. 4 4 ! 5 5 ! PALM is free software: you can redistribute it and/or modify it under the … … 26 26 ! ----------------- 27 27 ! $Id$ 28 ! - Missing code for css added to surf_*, handling of surface_csflux updated (FK) 29 ! - Bugfixes in reading/writing restart data in case several surface types are 30 ! present at the same time (MS) 31 ! - Implementation of chemistry module (FK) 32 ! - Allocation of pt1 and qv1 now done for all surface types (MS) 33 ! - Revised classification of surface types 34 ! - Introduce offset values to simplify index determination of surface elements 35 ! - Dimensions of function get_topo_top_index (MS) 36 ! - added variables for USM 37 ! - adapted to changes in USM (RvT) 38 ! 39 ! 2688 2017-12-12 17:27:04Z Giersch 28 40 ! Allocation and initialization of the latent heat flux (qsws) at the top of 29 41 ! the ocean domain in case of coupled runs. In addtion, a double if-query has … … 84 96 !> In addition, a further derived data structure is defined, in order to set 85 97 !> boundary conditions at surfaces. 98 !> @todo For the moment, downward-facing surfaces are only classified as 99 !> default type 100 !> @todo Clean up urban-surface variables (some of them are not used any more) 101 !> @todo Revise chemistry surface flux part (reduce loops?!) 86 102 !------------------------------------------------------------------------------! 87 103 MODULE surface_mod … … 91 107 momentumflux_input_conversion 92 108 109 #if defined( __chem ) 110 USE chem_modules 111 #endif 112 93 113 USE control_parameters 94 114 … … 126 146 TYPE surf_type 127 147 148 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element 149 INTEGER(iwp) :: joff !< offset value in y-direction, used to determine index of surface element 150 INTEGER(iwp) :: koff !< offset value in z-direction, used to determine index of surface element 128 151 INTEGER(iwp) :: ns !< number of surface elements on the PE 152 129 153 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 130 154 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid … … 154 178 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0q !< roughness length for humidity 155 179 156 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt1 !< Specific humidity at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.) 157 REAL(wp), DIMENSION(:), ALLOCATABLE :: qv1 !< Potential temperature at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.) 180 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt1 !< Potential temperature at first grid level 181 REAL(wp), DIMENSION(:), ALLOCATABLE :: qv1 !< Specific humidity at first grid level 182 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: css !< scaling parameter chemical species 158 183 ! 159 184 !-- Define arrays for surface fluxes … … 169 194 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrsws !< surface flux nr 170 195 REAL(wp), DIMENSION(:), ALLOCATABLE :: sasws !< surface flux salinity 196 197 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: cssws !< surface flux chemical species 171 198 ! 172 199 !-- Required for horizontal walls in production_e … … 179 206 ! 180 207 !-- Variables required for LSM as well as for USM 181 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature 182 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_l !< net radiation 183 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil (W/m/K) 184 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 185 208 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nzt_pavement !< top index for pavement in soil 209 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: albedo_type !< albedo type, for each fraction (wall,green,window or vegetation,pavement water) 210 186 211 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_surface !< flag parameter indicating that the surface element is covered by buildings (no LSM actions, not implemented yet) 212 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_covered !< flag indicating that buildings are on top of orography, only used for vertical surfaces in LSM 187 213 LOGICAL, DIMENSION(:), ALLOCATABLE :: pavement_surface !< flag parameter for pavements 188 214 LOGICAL, DIMENSION(:), ALLOCATABLE :: water_surface !< flag parameter for water surfaces 189 LOGICAL, DIMENSION(:), ALLOCATABLE :: vegetation_surface !< flag parameter for natural land surfaces 215 LOGICAL, DIMENSION(:), ALLOCATABLE :: vegetation_surface !< flag parameter for natural land surfaces 216 217 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: albedo !< broadband albedo for each surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 218 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: emissivity !< emissivity of the surface, for each fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 219 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: frac !< relative surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 220 221 REAL(wp), DIMENSION(:), ALLOCATABLE :: aldif !< albedo for longwave diffusive radiation, solar angle of 60° 222 REAL(wp), DIMENSION(:), ALLOCATABLE :: aldir !< albedo for longwave direct radiation, solar angle of 60° 223 REAL(wp), DIMENSION(:), ALLOCATABLE :: asdif !< albedo for shortwave diffusive radiation, solar angle of 60° 224 REAL(wp), DIMENSION(:), ALLOCATABLE :: asdir !< albedo for shortwave direct radiation, solar angle of 60° 225 REAL(wp), DIMENSION(:), ALLOCATABLE :: rrtm_aldif !< albedo for longwave diffusive radiation, solar angle of 60° 226 REAL(wp), DIMENSION(:), ALLOCATABLE :: rrtm_aldir !< albedo for longwave direct radiation, solar angle of 60° 227 REAL(wp), DIMENSION(:), ALLOCATABLE :: rrtm_asdif !< albedo for shortwave diffusive radiation, solar angle of 60° 228 REAL(wp), DIMENSION(:), ALLOCATABLE :: rrtm_asdir !< albedo for shortwave direct radiation, solar angle of 60° 229 230 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature 231 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net !< net radiation 232 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_l !< net radiation, used in USM 233 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil/ wall (W/m/K) 234 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_green !< heat conductivity of green soil (W/m/K) 235 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_window !< heat conductivity of windows (W/m/K) 236 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 237 238 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_in !< incoming longwave radiation 239 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out !< emitted longwave radiation 240 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_in !< incoming shortwave radiation 241 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_out !< emitted shortwave radiation 242 243 190 244 191 245 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_liq !< liquid water coverage (of vegetated area) 192 246 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_veg !< vegetation coverage 193 247 REAL(wp), DIMENSION(:), ALLOCATABLE :: f_sw_in !< fraction of absorbed shortwave radiation by the surface layer (not implemented yet) 194 REAL(wp), DIMENSION(:), ALLOCATABLE :: ghf !< ground heat flux248 REAL(wp), DIMENSION(:), ALLOCATABLE :: ghf !< ground heat flux 195 249 REAL(wp), DIMENSION(:), ALLOCATABLE :: g_d !< coefficient for dependence of r_canopy on water vapour pressure deficit 196 250 REAL(wp), DIMENSION(:), ALLOCATABLE :: lai !< leaf area index 197 251 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_u !< coupling between surface and soil (depends on vegetation type) (W/m2/K) 198 252 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_s !< coupling between surface and soil (depends on vegetation type) (W/m2/K) 199 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq !< surface flux of latent heat (liquid water portion)200 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_soil !< surface flux of latent heat (soil portion)201 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg !< surface flux of latent heat (vegetation portion)253 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq !< surface flux of latent heat (liquid water portion) 254 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_soil !< surface flux of latent heat (soil portion) 255 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg !< surface flux of latent heat (vegetation portion) 202 256 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a !< aerodynamic resistance 203 257 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy !< canopy resistance … … 224 278 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: surface_types !< array of types of wall parameters 225 279 226 LOGICAL, DIMENSION(:), ALLOCATABLE :: isroof_surf !< flag indication roof surfaces 227 228 REAL(wp), DIMENSION(:), ALLOCATABLE :: albedo_surf !< albedo of the surface 280 LOGICAL, DIMENSION(:), ALLOCATABLE :: isroof_surf !< flag indicating roof surfaces 281 LOGICAL, DIMENSION(:), ALLOCATABLE :: ground_level !< flag indicating ground floor level surfaces 282 283 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_summer !< indoor target temperature summer 284 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_winter !< indoor target temperature summer 285 229 286 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_surface !< heat capacity of the wall surface skin (J/m2/K) 230 REAL(wp), DIMENSION(:), ALLOCATABLE :: emiss_surf !< emissivity of the wall surface 287 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_surface_green !< heat capacity of the green surface skin (J/m2/K) 288 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_surface_window !< heat capacity of the window surface skin (J/m2/K) 231 289 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surf !< heat conductivity between air and surface (W/m2/K) 232 REAL(wp), DIMENSION(:), ALLOCATABLE :: roughness_wall !< roughness relative to concrete 290 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surf_green !< heat conductivity between air and green surface (W/m2/K) 291 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surf_window !< heat conductivity between air and window surface (W/m2/K) 233 292 REAL(wp), DIMENSION(:), ALLOCATABLE :: thickness_wall !< thickness of the wall, roof and soil layers 293 REAL(wp), DIMENSION(:), ALLOCATABLE :: thickness_green !< thickness of the green wall, roof and soil layers 294 REAL(wp), DIMENSION(:), ALLOCATABLE :: thickness_window !< thickness of the window wall, roof and soil layers 295 REAL(wp), DIMENSION(:), ALLOCATABLE :: transmissivity !< transmissivity of windows 234 296 235 297 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsl !< reflected shortwave radiation for local surface in i-th reflection … … 238 300 239 301 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_m !< surface temperature tendency (K) 302 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_window_m !< window surface temperature tendency (K) 303 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_green_m !< green surface temperature tendency (K) 240 304 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf !< kinematic wall heat flux of sensible heat (actually no longer needed) 241 305 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb !< wall heat flux of sensible heat in wall normal direction 242 306 243 244 307 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb !< wall ground heat flux 245 246 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_in_sw !< incoming shortwave radiation 247 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_out_sw !< emitted shortwave radiation 248 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_in_lw !< incoming longwave radiation 249 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_out_lw !< emitted longwave radiation 308 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window !< window ground heat flux 309 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green !< green ground heat flux 310 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb !< indoor wall ground heat flux 311 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window !< indoor window ground heat flux 312 313 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out_change_0 250 314 251 315 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw !< shortwave radiation falling to local surface including radiation from reflections … … 262 326 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array 263 327 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw !< wall layer depths (m) 328 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_window !< volumetric heat capacity of the window material ( J m-3 K-1 ) (= 2.19E6) 329 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window !< window grid spacing (center-center) 330 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window !< 1/dz_window 331 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window_stag !< window grid spacing (edge-edge) 332 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window_stag !< 1/dz_window_stag 333 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array 334 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_window !< window layer depths (m) 335 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_green !< volumetric heat capacity of the green material ( J m-3 K-1 ) (= 2.19E6) 336 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green !< green grid spacing (center-center) 337 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green !< 1/dz_green 338 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green_stag !< green grid spacing (edge-edge) 339 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green_stag !< 1/dz_green_stag 340 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array 341 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_green !< green layer depths (m) 264 342 265 343 … … 279 357 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing from local surface 280 358 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_av !< average of wghf_eb 359 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window_av !< average of wghf_eb window 360 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green_av !< average of wghf_eb window 361 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_av !< indoor average of wghf_eb 362 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window_av !< indoor average of wghf_eb window 281 363 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb_av !< average of wshf_eb 282 364 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_av !< average of wall surface temperature (K) 365 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_window_av !< average of window surface temperature (K) 366 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_green_av !< average of green wall surface temperature (K) 367 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_whole_av !< average of whole wall surface temperature (K) 368 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_10cm_av !< average of the near surface temperature (K) 283 369 284 370 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_wall_av !< Average of t_wall 371 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window 372 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_green_av !< Average of t_green 285 373 286 374 END TYPE surf_type … … 305 393 INTERFACE get_topography_top_index 306 394 MODULE PROCEDURE get_topography_top_index 395 MODULE PROCEDURE get_topography_top_index_ji 307 396 END INTERFACE get_topography_top_index 308 397 … … 331 420 END INTERFACE surface_last_actions 332 421 422 INTERFACE surface_restore_elements 423 MODULE PROCEDURE surface_restore_elements_1d 424 MODULE PROCEDURE surface_restore_elements_2d 425 END INTERFACE surface_restore_elements 426 333 427 ! 334 428 !-- Public variables … … 338 432 !-- Public subroutines and functions 339 433 PUBLIC get_topography_top_index, init_bc, init_surfaces, & 340 init_surface_arrays, surface_read_restart_data, & 341 surface_write_restart_data, surface_last_actions 434 init_surface_arrays, surface_read_restart_data, & 435 surface_restore_elements, surface_write_restart_data, & 436 surface_last_actions 342 437 343 438 … … 473 568 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< number of vertically-aligned urban surfaces 474 569 570 LOGICAL :: building !< flag indicating building grid point 571 LOGICAL :: terrain !< flag indicating natural terrain grid point 475 572 476 573 num_def_h = 0 … … 481 578 num_usm_v = 0 482 579 ! 580 !-- Surfaces are classified according to the input data read from static 581 !-- input file. If no input file is present, all surfaces are classified 582 !-- either as natural, urban, or default, depending on the setting of 583 !-- land_surface and urban_surface. To control this, use the control 584 !-- flag topo_no_distinct 585 ! 483 586 !-- Count number of horizontal surfaces on local domain 484 587 DO i = nxl, nxr … … 491 594 !-- Check if grid point adjoins to any upward-facing horizontal 492 595 !-- surface, e.g. the Earth surface, plane roofs, or ceilings. 596 493 597 IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) ) THEN 494 598 ! 599 !-- Determine flags indicating terrain or building. 600 terrain = BTEST( wall_flags_0(k-1,j,i), 5 ) .OR. & 601 topo_no_distinct 602 building = BTEST( wall_flags_0(k-1,j,i), 6 ) .OR. & 603 topo_no_distinct 604 ! 495 605 !-- Land-surface type 496 IF ( land_surface ) THEN606 IF ( land_surface .AND. terrain ) THEN 497 607 num_lsm_h = num_lsm_h + 1 498 608 ! 499 609 !-- Urban surface tpye 500 ELSEIF ( urban_surface ) THEN610 ELSEIF ( urban_surface .AND. building ) THEN 501 611 num_usm_h = num_usm_h + 1 502 612 ! 503 613 !-- Default-surface type 504 ELSE 505 num_def_h(0) = num_def_h(0) + 1 614 ELSEIF ( .NOT. land_surface .AND. & 615 .NOT. urban_surface ) THEN 616 617 num_def_h(0) = num_def_h(0) + 1 618 ! 619 !-- Unclassifified surface-grid point. Give error message. 620 ELSE 621 WRITE( message_string, * ) & 622 'Unclassified upward-facing ' // & 623 'surface element at '// & 624 'grid point (k,j,i) = ', k, j, i 625 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) 506 626 ENDIF 507 627 … … 531 651 !-- Northward-facing 532 652 IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) ) THEN 533 IF ( urban_surface ) THEN 653 ! 654 !-- Determine flags indicating terrain or building 655 656 terrain = BTEST( wall_flags_0(k,j-1,i), 5 ) .OR. & 657 topo_no_distinct 658 building = BTEST( wall_flags_0(k,j-1,i), 6 ) .OR. & 659 topo_no_distinct 660 IF ( land_surface .AND. terrain ) THEN 661 num_lsm_v(0) = num_lsm_v(0) + 1 662 ELSEIF ( urban_surface .AND. building ) THEN 534 663 num_usm_v(0) = num_usm_v(0) + 1 535 ELSEIF ( land_surface ) THEN 536 num_lsm_v(0) = num_lsm_v(0) + 1 537 ELSE 664 ! 665 !-- Default-surface type 666 ELSEIF ( .NOT. land_surface .AND. & 667 .NOT. urban_surface ) THEN 538 668 num_def_v(0) = num_def_v(0) + 1 669 ! 670 !-- Unclassifified surface-grid point. Give error message. 671 ELSE 672 WRITE( message_string, * ) & 673 'Unclassified northward-facing ' // & 674 'surface element at '// & 675 'grid point (k,j,i) = ', k, j, i 676 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) 677 539 678 ENDIF 540 679 ENDIF … … 542 681 !-- Southward-facing 543 682 IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) ) THEN 544 IF ( urban_surface ) THEN 683 ! 684 !-- Determine flags indicating terrain or building 685 terrain = BTEST( wall_flags_0(k,j+1,i), 5 ) .OR. & 686 topo_no_distinct 687 building = BTEST( wall_flags_0(k,j+1,i), 6 ) .OR. & 688 topo_no_distinct 689 IF ( land_surface .AND. terrain ) THEN 690 num_lsm_v(1) = num_lsm_v(1) + 1 691 ELSEIF ( urban_surface .AND. building ) THEN 545 692 num_usm_v(1) = num_usm_v(1) + 1 546 ELSEIF ( land_surface ) THEN 547 num_lsm_v(1) = num_lsm_v(1) + 1 548 ELSE 693 ! 694 !-- Default-surface type 695 ELSEIF ( .NOT. land_surface .AND. & 696 .NOT. urban_surface ) THEN 549 697 num_def_v(1) = num_def_v(1) + 1 698 ! 699 !-- Unclassifified surface-grid point. Give error message. 700 ELSE 701 WRITE( message_string, * ) & 702 'Unclassified southward-facing ' // & 703 'surface element at '// & 704 'grid point (k,j,i) = ', k, j, i 705 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) 706 550 707 ENDIF 551 708 ENDIF … … 553 710 !-- Eastward-facing 554 711 IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) ) THEN 555 IF ( urban_surface ) THEN 712 ! 713 !-- Determine flags indicating terrain or building 714 terrain = BTEST( wall_flags_0(k,j,i-1), 5 ) .OR. & 715 topo_no_distinct 716 building = BTEST( wall_flags_0(k,j,i-1), 6 ) .OR. & 717 topo_no_distinct 718 IF ( land_surface .AND. terrain ) THEN 719 num_lsm_v(2) = num_lsm_v(2) + 1 720 ELSEIF ( urban_surface .AND. building ) THEN 556 721 num_usm_v(2) = num_usm_v(2) + 1 557 ELSEIF ( land_surface ) THEN 558 num_lsm_v(2) = num_lsm_v(2) + 1 559 ELSE 722 ! 723 !-- Default-surface type 724 ELSEIF ( .NOT. land_surface .AND. & 725 .NOT. urban_surface ) THEN 560 726 num_def_v(2) = num_def_v(2) + 1 727 ! 728 !-- Unclassifified surface-grid point. Give error message. 729 ELSE 730 WRITE( message_string, * ) & 731 'Unclassified eastward-facing ' // & 732 'surface element at '// & 733 'grid point (k,j,i) = ', k, j, i 734 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) 735 561 736 ENDIF 562 737 ENDIF … … 564 739 !-- Westward-facing 565 740 IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) ) THEN 566 IF ( urban_surface ) THEN 567 num_usm_v(3) = num_usm_v(3) + 1 568 ELSEIF ( land_surface ) THEN 569 num_lsm_v(3) = num_lsm_v(3) + 1 570 ELSE 741 ! 742 !-- Determine flags indicating terrain or building 743 terrain = BTEST( wall_flags_0(k,j,i+1), 5 ) .OR. & 744 topo_no_distinct 745 building = BTEST( wall_flags_0(k,j,i+1), 6 ) .OR. & 746 topo_no_distinct 747 IF ( land_surface .AND. terrain ) THEN 748 num_lsm_v(3) = num_lsm_v(3) + 1 749 ELSEIF ( urban_surface .AND. building ) THEN 750 num_usm_v(3) = num_usm_v(3) + 1 751 ! 752 !-- Default-surface type 753 ELSEIF ( .NOT. land_surface .AND. & 754 .NOT. urban_surface ) THEN 571 755 num_def_v(3) = num_def_v(3) + 1 756 ! 757 !-- Unclassifified surface-grid point. Give error message. 758 ELSE 759 WRITE( message_string, * ) & 760 'Unclassified westward-facing ' // & 761 'surface element at '// & 762 'grid point (k,j,i) = ', k, j, i 763 CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 ) 764 572 765 ENDIF 573 766 ENDIF … … 651 844 !-- Default type. 652 845 DO l = 0, 3 653 CALL allocate_surface_attributes_v ( surf_def_v(l), .FALSE.,&846 CALL allocate_surface_attributes_v ( surf_def_v(l), & 654 847 nys, nyn, nxl, nxr ) 655 848 ENDDO … … 657 850 !-- Natural type 658 851 DO l = 0, 3 659 CALL allocate_surface_attributes_v ( surf_lsm_v(l), .TRUE.,&852 CALL allocate_surface_attributes_v ( surf_lsm_v(l), & 660 853 nys, nyn, nxl, nxr ) 661 854 ENDDO … … 663 856 !-- Urban type 664 857 DO l = 0, 3 665 CALL allocate_surface_attributes_v ( surf_usm_v(l), .FALSE.,&858 CALL allocate_surface_attributes_v ( surf_usm_v(l), & 666 859 nys, nyn, nxl, nxr ) 667 860 ENDDO … … 716 909 !-- Surface-parallel wind velocity 717 910 ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) ) 718 ! ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) )719 911 ! 720 912 !-- Roughness … … 746 938 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 747 939 ! 940 !-- surface temperature 941 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 942 ! 748 943 !-- Characteristic humidity and surface flux of latent heat 749 944 IF ( humidity ) THEN … … 758 953 ENDIF 759 954 ! 760 !-- When cloud physics is used, arrays for storing potential temperature and 761 !-- specific humidity at first grid level are required. 762 IF ( cloud_physics .OR. cloud_droplets ) THEN 763 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 764 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 765 ENDIF 955 !-- Scaling parameter (cs*) and surface flux of chemical species 956 #if defined ( __chem ) 957 IF ( air_chemistry ) THEN 958 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 959 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 960 ENDIF 961 #endif 962 ! 963 !-- Arrays for storing potential temperature and 964 !-- specific humidity at first grid level 965 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 966 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 766 967 ! 767 968 !-- … … 836 1037 ENDIF 837 1038 ! 1039 !-- Chemical species flux 1040 #if defined( __chem ) 1041 IF ( air_chemistry ) THEN 1042 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1043 ENDIF 1044 #endif 1045 ! 838 1046 !-- 839 1047 IF ( cloud_physics .AND. microphysics_morrison) THEN … … 858 1066 !> Allocating memory for vertical surface types. 859 1067 !------------------------------------------------------------------------------! 860 SUBROUTINE allocate_surface_attributes_v( surfaces, lsm,&1068 SUBROUTINE allocate_surface_attributes_v( surfaces, & 861 1069 nys_l, nyn_l, nxl_l, nxr_l ) 862 1070 … … 867 1075 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 868 1076 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 869 870 LOGICAL :: lsm !< flag indicating data type of natural land surface871 1077 872 1078 TYPE(surf_type) :: surfaces !< respective surface type … … 909 1115 ALLOCATE ( surfaces%us(1:surfaces%ns) ) 910 1116 ! 911 !-- Allocate Obukhov length and bulk Richardson number. Only required 1117 !-- Allocate Obukhov length and bulk Richardson number. Actually, at 1118 !-- vertical surfaces these are only required for natural surfaces. 912 1119 !-- for natural land surfaces 913 IF ( lsm ) THEN 914 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 915 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 916 ENDIF 1120 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 1121 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 917 1122 ! 918 1123 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- … … 930 1135 !-- Characteristic temperature and surface flux of sensible heat 931 1136 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 932 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1137 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1138 ! 1139 !-- surface temperature 1140 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 933 1141 ! 934 1142 !-- Characteristic humidity and surface flux of latent heat … … 942 1150 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 943 1151 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1152 ENDIF 1153 ! 1154 !-- Scaling parameter (cs*) and surface flux of chemical species 1155 #if defined( __chem ) 1156 IF ( air_chemistry ) THEN 1157 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1158 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 944 1159 ENDIF 1160 #endif 1161 ! 1162 !-- Arrays for storing potential temperature and 1163 !-- specific humidity at first grid level 1164 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 1165 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 945 1166 946 1167 IF ( cloud_physics .AND. microphysics_seifert) THEN … … 966 1187 ! Description: 967 1188 ! ------------ 968 !> Initialize surface elements. 1189 !> Initialize surface elements, i.e. set initial values for surface fluxes, 1190 !> friction velocity, calcuation of start/end indices, etc. . 1191 !> Please note, further initialization concerning 1192 !> special surface characteristics, e.g. soil- and vegatation type, 1193 !> building type, etc., is done in the land-surface and urban-surface module, 1194 !> respectively. 969 1195 !------------------------------------------------------------------------------! 970 1196 SUBROUTINE init_surfaces … … 1001 1227 INTEGER(iwp), DIMENSION(0:3) :: start_index_usm_v !< dummy to determing local start index in surface type for given (j,i), for vertical urban surfaces 1002 1228 1229 LOGICAL :: building !< flag indicating building grid point 1230 LOGICAL :: terrain !< flag indicating natural terrain grid point 1231 1232 ! 1233 !-- Set offset indices, i.e. index difference between surface element and 1234 !-- surface-bounded grid point. 1235 !-- Upward facing - no horizontal offsets 1236 surf_def_h(0:2)%ioff = 0 1237 surf_def_h(0:2)%joff = 0 1238 1239 surf_lsm_h%ioff = 0 1240 surf_lsm_h%joff = 0 1241 1242 surf_usm_h%ioff = 0 1243 surf_usm_h%joff = 0 1244 ! 1245 !-- Upward facing vertical offsets 1246 surf_def_h(0)%koff = -1 1247 surf_lsm_h%koff = -1 1248 surf_usm_h%koff = -1 1249 ! 1250 !-- Downward facing vertical offset 1251 surf_def_h(1:2)%koff = 1 1252 ! 1253 !-- Vertical surfaces - no vertical offset 1254 surf_def_v(0:3)%koff = 0 1255 surf_lsm_v(0:3)%koff = 0 1256 surf_usm_v(0:3)%koff = 0 1257 ! 1258 !-- North- and southward facing - no offset in x 1259 surf_def_v(0:1)%ioff = 0 1260 surf_lsm_v(0:1)%ioff = 0 1261 surf_usm_v(0:1)%ioff = 0 1262 ! 1263 !-- Northward facing offset in y 1264 surf_def_v(0)%joff = -1 1265 surf_lsm_v(0)%joff = -1 1266 surf_usm_v(0)%joff = -1 1267 ! 1268 !-- Southward facing offset in y 1269 surf_def_v(1)%joff = 1 1270 surf_lsm_v(1)%joff = 1 1271 surf_usm_v(1)%joff = 1 1272 1273 ! 1274 !-- East- and westward facing - no offset in y 1275 surf_def_v(2:3)%joff = 0 1276 surf_lsm_v(2:3)%joff = 0 1277 surf_usm_v(2:3)%joff = 0 1278 ! 1279 !-- Eastward facing offset in x 1280 surf_def_v(2)%ioff = -1 1281 surf_lsm_v(2)%ioff = -1 1282 surf_usm_v(2)%ioff = -1 1283 ! 1284 !-- Westward facing offset in y 1285 surf_def_v(3)%ioff = 1 1286 surf_lsm_v(3)%ioff = 1 1287 surf_usm_v(3)%ioff = 1 1003 1288 1004 1289 ! … … 1039 1324 !-- Upward-facing surface. Distinguish between differet surface types. 1040 1325 !-- To do, think about method to flag natural and non-natural 1041 !-- surfaces. Only to ask for land_surface or urban surface 1042 !-- is just a work-around. 1326 !-- surfaces. 1043 1327 IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) ) THEN 1044 1328 ! 1329 !-- Determine flags indicating terrain or building 1330 terrain = BTEST( wall_flags_0(k-1,j,i), 5 ) .OR. & 1331 topo_no_distinct 1332 building = BTEST( wall_flags_0(k-1,j,i), 6 ) .OR. & 1333 topo_no_distinct 1334 ! 1045 1335 !-- Natural surface type 1046 IF ( land_surface ) THEN1336 IF ( land_surface .AND. terrain ) THEN 1047 1337 CALL initialize_horizontal_surfaces( k, j, i, & 1048 1338 surf_lsm_h, & … … 1052 1342 ! 1053 1343 !-- Urban surface tpye 1054 ELSEIF ( urban_surface ) THEN1344 ELSEIF ( urban_surface .AND. building ) THEN 1055 1345 CALL initialize_horizontal_surfaces( k, j, i, & 1056 1346 surf_usm_h, & … … 1069 1359 ENDIF 1070 1360 ! 1071 !-- downward-facing surface, first, model top 1361 !-- downward-facing surface, first, model top. Please note, 1362 !-- for the moment, downward-facing surfaces are always of 1363 !-- default type 1072 1364 IF ( k == nzt .AND. use_top_fluxes ) THEN 1073 1365 CALL initialize_top( k, j, i, surf_def_h(2), & … … 1087 1379 ! Start with northward-facing surface. 1088 1380 IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) ) THEN 1089 IF ( urban_surface ) THEN 1381 ! 1382 !-- Determine flags indicating terrain or building 1383 terrain = BTEST( wall_flags_0(k,j-1,i), 5 ) .OR. & 1384 topo_no_distinct 1385 building = BTEST( wall_flags_0(k,j-1,i), 6 ) .OR. & 1386 topo_no_distinct 1387 IF ( urban_surface .AND. building ) THEN 1090 1388 CALL initialize_vertical_surfaces( 0, k, j, i, & 1091 1389 surf_usm_v(0), & … … 1094 1392 .FALSE., .FALSE., & 1095 1393 .FALSE., .TRUE. ) 1096 ELSEIF ( land_surface ) THEN1394 ELSEIF ( land_surface .AND. terrain ) THEN 1097 1395 CALL initialize_vertical_surfaces( 0, k, j, i, & 1098 1396 surf_lsm_v(0), & … … 1113 1411 !-- southward-facing surface 1114 1412 IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) ) THEN 1115 IF ( urban_surface ) THEN 1413 ! 1414 !-- Determine flags indicating terrain or building 1415 terrain = BTEST( wall_flags_0(k,j+1,i), 5 ) .OR. & 1416 topo_no_distinct 1417 building = BTEST( wall_flags_0(k,j+1,i), 6 ) .OR. & 1418 topo_no_distinct 1419 IF ( urban_surface .AND. building ) THEN 1116 1420 CALL initialize_vertical_surfaces( 1, k, j, i, & 1117 1421 surf_usm_v(1), & … … 1120 1424 .FALSE., .FALSE., & 1121 1425 .TRUE., .FALSE. ) 1122 ELSEIF ( land_surface ) THEN1426 ELSEIF ( land_surface .AND. terrain ) THEN 1123 1427 CALL initialize_vertical_surfaces( 1, k, j, i, & 1124 1428 surf_lsm_v(1), & … … 1139 1443 !-- eastward-facing surface 1140 1444 IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) ) THEN 1141 IF ( urban_surface ) THEN 1445 ! 1446 !-- Determine flags indicating terrain or building 1447 terrain = BTEST( wall_flags_0(k,j,i-1), 5 ) .OR. & 1448 topo_no_distinct 1449 building = BTEST( wall_flags_0(k,j,i-1), 6 ) .OR. & 1450 topo_no_distinct 1451 IF ( urban_surface .AND. building ) THEN 1142 1452 CALL initialize_vertical_surfaces( 2, k, j, i, & 1143 1453 surf_usm_v(2), & … … 1146 1456 .TRUE., .FALSE., & 1147 1457 .FALSE., .FALSE. ) 1148 ELSEIF ( land_surface ) THEN1458 ELSEIF ( land_surface .AND. terrain ) THEN 1149 1459 CALL initialize_vertical_surfaces( 2, k, j, i, & 1150 1460 surf_lsm_v(2), & … … 1165 1475 !-- westward-facing surface 1166 1476 IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) ) THEN 1167 IF ( urban_surface ) THEN 1477 ! 1478 !-- Determine flags indicating terrain or building 1479 terrain = BTEST( wall_flags_0(k,j,i+1), 5 ) .OR. & 1480 topo_no_distinct 1481 building = BTEST( wall_flags_0(k,j,i+1), 6 ) .OR. & 1482 topo_no_distinct 1483 IF ( urban_surface .AND. building ) THEN 1168 1484 CALL initialize_vertical_surfaces( 3, k, j, i, & 1169 1485 surf_usm_v(3), & … … 1172 1488 .FALSE., .TRUE., & 1173 1489 .FALSE., .FALSE. ) 1174 ELSEIF ( land_surface ) THEN1490 ELSEIF ( land_surface .AND. terrain ) THEN 1175 1491 CALL initialize_vertical_surfaces( 3, k, j, i, & 1176 1492 surf_lsm_v(3), & … … 1285 1601 ENDDO 1286 1602 1603 1287 1604 CONTAINS 1288 1605 … … 1305 1622 INTEGER(iwp) :: num_h !< current number of surface element 1306 1623 INTEGER(iwp) :: num_h_kji !< dummy increment 1624 INTEGER(iwp) :: lsp !< running index chemical species 1625 INTEGER(iwp) :: lsp_pr !< running index chemical species?? 1307 1626 1308 1627 LOGICAL :: upward_facing !< flag indicating upward-facing surface … … 1356 1675 ! 1357 1676 !-- Initialization in case of constant profiles 1358 ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )&1359 THEN1677 ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0& 1678 .OR. INDEX(initializing_actions, 'inifor' ) /= 0 ) THEN 1360 1679 1361 1680 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min … … 1403 1722 1404 1723 IF ( passive_scalar ) surf%ss(num_h) = 0.0_wp 1724 1725 #if defined( __chem ) 1726 DO lsp = 1, nvar 1727 IF ( air_chemistry ) surf%css(lsp,num_h) = 0.0_wp 1728 ENDDO 1729 #endif 1730 ! 1731 !-- Set initial value for surface temperature 1732 surf%pt_surface(num_h) = pt_surface 1405 1733 ! 1406 1734 !-- Inititalize surface fluxes of sensible and latent heat, as well as … … 1414 1742 !-- if random_heatflux is set. This case, shf is initialized later. 1415 1743 IF ( .NOT. random_heatflux ) THEN 1416 surf%shf(num_h) = surface_heatflux * &1744 surf%shf(num_h) = surface_heatflux * & 1417 1745 heatflux_input_conversion(nzb) 1418 1746 ! … … 1420 1748 !-- prescribed wall heatflux 1421 1749 IF ( k-1 /= 0 ) THEN 1422 surf%shf(num_h) = wall_heatflux(0) * &1750 surf%shf(num_h) = wall_heatflux(0) * & 1423 1751 heatflux_input_conversion(k-1) 1424 1752 ENDIF … … 1476 1804 ENDIF 1477 1805 1806 #if defined( __chem ) 1807 IF ( air_chemistry ) THEN 1808 lsp_pr = 1 1809 DO WHILE ( TRIM( surface_csflux_name( lsp_pr ) ) /= 'novalue' ) !<'novalue' is the default 1810 DO lsp = 1, nvar 1811 ! 1812 !-- Assign surface flux for each variable species 1813 IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) ) THEN 1814 IF ( upward_facing ) THEN 1815 IF ( constant_csflux(lsp_pr) ) THEN 1816 surf%cssws(lsp,num_h) = surface_csflux(lsp_pr) 1817 1818 IF ( k-1 /= 0 ) & 1819 surf%cssws(lsp,num_h) = wall_csflux(lsp,0) 1820 ELSE 1821 surf%cssws(lsp,num_h) = 0.0_wp 1822 ENDIF 1823 ELSE 1824 surf%cssws(lsp,num_h) = wall_csflux(lsp,5) 1825 ENDIF 1826 ENDIF 1827 ENDDO 1828 lsp_pr = lsp_pr + 1 1829 ENDDO 1830 ENDIF 1831 #endif 1832 1478 1833 IF ( ocean ) THEN 1479 1834 IF ( upward_facing ) THEN … … 1508 1863 INTEGER(iwp) :: num_h !< current number of surface element 1509 1864 INTEGER(iwp) :: num_h_kji !< dummy increment 1865 INTEGER(iwp) :: lsp !< running index for chemical species 1510 1866 1511 1867 TYPE( surf_type ) :: surf !< respective surface type … … 1543 1899 surf%ssws(num_h) = top_scalarflux 1544 1900 ! 1901 !-- Prescribe top chemical species' flux 1902 #if defined( __chem ) 1903 DO lsp = 1, nvar 1904 IF ( air_chemistry .AND. constant_top_csflux(lsp) ) THEN 1905 surf%cssws(lsp,num_h) = top_csflux(lsp) 1906 ENDIF 1907 ENDDO 1908 #endif 1909 ! 1545 1910 !-- Prescribe top salinity flux 1546 1911 IF ( ocean .AND. constant_top_salinityflux) & … … 1575 1940 IMPLICIT NONE 1576 1941 1577 INTEGER(iwp) :: component !<1942 INTEGER(iwp) :: component !< index of wall_fluxes_ array for respective orientation 1578 1943 INTEGER(iwp) :: i !< running index x-direction 1579 1944 INTEGER(iwp) :: j !< running index x-direction … … 1582 1947 INTEGER(iwp) :: num_v !< current number of surface element 1583 1948 INTEGER(iwp) :: num_v_kji !< current number of surface element at (j,i) 1949 INTEGER(iwp) :: lsp !< running index for chemical species 1584 1950 1585 1951 … … 1609 1975 !-- etc., on surface type (further below) 1610 1976 IF ( north_facing ) THEN 1611 surf%facing(num_v) = IBSET( surf%facing(num_v), 0 )1977 surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 ) 1612 1978 component = 4 1613 1979 ENDIF 1614 1980 1615 1981 IF ( south_facing ) THEN 1616 surf%facing(num_v) = IBSET( surf%facing(num_v), 1 )1982 surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 1617 1983 component = 3 1618 1984 ENDIF 1619 1985 1620 1986 IF ( east_facing ) THEN 1621 surf%facing(num_v) = IBSET( surf%facing(num_v), 2 )1987 surf%facing(num_v) = 7 !IBSET( surf%facing(num_v), 2 ) 1622 1988 component = 2 1623 1989 ENDIF 1624 1990 1625 1991 IF ( west_facing ) THEN 1626 surf%facing(num_v) = IBSET( surf%facing(num_v), 3 )1992 surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 1627 1993 component = 1 1628 1994 ENDIF … … 1647 2013 surf%ts(num_v) = 0.0_wp 1648 2014 surf%shf(num_v) = wall_heatflux(component) 2015 ! 2016 !-- Set initial value for surface temperature 2017 surf%pt_surface(num_v) = pt_surface 1649 2018 1650 2019 IF ( humidity ) THEN … … 1673 2042 surf%ssws(num_v) = wall_scalarflux(component) 1674 2043 ENDIF 2044 2045 #if defined( __chem ) 2046 IF ( air_chemistry ) THEN 2047 DO lsp = 1, nvar 2048 surf%css(lsp,num_v) = 0.0_wp 2049 surf%cssws(lsp,num_v) = wall_csflux(lsp,component) 2050 ENDDO 2051 ENDIF 2052 #endif 2053 1675 2054 ! 1676 2055 !-- So far, salinityflux at vertical surfaces is simply zero … … 1692 2071 !> Determines topography-top index at given (j,i)-position. 1693 2072 !------------------------------------------------------------------------------! 1694 FUNCTION get_topography_top_index( j, i, grid ) 1695 1696 USE kinds 2073 FUNCTION get_topography_top_index_ji( j, i, grid ) 1697 2074 1698 2075 IMPLICIT NONE 1699 2076 1700 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids1701 INTEGER(iwp) :: i !< grid index in x-dimension1702 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid1703 INTEGER(iwp) :: j !< grid index in y-dimension1704 INTEGER(iwp) :: get_topography_top_index !< topography top index2077 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids 2078 INTEGER(iwp) :: i !< grid index in x-dimension 2079 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid 2080 INTEGER(iwp) :: j !< grid index in y-dimension 2081 INTEGER(iwp) :: get_topography_top_index_ji !< topography top index 1705 2082 1706 2083 SELECT CASE ( TRIM( grid ) ) … … 1729 2106 END SELECT 1730 2107 1731 get_topography_top_index = MAXLOC(&2108 get_topography_top_index_ji = MAXLOC( & 1732 2109 MERGE( 1, 0, & 1733 2110 BTEST( wall_flags_0(:,j,i), ibit ) & 1734 2111 ), DIM = 1 & 1735 ) - 1 2112 ) - 1 2113 2114 RETURN 2115 2116 END FUNCTION get_topography_top_index_ji 2117 2118 !------------------------------------------------------------------------------! 2119 ! Description: 2120 ! ------------ 2121 !> Determines topography-top index at each (j,i)-position. 2122 !------------------------------------------------------------------------------! 2123 FUNCTION get_topography_top_index( grid ) 2124 2125 IMPLICIT NONE 2126 2127 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids 2128 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid 2129 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: get_topography_top_index !< topography top index 2130 2131 SELECT CASE ( TRIM( grid ) ) 2132 2133 CASE ( 's' ) 2134 ibit = 12 2135 CASE ( 'u' ) 2136 ibit = 14 2137 CASE ( 'v' ) 2138 ibit = 16 2139 CASE ( 'w' ) 2140 ibit = 18 2141 CASE ( 's_out' ) 2142 ibit = 24 2143 CASE ( 'u_out' ) 2144 ibit = 26 2145 CASE ( 'v_out' ) 2146 ibit = 27 2147 CASE ( 'w_out' ) 2148 ibit = 28 2149 CASE DEFAULT 2150 ! 2151 !-- Set default to scalar grid 2152 ibit = 12 2153 2154 END SELECT 2155 2156 get_topography_top_index(nys:nyn,nxl:nxr) = MAXLOC( & 2157 MERGE( 1, 0, & 2158 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), ibit )& 2159 ), DIM = 1 & 2160 ) - 1 1736 2161 1737 2162 RETURN … … 1754 2179 INTEGER(iwp) :: j !< running index y-direction 1755 2180 INTEGER(iwp) :: l !< index surface type orientation 2181 INTEGER(iwp) :: lsp !< running index chemical species 1756 2182 INTEGER(iwp) :: m !< running index for surface elements on individual surface array 1757 2183 INTEGER(iwp), DIMENSION(0:3) :: mm !< running index for surface elements on gathered surface array … … 1781 2207 DO l = 0, 3 1782 2208 surf_v(l)%ns = ns_v_on_file(l) 1783 CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,&2209 CALL allocate_surface_attributes_v( surf_v(l), & 1784 2210 nys, nyn, nxl, nxr ) 1785 2211 ENDDO … … 1823 2249 IF ( ALLOCATED( surf_def_h(l)%ssws ) ) & 1824 2250 surf_h(l)%ssws(mm(l)) = surf_def_h(l)%ssws(m) 2251 #if defined( __chem ) 2252 IF ( ALLOCATED( surf_def_h(l)%css ) ) THEN 2253 DO lsp = 1,nvar 2254 surf_h(l)%css(lsp,mm(l)) = surf_def_h(l)%css(lsp,m) 2255 ENDDO 2256 ENDIF 2257 IF ( ALLOCATED( surf_def_h(l)%cssws ) ) THEN 2258 DO lsp = 1,nvar 2259 surf_h(l)%cssws(lsp,mm(l)) = surf_def_h(l)%cssws(lsp,m) 2260 ENDDO 2261 ENDIF 2262 #endif 1825 2263 IF ( ALLOCATED( surf_def_h(l)%ncsws ) ) & 1826 2264 surf_h(l)%ncsws(mm(l)) = surf_def_h(l)%ncsws(m) … … 1866 2304 IF ( ALLOCATED( surf_lsm_h%ssws ) ) & 1867 2305 surf_h(0)%ssws(mm(0)) = surf_lsm_h%ssws(m) 2306 #if defined( __chem ) 2307 IF ( ALLOCATED( surf_lsm_h%css ) ) THEN 2308 DO lsp = 1, nvar 2309 surf_h(0)%css(lsp,mm(0)) = surf_lsm_h%css(lsp,m) 2310 ENDDO 2311 ENDIF 2312 IF ( ALLOCATED( surf_lsm_h%cssws ) ) THEN 2313 DO lsp = 1, nvar 2314 surf_h(0)%cssws(lsp,mm(0)) = surf_lsm_h%cssws(lsp,m) 2315 ENDDO 2316 ENDIF 2317 #endif 1868 2318 IF ( ALLOCATED( surf_lsm_h%ncsws ) ) & 1869 2319 surf_h(0)%ncsws(mm(0)) = surf_lsm_h%ncsws(m) … … 1909 2359 IF ( ALLOCATED( surf_usm_h%ssws ) ) & 1910 2360 surf_h(0)%ssws(mm(0)) = surf_usm_h%ssws(m) 2361 #if defined( __chem ) 2362 IF ( ALLOCATED( surf_usm_h%css ) ) THEN 2363 DO lsp = 1, nvar 2364 surf_h(0)%css(lsp,mm(0)) = surf_usm_h%css(lsp,m) 2365 ENDDO 2366 ENDIF 2367 IF ( ALLOCATED( surf_usm_h%cssws ) ) THEN 2368 DO lsp = 1, nvar 2369 surf_h(0)%cssws(lsp,mm(0)) = surf_usm_h%cssws(lsp,m) 2370 ENDDO 2371 ENDIF 2372 #endif 1911 2373 IF ( ALLOCATED( surf_usm_h%ncsws ) ) & 1912 2374 surf_h(0)%ncsws(mm(0)) = surf_usm_h%ncsws(m) … … 1926 2388 1927 2389 ENDDO 1928 IF ( l == 0 ) THEN 1929 surf_h(l)%start_index = MAX( surf_def_h(l)%start_index, & 1930 surf_lsm_h%start_index, & 1931 surf_usm_h%start_index ) 1932 surf_h(l)%end_index = MAX( surf_def_h(l)%end_index, & 1933 surf_lsm_h%end_index, & 1934 surf_usm_h%end_index ) 1935 ELSE 1936 surf_h(l)%start_index = surf_def_h(l)%start_index 1937 surf_h(l)%end_index = surf_def_h(l)%end_index 1938 ENDIF 2390 ! 2391 !-- Gather start- and end indices 2392 DO i = nxl, nxr 2393 DO j = nys, nyn 2394 IF ( surf_def_h(l)%start_index(j,i) <= & 2395 surf_def_h(l)%end_index(j,i) ) THEN 2396 surf_h(l)%start_index(j,i) = surf_def_h(l)%start_index(j,i) 2397 surf_h(l)%end_index(j,i) = surf_def_h(l)%end_index(j,i) 2398 ENDIF 2399 IF ( l == 0 ) THEN 2400 IF ( surf_lsm_h%start_index(j,i) <= & 2401 surf_lsm_h%end_index(j,i) ) THEN 2402 surf_h(l)%start_index(j,i) = surf_lsm_h%start_index(j,i) 2403 surf_h(l)%end_index(j,i) = surf_lsm_h%end_index(j,i) 2404 ENDIF 2405 IF ( surf_usm_h%start_index(j,i) <= & 2406 surf_usm_h%end_index(j,i) ) THEN 2407 surf_h(l)%start_index(j,i) = surf_usm_h%start_index(j,i) 2408 surf_h(l)%end_index(j,i) = surf_usm_h%end_index(j,i) 2409 ENDIF 2410 ENDIF 2411 ENDDO 2412 ENDDO 1939 2413 ENDDO 1940 2414 … … 1972 2446 IF ( ALLOCATED( surf_def_v(l)%ssws ) ) & 1973 2447 surf_v(l)%ssws(mm(l)) = surf_def_v(l)%ssws(m) 2448 #if defined( __chem ) 2449 IF ( ALLOCATED( surf_def_v(l)%css ) ) THEN 2450 DO lsp = 1, nvar 2451 surf_v(l)%css(lsp,mm(l)) = surf_def_v(l)%css(lsp,m) 2452 ENDDO 2453 ENDIF 2454 IF ( ALLOCATED( surf_def_v(l)%cssws ) ) THEN 2455 DO lsp = 1, nvar 2456 surf_v(l)%cssws(lsp,mm(l)) = surf_def_v(l)%cssws(lsp,m) 2457 ENDDO 2458 ENDIF 2459 #endif 1974 2460 IF ( ALLOCATED( surf_def_v(l)%ncsws ) ) & 1975 2461 surf_v(l)%ncsws(mm(l)) = surf_def_v(l)%ncsws(m) … … 2020 2506 IF ( ALLOCATED( surf_lsm_v(l)%ssws ) ) & 2021 2507 surf_v(l)%ssws(mm(l)) = surf_lsm_v(l)%ssws(m) 2508 #if defined( __chem ) 2509 IF ( ALLOCATED( surf_lsm_v(l)%css ) ) THEN 2510 DO lsp = 1, nvar 2511 surf_v(l)%css(lsp,mm(l)) = surf_lsm_v(l)%css(lsp,m) 2512 ENDDO 2513 ENDIF 2514 IF ( ALLOCATED( surf_lsm_v(l)%cssws ) ) THEN 2515 DO lsp = 1, nvar 2516 surf_v(l)%cssws(lsp,mm(l)) = surf_lsm_v(l)%cssws(lsp,m) 2517 ENDDO 2518 ENDIF 2519 #endif 2022 2520 IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) ) & 2023 2521 surf_v(l)%ncsws(mm(l)) = surf_lsm_v(l)%ncsws(m) … … 2068 2566 IF ( ALLOCATED( surf_usm_v(l)%ssws ) ) & 2069 2567 surf_v(l)%ssws(mm(l)) = surf_usm_v(l)%ssws(m) 2568 #if defined( __chem ) 2569 IF ( ALLOCATED( surf_usm_v(l)%css ) ) THEN 2570 DO lsp = 1, nvar 2571 surf_v(l)%css(lsp,mm(l)) = surf_usm_v(l)%css(lsp,m) 2572 ENDDO 2573 ENDIF 2574 IF ( ALLOCATED( surf_usm_v(l)%cssws ) ) THEN 2575 DO lsp = 1, nvar 2576 surf_v(l)%cssws(lsp,mm(l)) = surf_usm_v(l)%cssws(lsp,m) 2577 ENDDO 2578 ENDIF 2579 #endif 2070 2580 IF ( ALLOCATED( surf_usm_v(l)%ncsws ) ) & 2071 2581 surf_v(l)%ncsws(mm(l)) = surf_usm_v(l)%ncsws(m) … … 2171 2681 WRITE ( 14 ) surf_h(l)%ssws 2172 2682 ENDIF 2683 #if defined ( __chem ) 2684 WRITE ( 14 ) 'surf_h(' // dum // ')%css ' 2685 IF ( ALLOCATED ( surf_h(l)%css ) ) THEN 2686 WRITE ( 14 ) surf_h(l)%css 2687 ENDIF 2688 WRITE ( 14 ) 'surf_h(' // dum // ')%cssws ' 2689 IF ( ALLOCATED ( surf_h(l)%cssws ) ) THEN 2690 WRITE ( 14 ) surf_h(l)%cssws 2691 ENDIF 2692 #endif 2173 2693 WRITE ( 14 ) 'surf_h(' // dum // ')%qcsws ' 2174 2694 IF ( ALLOCATED ( surf_h(l)%qcsws ) ) THEN … … 2254 2774 WRITE ( 14 ) surf_v(l)%ssws 2255 2775 ENDIF 2776 #if defined( __chem ) 2777 WRITE ( 14 ) 'surf_v(' // dum // ')%css ' 2778 IF ( ALLOCATED ( surf_v(l)%css ) ) THEN 2779 WRITE ( 14 ) surf_v(l)%css 2780 ENDIF 2781 WRITE ( 14 ) 'surf_v(' // dum // ')%cssws ' 2782 IF ( ALLOCATED ( surf_v(l)%cssws ) ) THEN 2783 WRITE ( 14 ) surf_v(l)%cssws 2784 ENDIF 2785 #endif 2256 2786 WRITE ( 14 ) 'surf_v(' // dum // ')%qcsws ' 2257 2787 IF ( ALLOCATED ( surf_v(l)%qcsws ) ) THEN … … 2399 2929 DO l = 0, 3 2400 2930 surf_v(l)%ns = ns_v_on_file(l) 2401 CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,&2931 CALL allocate_surface_attributes_v( surf_v(l), & 2402 2932 nys_on_file, nyn_on_file, & 2403 2933 nxl_on_file, nxr_on_file ) … … 2486 3016 IF ( ALLOCATED( surf_h(0)%ssws ) .AND. kk == 1 ) & 2487 3017 READ ( 13 ) surf_h(0)%ssws 3018 #if defined( __chem ) 3019 CASE ( 'surf_h(0)%css' ) 3020 IF ( ALLOCATED( surf_h(0)%css ) .AND. kk == 1 ) & 3021 READ ( 13 ) surf_h(0)%css 3022 CASE ( 'surf_h(0)%cssws' ) 3023 IF ( ALLOCATED( surf_h(0)%cssws ) .AND. kk == 1 ) & 3024 READ ( 13 ) surf_h(0)%cssws 3025 #endif 2488 3026 CASE ( 'surf_h(0)%qcsws' ) 2489 3027 IF ( ALLOCATED( surf_h(0)%qcsws ) .AND. kk == 1 ) & … … 2554 3092 IF ( ALLOCATED( surf_h(1)%ssws ) .AND. kk == 1 ) & 2555 3093 READ ( 13 ) surf_h(1)%ssws 3094 #if defined( __chem ) 3095 CASE ( 'surf_h(1)%css' ) 3096 IF ( ALLOCATED( surf_h(1)%css ) .AND. kk == 1 ) & 3097 READ ( 13 ) surf_h(1)%css 3098 CASE ( 'surf_h(1)%cssws' ) 3099 IF ( ALLOCATED( surf_h(1)%cssws ) .AND. kk == 1 ) & 3100 READ ( 13 ) surf_h(1)%cssws 3101 #endif 2556 3102 CASE ( 'surf_h(1)%qcsws' ) 2557 3103 IF ( ALLOCATED( surf_h(1)%qcsws ) .AND. kk == 1 ) & … … 2622 3168 IF ( ALLOCATED( surf_h(2)%ssws ) .AND. kk == 1 ) & 2623 3169 READ ( 13 ) surf_h(2)%ssws 3170 #if defined( __chem ) 3171 CASE ( 'surf_h(2)%css' ) 3172 IF ( ALLOCATED( surf_h(2)%css ) .AND. kk == 1 ) & 3173 READ ( 13 ) surf_h(2)%css 3174 CASE ( 'surf_h(2)%cssws' ) 3175 IF ( ALLOCATED( surf_h(2)%cssws ) .AND. kk == 1 ) & 3176 READ ( 13 ) surf_h(2)%cssws 3177 #endif 2624 3178 CASE ( 'surf_h(2)%qcsws' ) 2625 3179 IF ( ALLOCATED( surf_h(2)%qcsws ) .AND. kk == 1 ) & … … 2686 3240 IF ( ALLOCATED( surf_v(0)%ssws ) .AND. kk == 1 ) & 2687 3241 READ ( 13 ) surf_v(0)%ssws 3242 #if defined( __chem ) 3243 CASE ( 'surf_v(0)%css' ) 3244 IF ( ALLOCATED( surf_v(0)%css ) .AND. kk == 1 ) & 3245 READ ( 13 ) surf_v(0)%css 3246 CASE ( 'surf_v(0)%cssws' ) 3247 IF ( ALLOCATED( surf_v(0)%cssws ) .AND. kk == 1 ) & 3248 READ ( 13 ) surf_v(0)%cssws 3249 #endif 2688 3250 CASE ( 'surf_v(0)%qcsws' ) 2689 3251 IF ( ALLOCATED( surf_v(0)%qcsws ) .AND. kk == 1 ) & … … 2757 3319 IF ( ALLOCATED( surf_v(1)%ssws ) .AND. kk == 1 ) & 2758 3320 READ ( 13 ) surf_v(1)%ssws 3321 #if defined( __chem ) 3322 CASE ( 'surf_v(1)%css' ) 3323 IF ( ALLOCATED( surf_v(1)%css ) .AND. kk == 1 ) & 3324 READ ( 13 ) surf_v(1)%css 3325 CASE ( 'surf_v(1)%cssws' ) 3326 IF ( ALLOCATED( surf_v(1)%cssws ) .AND. kk == 1 ) & 3327 READ ( 13 ) surf_v(1)%cssws 3328 #endif 2759 3329 CASE ( 'surf_v(1)%qcsws' ) 2760 3330 IF ( ALLOCATED( surf_v(1)%qcsws ) .AND. kk == 1 ) & … … 2828 3398 IF ( ALLOCATED( surf_v(2)%ssws ) .AND. kk == 1 ) & 2829 3399 READ ( 13 ) surf_v(2)%ssws 3400 #if defined( __chem ) 3401 CASE ( 'surf_v(2)%css' ) 3402 IF ( ALLOCATED( surf_v(2)%css ) .AND. kk == 1 ) & 3403 READ ( 13 ) surf_v(2)%css 3404 CASE ( 'surf_v(2)%cssws' ) 3405 IF ( ALLOCATED( surf_v(2)%cssws ) .AND. kk == 1 ) & 3406 READ ( 13 ) surf_v(2)%cssws 3407 #endif 2830 3408 CASE ( 'surf_v(2)%qcsws' ) 2831 3409 IF ( ALLOCATED( surf_v(2)%qcsws ) .AND. kk == 1 ) & … … 2899 3477 IF ( ALLOCATED( surf_v(3)%ssws ) .AND. kk == 1 ) & 2900 3478 READ ( 13 ) surf_v(3)%ssws 3479 #if defined( __chem ) 3480 CASE ( 'surf_v(3)%css' ) 3481 IF ( ALLOCATED( surf_v(3)%css ) .AND. kk == 1 ) & 3482 READ ( 13 ) surf_v(3)%css 3483 CASE ( 'surf_v(3)%cssws' ) 3484 IF ( ALLOCATED( surf_v(3)%cssws ) .AND. kk == 1 ) & 3485 READ ( 13 ) surf_v(3)%cssws 3486 #endif 2901 3487 CASE ( 'surf_v(3)%qcsws' ) 2902 3488 IF ( ALLOCATED( surf_v(3)%qcsws ) .AND. kk == 1 ) & … … 3047 3633 INTEGER(iwp) :: m_file !< respective surface-element index of current surface array 3048 3634 INTEGER(iwp) :: m_target !< respecitve surface-element index of surface array on file 3635 INTEGER(iwp) :: lsp !< running index chemical species 3049 3636 3050 3637 TYPE( surf_type ) :: surf_target !< target surface type 3051 3638 TYPE( surf_type ) :: surf_file !< surface type on file 3052 3639 3053 IF ( SCAN( TRIM( field_chr ), '%us' ) /= 0 ) THEN3640 IF ( INDEX( TRIM( field_chr ), '%us' ) /= 0 ) THEN 3054 3641 IF ( ALLOCATED( surf_target%us ) .AND. & 3055 3642 ALLOCATED( surf_file%us ) ) & … … 3057 3644 ENDIF 3058 3645 3059 IF ( SCAN( TRIM( field_chr ), '%ol' ) /= 0 ) THEN3646 IF ( INDEX( TRIM( field_chr ), '%ol' ) /= 0 ) THEN 3060 3647 IF ( ALLOCATED( surf_target%ol ) .AND. & 3061 3648 ALLOCATED( surf_file%ol ) ) & … … 3063 3650 ENDIF 3064 3651 3065 IF ( SCAN( TRIM( field_chr ), '%usws' ) /= 0 ) THEN3652 IF ( INDEX( TRIM( field_chr ), '%usws' ) /= 0 ) THEN 3066 3653 IF ( ALLOCATED( surf_target%usws ) .AND. & 3067 3654 ALLOCATED( surf_file%usws ) ) & … … 3069 3656 ENDIF 3070 3657 3071 IF ( SCAN( TRIM( field_chr ), '%vsws' ) /= 0 ) THEN3658 IF ( INDEX( TRIM( field_chr ), '%vsws' ) /= 0 ) THEN 3072 3659 IF ( ALLOCATED( surf_target%vsws ) .AND. & 3073 3660 ALLOCATED( surf_file%vsws ) ) & … … 3075 3662 ENDIF 3076 3663 3077 IF ( SCAN( TRIM( field_chr ), '%ts' ) /= 0 ) THEN3664 IF ( INDEX( TRIM( field_chr ), '%ts' ) /= 0 ) THEN 3078 3665 IF ( ALLOCATED( surf_target%ts ) .AND. & 3079 3666 ALLOCATED( surf_file%ts ) ) & … … 3081 3668 ENDIF 3082 3669 3083 IF ( SCAN( TRIM( field_chr ), '%shf' ) /= 0 ) THEN3670 IF ( INDEX( TRIM( field_chr ), '%shf' ) /= 0 ) THEN 3084 3671 IF ( ALLOCATED( surf_target%shf ) .AND. & 3085 3672 ALLOCATED( surf_file%shf ) ) & … … 3087 3674 ENDIF 3088 3675 3089 IF ( SCAN( TRIM( field_chr ), '%qs' ) /= 0 ) THEN3676 IF ( INDEX( TRIM( field_chr ), '%qs' ) /= 0 ) THEN 3090 3677 IF ( ALLOCATED( surf_target%qs ) .AND. & 3091 3678 ALLOCATED( surf_file%qs ) ) & … … 3093 3680 ENDIF 3094 3681 3095 IF ( SCAN( TRIM( field_chr ), '%qsws' ) /= 0 ) THEN3682 IF ( INDEX( TRIM( field_chr ), '%qsws' ) /= 0 ) THEN 3096 3683 IF ( ALLOCATED( surf_target%qsws ) .AND. & 3097 3684 ALLOCATED( surf_file%qsws ) ) & … … 3099 3686 ENDIF 3100 3687 3101 IF ( SCAN( TRIM( field_chr ), '%ss' ) /= 0 ) THEN3688 IF ( INDEX( TRIM( field_chr ), '%ss' ) /= 0 ) THEN 3102 3689 IF ( ALLOCATED( surf_target%ss ) .AND. & 3103 3690 ALLOCATED( surf_file%ss ) ) & … … 3105 3692 ENDIF 3106 3693 3107 IF ( SCAN( TRIM( field_chr ), '%ssws' ) /= 0 ) THEN3694 IF ( INDEX( TRIM( field_chr ), '%ssws' ) /= 0 ) THEN 3108 3695 IF ( ALLOCATED( surf_target%ssws ) .AND. & 3109 3696 ALLOCATED( surf_file%ssws ) ) & … … 3111 3698 ENDIF 3112 3699 3113 IF ( SCAN( TRIM( field_chr ), '%qcs' ) /= 0 ) THEN 3700 #if defined( __chem ) 3701 IF ( INDEX( TRIM( field_chr ), '%css' ) /= 0 ) THEN 3702 IF ( ALLOCATED( surf_target%css ) .AND. & 3703 ALLOCATED( surf_file%css ) ) THEN 3704 DO lsp = 1, nvar 3705 surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file) 3706 ENDDO 3707 ENDIF 3708 ENDIF 3709 IF ( INDEX( TRIM( field_chr ), '%cssws' ) /= 0 ) THEN 3710 IF ( ALLOCATED( surf_target%cssws ) .AND. & 3711 ALLOCATED( surf_file%cssws ) ) THEN 3712 DO lsp = 1, nvar 3713 surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file) 3714 ENDDO 3715 ENDIF 3716 ENDIF 3717 #endif 3718 3719 IF ( INDEX( TRIM( field_chr ), '%qcs' ) /= 0 ) THEN 3114 3720 IF ( ALLOCATED( surf_target%qcs ) .AND. & 3115 3721 ALLOCATED( surf_file%qcs ) ) & … … 3117 3723 ENDIF 3118 3724 3119 IF ( SCAN( TRIM( field_chr ), '%qcsws' ) /= 0 ) THEN3725 IF ( INDEX( TRIM( field_chr ), '%qcsws' ) /= 0 ) THEN 3120 3726 IF ( ALLOCATED( surf_target%qcsws ) .AND. & 3121 3727 ALLOCATED( surf_file%qcsws ) ) & … … 3123 3729 ENDIF 3124 3730 3125 IF ( SCAN( TRIM( field_chr ), '%ncs' ) /= 0 ) THEN3731 IF ( INDEX( TRIM( field_chr ), '%ncs' ) /= 0 ) THEN 3126 3732 IF ( ALLOCATED( surf_target%ncs ) .AND. & 3127 3733 ALLOCATED( surf_file%ncs ) ) & … … 3129 3735 ENDIF 3130 3736 3131 IF ( SCAN( TRIM( field_chr ), '%ncsws' ) /= 0 ) THEN3737 IF ( INDEX( TRIM( field_chr ), '%ncsws' ) /= 0 ) THEN 3132 3738 IF ( ALLOCATED( surf_target%ncsws ) .AND. & 3133 3739 ALLOCATED( surf_file%ncsws ) ) & … … 3135 3741 ENDIF 3136 3742 3137 IF ( SCAN( TRIM( field_chr ), '%qrs' ) /= 0 ) THEN3743 IF ( INDEX( TRIM( field_chr ), '%qrs' ) /= 0 ) THEN 3138 3744 IF ( ALLOCATED( surf_target%qrs ) .AND. & 3139 3745 ALLOCATED( surf_file%qrs ) ) & … … 3141 3747 ENDIF 3142 3748 3143 IF ( SCAN( TRIM( field_chr ), '%qrsws' ) /= 0 ) THEN3749 IF ( INDEX( TRIM( field_chr ), '%qrsws' ) /= 0 ) THEN 3144 3750 IF ( ALLOCATED( surf_target%qrsws ) .AND. & 3145 3751 ALLOCATED( surf_file%qrsws ) ) & … … 3147 3753 ENDIF 3148 3754 3149 IF ( SCAN( TRIM( field_chr ), '%nrs' ) /= 0 ) THEN3755 IF ( INDEX( TRIM( field_chr ), '%nrs' ) /= 0 ) THEN 3150 3756 IF ( ALLOCATED( surf_target%nrs ) .AND. & 3151 3757 ALLOCATED( surf_file%nrs ) ) & … … 3153 3759 ENDIF 3154 3760 3155 IF ( SCAN( TRIM( field_chr ), '%nrsws' ) /= 0 ) THEN3761 IF ( INDEX( TRIM( field_chr ), '%nrsws' ) /= 0 ) THEN 3156 3762 IF ( ALLOCATED( surf_target%nrsws ) .AND. & 3157 3763 ALLOCATED( surf_file%nrsws ) ) & … … 3159 3765 ENDIF 3160 3766 3161 IF ( SCAN( TRIM( field_chr ), '%sasws' ) /= 0 ) THEN3767 IF ( INDEX( TRIM( field_chr ), '%sasws' ) /= 0 ) THEN 3162 3768 IF ( ALLOCATED( surf_target%sasws ) .AND. & 3163 3769 ALLOCATED( surf_file%sasws ) ) & … … 3165 3771 ENDIF 3166 3772 3167 IF ( SCAN( TRIM( field_chr ), '%mom_uv' ) /= 0 ) THEN3773 IF ( INDEX( TRIM( field_chr ), '%mom_uv' ) /= 0 ) THEN 3168 3774 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. & 3169 3775 ALLOCATED( surf_file%mom_flux_uv ) ) & … … 3172 3778 ENDIF 3173 3779 3174 IF ( SCAN( TRIM( field_chr ), '%mom_w' ) /= 0 ) THEN3780 IF ( INDEX( TRIM( field_chr ), '%mom_w' ) /= 0 ) THEN 3175 3781 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. & 3176 3782 ALLOCATED( surf_file%mom_flux_w ) ) & … … 3179 3785 ENDIF 3180 3786 3181 IF ( SCAN( TRIM( field_chr ), '%mom_tke' ) /= 0 ) THEN3787 IF ( INDEX( TRIM( field_chr ), '%mom_tke' ) /= 0 ) THEN 3182 3788 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. & 3183 3789 ALLOCATED( surf_file%mom_flux_tke ) ) & … … 3214 3820 END SUBROUTINE surface_last_actions 3215 3821 3822 !------------------------------------------------------------------------------! 3823 ! Description: 3824 ! ------------ 3825 !> Routine maps surface data read from file after restart - 1D arrays 3826 !------------------------------------------------------------------------------! 3827 SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, & 3828 start_index_c, & 3829 start_index_on_file, & 3830 end_index_on_file, & 3831 nxlc, nysc, nxlf, nxrf, nysf, nynf,& 3832 nys_on_file, nyn_on_file, & 3833 nxl_on_file,nxr_on_file ) 3834 3835 IMPLICIT NONE 3836 3837 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 3838 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 3839 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 3840 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 3841 INTEGER(iwp) :: m !< surface-element index on file 3842 INTEGER(iwp) :: mm !< surface-element index on current subdomain 3843 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 3844 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 3845 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 3846 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 3847 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 3848 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 3849 3850 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 3851 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 3852 INTEGER(iwp) :: nyn_on_file !< northmost index on file 3853 INTEGER(iwp) :: nys_on_file !< southmost index on file 3854 3855 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 3856 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 3857 start_index_on_file !< start index of surface elements on file 3858 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 3859 end_index_on_file !< end index of surface elements on file 3860 3861 REAL(wp), DIMENSION(:) :: surf_target !< target surface type 3862 REAL(wp), DIMENSION(:) :: surf_file !< surface type on file 3863 3864 ic = nxlc 3865 DO i = nxlf, nxrf 3866 jc = nysc 3867 DO j = nysf, nynf 3868 3869 mm = start_index_c(jc,ic) 3870 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 3871 surf_target(mm) = surf_file(m) 3872 mm = mm + 1 3873 ENDDO 3874 3875 jc = jc + 1 3876 ENDDO 3877 ic = ic + 1 3878 ENDDO 3879 3880 3881 END SUBROUTINE surface_restore_elements_1d 3882 3883 !------------------------------------------------------------------------------! 3884 ! Description: 3885 ! ------------ 3886 !> Routine maps surface data read from file after restart - 2D arrays 3887 !------------------------------------------------------------------------------! 3888 SUBROUTINE surface_restore_elements_2d( surf_target, surf_file, & 3889 start_index_c, & 3890 start_index_on_file, & 3891 end_index_on_file, & 3892 nxlc, nysc, nxlf, nxrf, nysf, nynf,& 3893 nys_on_file, nyn_on_file, & 3894 nxl_on_file,nxr_on_file ) 3895 3896 IMPLICIT NONE 3897 3898 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 3899 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 3900 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 3901 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 3902 INTEGER(iwp) :: m !< surface-element index on file 3903 INTEGER(iwp) :: mm !< surface-element index on current subdomain 3904 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 3905 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 3906 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 3907 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 3908 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 3909 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 3910 3911 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 3912 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 3913 INTEGER(iwp) :: nyn_on_file !< northmost index on file 3914 INTEGER(iwp) :: nys_on_file !< southmost index on file 3915 3916 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c !< start index of surface type 3917 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 3918 start_index_on_file !< start index of surface elements on file 3919 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 3920 end_index_on_file !< end index of surface elements on file 3921 3922 REAL(wp), DIMENSION(:,:) :: surf_target !< target surface type 3923 REAL(wp), DIMENSION(:,:) :: surf_file !< surface type on file 3924 3925 ic = nxlc 3926 DO i = nxlf, nxrf 3927 jc = nysc 3928 DO j = nysf, nynf 3929 mm = start_index_c(jc,ic) 3930 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 3931 surf_target(:,mm) = surf_file(:,m) 3932 mm = mm + 1 3933 ENDDO 3934 3935 jc = jc + 1 3936 ENDDO 3937 ic = ic + 1 3938 ENDDO 3939 3940 END SUBROUTINE surface_restore_elements_2d 3941 3216 3942 3217 3943 END MODULE surface_mod
Note: See TracChangeset
for help on using the changeset viewer.
