Changeset 2317 for palm/trunk/SOURCE/surface_mod.f90

Timestamp:

Jul 20, 2017 5:27:19 PM (8 years ago)

Author:

suehring

Message:

get topograpyh top index via function call

File:

• palm/trunk/SOURCE/surface_mod.f90 (modified) (4 diffs)

palm/trunk/SOURCE/surface_mod.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-! 
+! New function to obtain topography top index. 
 ! 
 ! Former revisions:
@@ -269 +269 @@
 
     PRIVATE
+
+    INTERFACE get_topography_top_index
+       MODULE PROCEDURE get_topography_top_index
+    END  INTERFACE get_topography_top_index
+
+    INTERFACE init_bc
+       MODULE PROCEDURE init_bc
+    END INTERFACE init_bc
+
+    INTERFACE init_surfaces
+       MODULE PROCEDURE init_surfaces
+    END INTERFACE init_surfaces
+
+    INTERFACE init_surface_arrays
+       MODULE PROCEDURE init_surface_arrays
+    END INTERFACE init_surface_arrays
+
+    INTERFACE surface_read_restart_data
+       MODULE PROCEDURE surface_read_restart_data
+    END INTERFACE surface_read_restart_data
+
+    INTERFACE surface_write_restart_data
+       MODULE PROCEDURE surface_write_restart_data
+    END INTERFACE surface_write_restart_data
+
+    INTERFACE surface_last_actions
+       MODULE PROCEDURE surface_last_actions
+    END INTERFACE surface_last_actions
+
 !
 !-- Public variables
@@ -274 +303 @@
            surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type
 !
-!-- Public subroutines
-    PUBLIC init_bc, init_surfaces, init_surface_arrays,                        &
-           surface_read_restart_data, surface_write_restart_data,              &
-           surface_last_actions
-
-    INTERFACE init_bc
-       MODULE PROCEDURE init_bc
-    END INTERFACE init_bc
-
-    INTERFACE init_surfaces
-       MODULE PROCEDURE init_surfaces
-    END INTERFACE init_surfaces
-
-    INTERFACE init_surface_arrays
-       MODULE PROCEDURE init_surface_arrays
-    END INTERFACE init_surface_arrays
-
-    INTERFACE surface_read_restart_data
-       MODULE PROCEDURE surface_read_restart_data
-    END INTERFACE surface_read_restart_data
-
-    INTERFACE surface_write_restart_data
-       MODULE PROCEDURE surface_write_restart_data
-    END INTERFACE surface_write_restart_data
-
-    INTERFACE surface_last_actions
-       MODULE PROCEDURE surface_last_actions
-    END INTERFACE surface_last_actions
+!-- Public subroutines and functions
+    PUBLIC get_topography_top_index, init_bc, init_surfaces,                   &
+           init_surface_arrays, surface_read_restart_data,                     &
+           surface_write_restart_data, surface_last_actions
 
 
@@ -1642 +1647 @@
 
     END SUBROUTINE init_surfaces
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Determines topography-top index at given (j,i)-position.  
+!------------------------------------------------------------------------------!
+    FUNCTION get_topography_top_index( j, i, grid )
+
+       USE kinds
+
+       IMPLICIT NONE 
+
+       CHARACTER(LEN=*) ::  grid                      !< flag to distinquish between staggered grids
+       INTEGER(iwp)     ::  i                         !< grid index in x-dimension
+       INTEGER(iwp)     ::  ibit                      !< bit position where topography information is stored on respective grid
+       INTEGER(iwp)     ::  j                         !< grid index in y-dimension
+       INTEGER(iwp)     ::  get_topography_top_index  !< topography top index
+
+       SELECT CASE ( TRIM( grid ) )
+
+          CASE ( 's'     )
+             ibit = 12
+          CASE ( 'u'     )
+             ibit = 14
+          CASE ( 'v'     )
+             ibit = 16
+          CASE ( 'w'     )
+             ibit = 18
+          CASE ( 's_out' )
+             ibit = 24
+          CASE ( 'u_out' )
+             ibit = 26
+          CASE ( 'v_out' )
+             ibit = 27
+          CASE ( 'w_out' )
+             ibit = 28
+          CASE DEFAULT
+!
+!--          Set default to scalar grid
+             ibit = 12 
+
+       END SELECT
+
+       get_topography_top_index = MAXLOC(                                      &
+                                     MERGE( 1, 0,                              &
+                                            BTEST( wall_flags_0(:,j,i), ibit ) &
+                                          ), DIM = 1                           &
+                                        ) - 1
+
+       RETURN
+
+    END FUNCTION get_topography_top_index
 
 !------------------------------------------------------------------------------!