Changeset 4150 for palm/trunk/SOURCE/surface_mod.f90
- Timestamp:
- Aug 8, 2019 8:00:47 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_mod.f90
r4104 r4150 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Generic routine to initialize single surface properties added 29 ! 30 ! 4104 2019-07-17 17:08:20Z suehring 28 31 ! Bugfix, initialization of index space for boundary data structure accidantly 29 32 ! run over ghost points, causing a segmentation fault. … … 642 645 END INTERFACE init_bc 643 646 647 INTERFACE init_single_surface_properties 648 MODULE PROCEDURE init_single_surface_properties 649 END INTERFACE init_single_surface_properties 650 644 651 INTERFACE init_surfaces 645 652 MODULE PROCEDURE init_surfaces … … 685 692 ! 686 693 !-- Public subroutines and functions 687 PUBLIC get_topography_top_index, get_topography_top_index_ji, init_bc, init_surfaces, & 688 init_surface_arrays, surface_rrd_local, surface_restore_elements, surface_wrd_local, & 689 surface_last_actions 694 PUBLIC get_topography_top_index, & 695 get_topography_top_index_ji, & 696 init_bc, & 697 init_single_surface_properties, & 698 init_surfaces, & 699 init_surface_arrays, & 700 surface_last_actions, & 701 surface_rrd_local, & 702 surface_restore_elements, & 703 surface_wrd_local 690 704 691 705 #if defined( _OPENACC ) … … 3035 3049 END SUBROUTINE init_surfaces 3036 3050 3051 ! Description: 3052 ! ------------ 3053 !> Initialize single surface properties from 2D input arrays 3054 !------------------------------------------------------------------------------! 3055 SUBROUTINE init_single_surface_properties( var_surf, var_2d, & 3056 ns, fill_value, & 3057 index_space_i, & 3058 index_space_j & 3059 ) 3060 3061 INTEGER(iwp) :: m !< running index over surface elements 3062 INTEGER(iwp) :: ns !< number of surface elements in var_surf 3063 3064 INTEGER(iwp), DIMENSION(1:ns) :: index_space_i !< grid indices along x direction where surface properties should be defined 3065 INTEGER(iwp), DIMENSION(1:ns) :: index_space_j !< grid indices along y direction where surface properties should be defined 3066 3067 REAL(wp) :: fill_value !< fill value in var_2d 3068 3069 REAL(wp), DIMENSION(1:ns) :: var_surf !< 1D surface variable that should be initialized 3070 REAL(wp), DIMENSION(nys:nyn,nxl:nxr) :: var_2d !< input variable 3071 3072 DO m = 1, ns 3073 IF ( var_2d(index_space_j(m),index_space_i(m)) /= fill_value ) THEN 3074 var_surf(m) = var_2d(index_space_j(m),index_space_i(m)) 3075 ENDIF 3076 ENDDO 3077 3078 END SUBROUTINE init_single_surface_properties 3037 3079 3038 3080 !------------------------------------------------------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.