Ignore:
Timestamp:
Jul 20, 2017 5:27:19 PM (4 years ago)
Author:
suehring
Message:

get topograpyh top index via function call

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/surface_mod.f90

    r2292 r2317  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! New function to obtain topography top index.
    2323!
    2424! Former revisions:
     
    269269
    270270    PRIVATE
     271
     272    INTERFACE get_topography_top_index
     273       MODULE PROCEDURE get_topography_top_index
     274    END  INTERFACE get_topography_top_index
     275
     276    INTERFACE init_bc
     277       MODULE PROCEDURE init_bc
     278    END INTERFACE init_bc
     279
     280    INTERFACE init_surfaces
     281       MODULE PROCEDURE init_surfaces
     282    END INTERFACE init_surfaces
     283
     284    INTERFACE init_surface_arrays
     285       MODULE PROCEDURE init_surface_arrays
     286    END INTERFACE init_surface_arrays
     287
     288    INTERFACE surface_read_restart_data
     289       MODULE PROCEDURE surface_read_restart_data
     290    END INTERFACE surface_read_restart_data
     291
     292    INTERFACE surface_write_restart_data
     293       MODULE PROCEDURE surface_write_restart_data
     294    END INTERFACE surface_write_restart_data
     295
     296    INTERFACE surface_last_actions
     297       MODULE PROCEDURE surface_last_actions
     298    END INTERFACE surface_last_actions
     299
    271300!
    272301!-- Public variables
     
    274303           surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type
    275304!
    276 !-- Public subroutines
    277     PUBLIC init_bc, init_surfaces, init_surface_arrays,                        &
    278            surface_read_restart_data, surface_write_restart_data,              &
    279            surface_last_actions
    280 
    281     INTERFACE init_bc
    282        MODULE PROCEDURE init_bc
    283     END INTERFACE init_bc
    284 
    285     INTERFACE init_surfaces
    286        MODULE PROCEDURE init_surfaces
    287     END INTERFACE init_surfaces
    288 
    289     INTERFACE init_surface_arrays
    290        MODULE PROCEDURE init_surface_arrays
    291     END INTERFACE init_surface_arrays
    292 
    293     INTERFACE surface_read_restart_data
    294        MODULE PROCEDURE surface_read_restart_data
    295     END INTERFACE surface_read_restart_data
    296 
    297     INTERFACE surface_write_restart_data
    298        MODULE PROCEDURE surface_write_restart_data
    299     END INTERFACE surface_write_restart_data
    300 
    301     INTERFACE surface_last_actions
    302        MODULE PROCEDURE surface_last_actions
    303     END INTERFACE surface_last_actions
     305!-- Public subroutines and functions
     306    PUBLIC get_topography_top_index, init_bc, init_surfaces,                   &
     307           init_surface_arrays, surface_read_restart_data,                     &
     308           surface_write_restart_data, surface_last_actions
    304309
    305310
     
    16421647
    16431648    END SUBROUTINE init_surfaces
     1649
     1650
     1651!------------------------------------------------------------------------------!
     1652! Description:
     1653! ------------
     1654!> Determines topography-top index at given (j,i)-position. 
     1655!------------------------------------------------------------------------------!
     1656    FUNCTION get_topography_top_index( j, i, grid )
     1657
     1658       USE kinds
     1659
     1660       IMPLICIT NONE
     1661
     1662       CHARACTER(LEN=*) ::  grid                      !< flag to distinquish between staggered grids
     1663       INTEGER(iwp)     ::  i                         !< grid index in x-dimension
     1664       INTEGER(iwp)     ::  ibit                      !< bit position where topography information is stored on respective grid
     1665       INTEGER(iwp)     ::  j                         !< grid index in y-dimension
     1666       INTEGER(iwp)     ::  get_topography_top_index  !< topography top index
     1667
     1668       SELECT CASE ( TRIM( grid ) )
     1669
     1670          CASE ( 's'     )
     1671             ibit = 12
     1672          CASE ( 'u'     )
     1673             ibit = 14
     1674          CASE ( 'v'     )
     1675             ibit = 16
     1676          CASE ( 'w'     )
     1677             ibit = 18
     1678          CASE ( 's_out' )
     1679             ibit = 24
     1680          CASE ( 'u_out' )
     1681             ibit = 26
     1682          CASE ( 'v_out' )
     1683             ibit = 27
     1684          CASE ( 'w_out' )
     1685             ibit = 28
     1686          CASE DEFAULT
     1687!
     1688!--          Set default to scalar grid
     1689             ibit = 12
     1690
     1691       END SELECT
     1692
     1693       get_topography_top_index = MAXLOC(                                      &
     1694                                     MERGE( 1, 0,                              &
     1695                                            BTEST( wall_flags_0(:,j,i), ibit ) &
     1696                                          ), DIM = 1                           &
     1697                                        ) - 1
     1698
     1699       RETURN
     1700
     1701    END FUNCTION get_topography_top_index
    16441702
    16451703!------------------------------------------------------------------------------!
Note: See TracChangeset for help on using the changeset viewer.