Changeset 2007


Ignore:
Timestamp:
Aug 24, 2016 3:47:17 PM (8 years ago)
Author:
kanani
Message:

changes in the course of urban surface model implementation

Location:
palm/trunk/SOURCE
Files:
2 added
16 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r1999 r2007  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# urban surface module added,
     23# cleaned up some lines (compiler flags/options), which were accidentally
     24# added in rev1938
    2325#
    2426# Former revisions:
     
    341343        time_integration.f90 time_to_string.f90 timestep.f90 \
    342344        timestep_scheme_steering.f90 transpose.f90 tridia_solver_mod.f90 \
     345        urban_surface_mod.f90 \
    343346        user_3d_data_averaging.f90 \
    344347        user_actions.f90 user_additional_routines.f90 \
     
    350353        user_init_3d_model.f90 user_init_flight.f90 user_init_grid.f90 user_init_land_surface.f90 \
    351354        user_init_plant_canopy.f90 user_init_radiation.f90 user_flight.f90\
     355        user_init_urban_surface.f90 \
    352356        user_last_actions.f90 user_lpm_advec.f90 \
    353357        user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \
     
    367371LDFLAGS =
    368372
    369 #BOUNDS="-Rbc"  # Array bounds checking. Compromises performance seriously.
    370 
    371 F90 = ftn
    372 #COPT = -DMPI_REAL=MPI_DOUBLE_PRECISION -DMPI_2REAL=MPI_2DOUBLE_PRECISION -D__lc -D__parallel -D__fftw \
    373 #             -D__netcdf -D__netcdf4 -D__netcdf4_parallel -D__nopointer
    374 COPT = -DMPI_REAL=MPI_DOUBLE_PRECISION -DMPI_2REAL=MPI_2DOUBLE_PRECISION -D__lc -D__parallel -D__fftw \
    375              -D__netcdf -D__netcdf4 -D__netcdf4_parallel
    376 
    377 #F90FLAGS = -O2 -e Fm -G2 -rm $(BOUNDS) -hnoomp
    378 F90FLAGS = -O2 -e F -G2 -rm $(BOUNDS) -hnoomp
    379 LDFLAGS = $(F90FLAGS) -dynamic
     373# The following line is needed for palm_simple_install, don't remove it!
     374#to_be_replaced_by_include
    380375
    381376.SUFFIXES:
     
    407402advec_w_up.o: modules.o mod_kinds.o
    408403average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    409                    radiation_model_mod.o
     404        radiation_model_mod.o urban_surface_mod.o
    410405boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o
    411406buoyancy.o: modules.o mod_kinds.o
     
    418413check_parameters.o: modules.o mod_kinds.o land_surface_model_mod.o \
    419414        netcdf_interface_mod.o plant_canopy_model_mod.o pmc_interface_mod.o radiation_model_mod.o \
    420         spectra_mod.o subsidence_mod.o microphysics_mod.o wind_turbine_model_mod.o
     415        spectra_mod.o subsidence_mod.o microphysics_mod.o wind_turbine_model_mod.o \
     416        urban_surface_mod.o
    421417close_file.o: modules.o mod_kinds.o netcdf_interface_mod.o
    422418compute_vpt.o: modules.o mod_kinds.o
     
    437433data_output_flight.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o virtual_flight_mod.o
    438434data_output_2d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    439    netcdf_interface_mod.o land_surface_model_mod.o radiation_model_mod.o
     435   netcdf_interface_mod.o land_surface_model_mod.o radiation_model_mod.o \
     436   urban_surface_mod.o
    440437data_output_3d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    441    netcdf_interface_mod.o land_surface_model_mod.o
     438   netcdf_interface_mod.o land_surface_model_mod.o urban_surface_mod.o
    442439diffusion_e.o: modules.o mod_kinds.o microphysics_mod.o \
    443440   mod_particle_attributes.o
     
    466463   radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
    467464   surface_layer_fluxes_mod.o microphysics_mod.o mod_particle_attributes.o \
    468    virtual_flight_mod.o wind_turbine_model_mod.o
     465   urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
    469466init_advec.o: modules.o mod_kinds.o
    470467init_cloud_physics.o: modules.o mod_kinds.o
     
    516513mod_particle_attributes.o: mod_particle_attributes.f90 mod_kinds.o
    517514netcdf_interface_mod.o: netcdf_interface_mod.f90 modules.o mod_kinds.o \
    518    land_surface_model_mod.o radiation_model_mod.o spectra_mod.o
     515   land_surface_model_mod.o radiation_model_mod.o spectra_mod.o urban_surface_mod.o
    519516nudging_mod.o: modules.o cpulog_mod.o mod_kinds.o
    520517package_parin.o: modules.o mod_kinds.o mod_particle_attributes.o
     
    546543        eqn_state_seawater.o mod_kinds.o microphysics_mod.o \
    547544        nudging_mod.o plant_canopy_model_mod.o production_e.o radiation_model_mod.o \
    548         subsidence_mod.o user_actions.o wind_turbine_model_mod.o
     545        subsidence_mod.o urban_surface_mod.o user_actions.o wind_turbine_model_mod.o
    549546progress_bar_mod.o: modules.o mod_kinds.o
    550547radiation_model_mod.o : modules.o mod_particle_attributes.o microphysics_mod.o
     
    556553   spectra_mod.o
    557554read_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o \
    558    spectra_mod.o microphysics_mod.o virtual_flight_mod.o
     555   spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o
    559556run_control.o: modules.o cpulog_mod.o mod_kinds.o
    560557set_slicer_attributes_dvrp.o: modules.o mod_kinds.o
     
    564561subsidence_mod.o: modules.o mod_kinds.o
    565562sum_up_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    566                   radiation_model_mod.o
     563                  radiation_model_mod.o urban_surface_mod.o
    567564surface_coupler.o: modules.o cpulog_mod.o mod_kinds.o
    568 surface_layer_fluxes_mod.o: modules.o mod_kinds.o land_surface_model_mod.o
     565surface_layer_fluxes_mod.o: modules.o mod_kinds.o land_surface_model_mod.o \
     566        urban_surface_mod.o
    569567swap_timelevel.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
    570    pmc_interface_mod.o
     568   pmc_interface_mod.o urban_surface_mod.o
    571569temperton_fft_mod.o: modules.o mod_kinds.o
    572570time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
     
    575573        prognostic_equations.o progress_bar_mod.o radiation_model_mod.o \
    576574        spectra_mod.o user_actions.o surface_layer_fluxes_mod.o microphysics_mod.o \
    577         virtual_flight_mod.o wind_turbine_model_mod.o
     575        urban_surface_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
    578576time_to_string.o: mod_kinds.o
    579577timestep.o: modules.o cpulog_mod.o mod_kinds.o microphysics_mod.o
     
    581579transpose.o: modules.o cpulog_mod.o mod_kinds.o
    582580tridia_solver_mod.o: modules.o mod_kinds.o
     581urban_surface_mod.o: modules.o mod_kinds.o radiation_model_mod.o plant_canopy_model_mod.o
    583582user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o
    584583user_actions.o: modules.o cpulog_mod.o mod_kinds.o user_module.o
     
    603602user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o
    604603user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o
     604user_init_urban_surface.o: modules.o mod_kinds.o user_module.o urban_surface_mod.o
    605605user_last_actions.o: modules.o mod_kinds.o user_module.o
    606606user_lpm_advec.o: modules.o mod_kinds.o user_module.o
     
    619619        spectra_mod.o
    620620write_var_list.o: modules.o mod_kinds.o netcdf_interface_mod.o plant_canopy_model_mod.o\
    621    spectra_mod.o microphysics_mod.o virtual_flight_mod.o
     621   spectra_mod.o microphysics_mod.o urban_surface_mod.o virtual_flight_mod.o
  • palm/trunk/SOURCE/average_3d_data.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added support for new urban surface model (temporary modifications of
     23! SELECT CASE ( ) necessary, see variable trimvar),
     24! added comments in variable declaration section
    2325!
    2426! Former revisions:
     
    107109        ONLY:  radiation, radiation_3d_data_averaging
    108110
     111    USE urban_surface_mod,                                                     &
     112        ONLY:  urban_surface, usm_average_3d_data
     113
    109114
    110115    IMPLICIT NONE
    111116
    112     INTEGER(iwp) ::  i  !<
    113     INTEGER(iwp) ::  ii !<
    114     INTEGER(iwp) ::  j  !<
    115     INTEGER(iwp) ::  k  !<
     117    INTEGER(iwp) ::  i  !< running index
     118    INTEGER(iwp) ::  ii !< running index
     119    INTEGER(iwp) ::  j  !< running index
     120    INTEGER(iwp) ::  k  !< running index
     121
     122    CHARACTER (LEN=20) ::  trimvar  !< TRIM of output-variable string
    116123
    117124
     
    127134
    128135!
     136!--    Temporary solution to account for data output within the new urban
     137!--    surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
     138       trimvar = TRIM( doav(ii) )
     139       IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     140          trimvar = 'usm_output'
     141       ENDIF
     142
     143!
    129144!--    Store the array chosen on the temporary array.
    130        SELECT CASE ( TRIM( doav(ii) ) )
     145       SELECT CASE ( trimvar )
    131146
    132147          CASE ( 'e' )
     
    399414                ENDDO
    400415             ENDDO
     416!             
     417!--       Block of urban surface model outputs   
     418          CASE ( 'usm_output' )
     419             CALL usm_average_3d_data( 'average', doav(ii) )
    401420
    402421          CASE DEFAULT
  • palm/trunk/SOURCE/check_parameters.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added checks for the urban surface model,
     23! increased counter in DO WHILE loop over data_output (for urban surface output)
    2324!
    2425! Former revisions:
     
    423424    USE profil_parameter
    424425    USE radiation_model_mod,                                                   &
    425         ONLY: radiation, radiation_check_data_output,                          &
    426               radiation_check_data_output_pr, radiation_check_parameters
     426        ONLY:  radiation, radiation_check_data_output,                         &
     427               radiation_check_data_output_pr, radiation_check_parameters
    427428    USE spectra_mod,                                                           &
    428429        ONLY:  calculate_spectra, spectra_check_parameters
     
    431432    USE statistics
    432433    USE transpose_indices
     434    USE urban_surface_mod,                                                     &
     435        ONLY:  urban_surface, usm_check_data_output, usm_check_parameters
    433436    USE wind_turbine_model_mod,                                                &
    434         ONLY: wtm_check_parameters, wind_turbine
     437        ONLY:  wtm_check_parameters, wind_turbine
    435438
    436439
     
    11001103!-- When land surface model is used, perform additional checks
    11011104    IF ( land_surface )  CALL lsm_check_parameters
     1105
     1106!
     1107!-- When urban surface model is used, perform additional checks
     1108    IF ( urban_surface )  CALL usm_check_parameters
    11021109
    11031110!
     
    16161623    ENDIF
    16171624
     1625!
     1626!   This IF clause needs revision, got too complex!!
    16181627    IF ( surface_heatflux == 9999999.9_wp  )  THEN
    16191628       constant_heatflux = .FALSE.
    1620        IF ( large_scale_forcing  .OR.  land_surface )  THEN
     1629       IF ( large_scale_forcing  .OR.  land_surface  .OR.  urban_surface )  THEN
    16211630          IF ( ibc_pt_b == 0 )  THEN
    16221631             constant_heatflux = .FALSE.
     
    28342843!-- Check and set steering parameters for 2d/3d data output and averaging
    28352844    i   = 1
    2836     DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 100 )
     2845    DO  WHILE ( data_output(i) /= ' '  .AND.  i <= 500 )
    28372846!
    28382847!--    Check for data averaging
     
    30533062             IF ( unit == 'illegal' )  THEN
    30543063                CALL radiation_check_data_output( var, unit, i, ilen, k )
     3064             ENDIF
     3065
     3066!
     3067!--          Block of urban surface model outputs
     3068             IF ( unit == 'illegal' .AND. urban_surface .AND. var(1:3) == 'us_' ) THEN
     3069                 CALL usm_check_data_output( var, unit )
    30553070             ENDIF
    30563071
     
    37183733    ENDIF
    37193734
    3720     IF ( large_scale_forcing  .AND.  topography /= 'flat' )  THEN
     3735    IF ( large_scale_forcing  .AND.  topography /= 'flat'                      &
     3736                              .AND.  .NOT.  urban_surface )  THEN
    37213737       message_string = 'The usage of large scale forcing from external &'//   &
    37223738                        'file LSF_DATA is not implemented for non-flat topography'
  • palm/trunk/SOURCE/data_output_3d.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added support for new urban surface model (temporary modifications of
     23! SELECT CASE ( ) necessary, see variable trimvar)
    2324!
    2425! Former revisions:
     
    178179        ONLY:  radiation, radiation_data_output_3d
    179180
     181    USE urban_surface_mod,                                                     &
     182        ONLY:  nzub, nzut, urban_surface, usm_data_output_3d
     183
    180184
    181185    IMPLICIT NONE
     
    200204
    201205    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !<
     206
     207    CHARACTER (LEN=20) ::  trimvar  !< TRIM of output-variable string
    202208
    203209!
     
    260266
    261267    DO  WHILE ( do3d(av,if)(1:1) /= ' ' )
    262 !
     268
     269!
     270!--    Temporary solution to account for data output within the new urban
     271!--    surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
    263272!--    Store the array chosen on the temporary array.
    264        resorted = .FALSE.
    265        nzb_do = nzb
    266        nzt_do = nz_do3d
     273       trimvar = TRIM( do3d(av,if) )
     274       IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     275          trimvar = 'usm_output'
     276          resorted = .TRUE.
     277          nzb_do   = nzub
     278          nzt_do   = nzut
     279       ELSE
     280          resorted = .FALSE.
     281          nzb_do   = nzb
     282          nzt_do   = nz_do3d
     283       ENDIF
    267284!
    268285!--    Set flag to steer output of radiation, land-surface, or user-defined
     
    273290       ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
    274291
    275        SELECT CASE ( TRIM( do3d(av,if) ) )
     292       SELECT CASE ( trimvar )
    276293
    277294          CASE ( 'e' )
     
    553570                to_be_resorted => w_av
    554571             ENDIF
     572!             
     573!--       Block of urban surface model outputs   
     574          CASE ( 'usm_output' )
     575             CALL usm_data_output_3d( av, do3d(av,if), found, local_pf,     &
     576                                         nzb_do, nzt_do )
    555577
    556578          CASE DEFAULT
  • palm/trunk/SOURCE/init_3d_model.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added support for urban surface model,
     23! adjusted location_message in case of plant_canopy
    2324!
    2425! Former revisions:
     
    363364        ONLY:  init_surface_layer_fluxes
    364365   
    365     USE transpose_indices
     366    USE transpose_indices
     367
     368    USE urban_surface_mod,                                                     &
     369        ONLY:  urban_surface, usm_init_urban_surface
    366370
    367371    USE wind_turbine_model_mod,                                                &
     
    17661770!
    17671771!-- If required, initialize quantities needed for the plant canopy model
    1768     CALL location_message( 'initializing plant canopy model', .FALSE. )
    1769     IF ( plant_canopy )  CALL pcm_init
    1770     CALL location_message( 'finished', .TRUE. )
     1772    IF ( plant_canopy )  THEN
     1773       CALL location_message( 'initializing plant canopy model', .FALSE. )   
     1774       CALL pcm_init
     1775       CALL location_message( 'finished', .TRUE. )
     1776    ENDIF
    17711777
    17721778!
     
    18191825       CALL location_message( 'finished', .TRUE. )
    18201826    ENDIF
    1821    
     1827
     1828!
     1829!-- If required, initialize urban surface model
     1830    IF ( urban_surface )  THEN
     1831       CALL location_message( 'initializing urban surface model', .FALSE. )
     1832       CALL usm_init_urban_surface
     1833       CALL location_message( 'finished', .TRUE. )
     1834    ENDIF
     1835
    18221836!
    18231837!-- If required, initialize quantities needed for the wind turbine model
  • palm/trunk/SOURCE/modules.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Increased DIMENSION of data_output, data_output_user, do2d, do3d
    2323!
    2424! Former revisions:
     
    631631    CHARACTER (LEN=1000) ::  message_string = ' '
    632632
    633     CHARACTER (LEN=20), DIMENSION(100) ::  data_output = ' ',    &
     633    CHARACTER (LEN=20), DIMENSION(500) ::  data_output = ' ',    &
    634634                                           data_output_user = ' ', doav = ' '
    635635    CHARACTER (LEN=20), DIMENSION(max_masks,100) ::  &
     
    639639    CHARACTER (LEN=20), DIMENSION(200) ::  data_output_pr_user = ' '
    640640    CHARACTER (LEN=20), DIMENSION(max_masks,0:1,100) ::  domask = ' '
    641     CHARACTER (LEN=20), DIMENSION(0:1,100) ::  do2d = ' ', do3d = ' '
     641    CHARACTER (LEN=20), DIMENSION(0:1,500) ::  do2d = ' ', do3d = ' '
    642642
    643643    INTEGER(iwp), PARAMETER :: fl_max = 100, var_fl_max = 20
  • palm/trunk/SOURCE/netcdf_interface_mod.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added support for new urban surface model (temporary modifications of
     23! SELECT CASE ( ) necessary, see variable trimvar),
     24! increased DIMENSION of do2d_unit, do3d_unit, id_var_do2d, id_var_do3d,
     25! increased LEN of char_cross_profiles, var_list, var_list_old
    2326!
    2427! Former revisions:
     
    240243    CHARACTER (LEN=9), DIMENSION(300) ::  dopr_unit = 'unknown'
    241244
    242     CHARACTER (LEN=7), DIMENSION(0:1,100) ::  do2d_unit, do3d_unit
     245    CHARACTER (LEN=7), DIMENSION(0:1,500) ::  do2d_unit, do3d_unit
    243246
    244247    CHARACTER (LEN=16), DIMENSION(25) ::  prt_var_names = &
     
    319322
    320323    INTEGER(iwp), DIMENSION(dopts_num,0:10) ::  id_var_dopts
    321     INTEGER(iwp), DIMENSION(0:1,100)        ::  id_var_do2d, id_var_do3d
     324    INTEGER(iwp), DIMENSION(0:1,500)        ::  id_var_do2d, id_var_do3d
    322325    INTEGER(iwp), DIMENSION(100,0:9)        ::  id_dim_z_pr, id_var_dopr, &
    323326                                                id_var_z_pr
     
    441444        ONLY:  hom, statistic_regions
    442445
     446    USE urban_surface_mod,                                                     &
     447        ONLY:  urban_surface, usm_define_netcdf_grid
     448
    443449
    444450    IMPLICIT NONE
     
    454460    CHARACTER (LEN=10)             ::  precision             !<
    455461    CHARACTER (LEN=10)             ::  var                   !<
     462    CHARACTER (LEN=20)             ::  trimvar               !< TRIM of output-variable string
    456463    CHARACTER (LEN=80)             ::  time_average_text     !<
    457     CHARACTER (LEN=2000)           ::  char_cross_profiles   !<
    458     CHARACTER (LEN=2000)           ::  var_list              !<
    459     CHARACTER (LEN=2000)           ::  var_list_old          !<
     464    CHARACTER (LEN=4000)           ::  char_cross_profiles   !<
     465    CHARACTER (LEN=4000)           ::  var_list              !<
     466    CHARACTER (LEN=4000)           ::  var_list_old          !<
    460467
    461468    CHARACTER (LEN=100), DIMENSION(1:crmax) ::  cross_profiles_adj   !<
     
    506513    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  netcdf_data    !<
    507514    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d !<
     515
    508516
    509517!
     
    746754
    747755          DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )
    748 
     756!
     757!--          Temporary solution to account for data output within the new urban
     758!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
     759             trimvar = TRIM( domask(mid,av,i) )
     760             IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     761                trimvar = 'usm_output'
     762             ENDIF
    749763!
    750764!--          Check for the grid
    751765             found = .FALSE.
    752              SELECT CASE ( domask(mid,av,i) )
     766             SELECT CASE ( trimvar )
    753767!
    754768!--             Most variables are defined on the scalar grid
     
    782796                   grid_z = 'zw'
    783797
     798!             
     799!--       Block of urban surface model outputs   
     800                CASE ( 'usm_output' )
     801
     802                   CALL usm_define_netcdf_grid( domask(mid,av,i), found, &
     803                                                        grid_x, grid_y, grid_z )
    784804
    785805                CASE DEFAULT
     
    806826                                                    grid_x, grid_y, grid_z )
    807827                   ENDIF
    808 
     828                                                 
    809829                   IF ( .NOT. found )  THEN
    810830                      WRITE ( message_string, * ) 'no grid defined for',       &
     
    12561276
    12571277          DO WHILE ( do3d(av,i)(1:1) /= ' ' )
    1258 
     1278!
     1279!--          Temporary solution to account for data output within the new urban
     1280!--          surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
     1281             trimvar = TRIM( do3d(av,i) )
     1282             IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     1283                trimvar = 'usm_output'
     1284             ENDIF
    12591285!
    12601286!--          Check for the grid
    12611287             found = .FALSE.
    1262              SELECT CASE ( do3d(av,i) )
     1288             SELECT CASE ( trimvar )
    12631289!
    12641290!--             Most variables are defined on the scalar grid
     
    12921318                   grid_z = 'zw'
    12931319
     1320!             
     1321!--             Block of urban surface model outputs   
     1322                CASE ( 'usm_output' )
     1323                   CALL usm_define_netcdf_grid( do3d(av,i), found, &
     1324                                                   grid_x, grid_y, grid_z )
    12941325
    12951326                CASE DEFAULT
     
    13151346                                                    grid_y, grid_z )
    13161347                   ENDIF
    1317 
     1348                                                 
    13181349                   IF ( .NOT. found )  THEN
    13191350                      WRITE ( message_string, * ) 'no grid defined for varia', &
  • palm/trunk/SOURCE/palm.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Temporarily added CALL for writing of restart data for urban surface model
    2323!
    2424! Former revisions:
     
    144144!>
    145145!> @todo create routine last_actions instead of calling lsm_last_actions etc.
     146!> @todo eventually move CALL usm_write_restart_data to suitable location
    146147!------------------------------------------------------------------------------!
    147148 PROGRAM palm
     
    201202    USE surface_layer_fluxes_mod,                                              &
    202203        ONLY:  pt1, qv1, uv_total
     204       
     205    USE urban_surface_mod,                                                     &
     206        ONLY:  urban_surface, usm_write_restart_data       
    203207
    204208#if defined( __openacc )
     
    455459!--    If required, write particle data
    456460       IF ( particle_advection )  CALL lpm_write_restart_file
     461!
     462!--    If required, write urban surface data
     463       IF (urban_surface)  CALL usm_write_restart_data
     464       
    457465    ENDIF
    458466
  • palm/trunk/SOURCE/parin.f90

    r2005 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added call to urban surface model for reading of &urban_surface_par
    2323!
    2424! Former revisions:
     
    290290    USE statistics,                                                            &
    291291        ONLY:  hom, hom_sum, pr_palm, region, statistic_regions
     292
     293    USE urban_surface_mod,                                                     &
     294        ONLY: usm_parin
    292295
    293296    USE wind_turbine_model_mod,                                                &
     
    558561
    559562!
     563!--       Check if urban surface model is used and read &urban_surface_par if required
     564          CALL usm_parin
     565
     566!
    560567!--       Check if spectra shall be calculated and read spectra_par if required
    561568          CALL spectra_parin
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added SUBROUTINE pcm_read_plant_canopy_3d for reading 3d plant canopy data
     23! from file (new case canopy_mode=read_from_file_3d) in the course of
     24! introduction of urban surface model,
     25! introduced variable ext_coef,
     26! resorted SUBROUTINEs to alphabetical order
    2327!
    2428! Former revisions:
     
    120124    REAL(wp) ::  cthf = 0.0_wp              !< canopy top heat flux
    121125    REAL(wp) ::  dt_plant_canopy = 0.0_wp   !< timestep account. for canopy drag
     126    REAL(wp) ::  ext_coef = 0.6_wp          !< extinction coefficient
    122127    REAL(wp) ::  lad_surface = 0.0_wp       !< lad surface value
    123128    REAL(wp) ::  lai_beta = 0.0_wp          !< leaf area index (lai) for lad calc.
     
    154159!
    155160!-- Public variables and constants
    156     PUBLIC canopy_mode, cthf, dt_plant_canopy, lad, lad_s, plant_canopy
     161    PUBLIC canopy_heat_flux, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
     162           pch_index, plant_canopy
     163           
    157164
    158165
     
    171178    INTERFACE pcm_parin
    172179       MODULE PROCEDURE pcm_parin
    173     END INTERFACE pcm_parin 
     180    END INTERFACE pcm_parin
     181
     182    INTERFACE pcm_read_plant_canopy_3d
     183       MODULE PROCEDURE pcm_read_plant_canopy_3d
     184    END INTERFACE pcm_read_plant_canopy_3d
    174185   
    175186    INTERFACE pcm_tendency
     
    363374
    364375       USE control_parameters,                                                 &
    365            ONLY: dz, ocean, passive_scalar
     376           ONLY: coupling_char, dz, humidity, io_blocks, io_group,             &
     377                 message_string, ocean, passive_scalar
    366378
    367379
    368380       IMPLICIT NONE
    369381
    370        INTEGER(iwp) ::  i !< running index
    371        INTEGER(iwp) ::  j !< running index
    372        INTEGER(iwp) ::  k !< running index
    373 
    374        REAL(wp) ::  int_bpdf      !< vertical integral for lad-profile construction
    375        REAL(wp) ::  dzh           !< vertical grid spacing in units of canopy height
    376        REAL(wp) ::  gradient      !< gradient for lad-profile construction
    377        REAL(wp) ::  canopy_height !< canopy height for lad-profile construction
    378 
     382       CHARACTER(10) :: pct
     383       
     384       INTEGER(iwp) ::  i   !< running index
     385       INTEGER(iwp) ::  ii  !< index       
     386       INTEGER(iwp) ::  j   !< running index
     387       INTEGER(iwp) ::  k   !< running index
     388
     389       REAL(wp) ::  int_bpdf        !< vertical integral for lad-profile construction
     390       REAL(wp) ::  dzh             !< vertical grid spacing in units of canopy height
     391       REAL(wp) ::  gradient        !< gradient for lad-profile construction
     392       REAL(wp) ::  canopy_height   !< canopy height for lad-profile construction
     393       REAL(wp) ::  pcv(nzb:nzt+1)  !<
     394       
    379395!
    380396!--    Allocate one-dimensional arrays for the computation of the
     
    509525             ENDDO
    510526
     527          CASE ( 'read_from_file_3d' )
     528!
     529!--          Initialize canopy parameters cdc (canopy drag coefficient),
     530!--          lsec (leaf scalar exchange coefficient), lsc (leaf surface concentration)
     531!--          from file which contains complete 3D data (separate vertical profiles for
     532!--          each location).
     533             CALL pcm_read_plant_canopy_3d
     534
    511535          CASE DEFAULT
    512 
    513 !
    514 !--       The DEFAULT case is reached either if the parameter
    515 !--       canopy mode contains a wrong character string or if the
    516 !--       user has coded a special case in the user interface.
    517 !--       There, the subroutine user_init_plant_canopy checks
    518 !--       which of these two conditions applies.
    519           CALL user_init_plant_canopy
     536!
     537!--          The DEFAULT case is reached either if the parameter
     538!--          canopy mode contains a wrong character string or if the
     539!--          user has coded a special case in the user interface.
     540!--          There, the subroutine user_init_plant_canopy checks
     541!--          which of these two conditions applies.
     542             CALL user_init_plant_canopy
    520543 
    521544       END SELECT
     
    561584                DO  k = 0, pch_index
    562585                   canopy_heat_flux(k,j,i) = cthf *                            &
    563                                              exp( -0.6_wp * cum_lai_hf(k,j,i) )
     586                                             exp( -ext_coef * cum_lai_hf(k,j,i) )
    564587                ENDDO
    565588             ENDDO
     
    585608
    586609
     610!------------------------------------------------------------------------------!
     611! Description:
     612! ------------
     613!> Parin for &canopy_par for plant canopy model
     614!------------------------------------------------------------------------------!
     615    SUBROUTINE pcm_parin
     616
     617
     618       IMPLICIT NONE
     619
     620       CHARACTER (LEN=80) ::  line  !< dummy string that contains the current line of the parameter file
     621       
     622       NAMELIST /canopy_par/      alpha_lad, beta_lad, canopy_drag_coeff,      &
     623                                  canopy_mode, cthf,                           &
     624                                  lad_surface,                                 &
     625                                  lad_vertical_gradient,                       &
     626                                  lad_vertical_gradient_level,                 &
     627                                  lai_beta,                                    &
     628                                  leaf_scalar_exch_coeff,                      &
     629                                  leaf_surface_conc, pch_index
     630       
     631       line = ' '
     632       
     633!
     634!--    Try to find radiation model package
     635       REWIND ( 11 )
     636       line = ' '
     637       DO   WHILE ( INDEX( line, '&canopy_par' ) == 0 )
     638          READ ( 11, '(A)', END=10 )  line
     639       ENDDO
     640       BACKSPACE ( 11 )
     641
     642!
     643!--    Read user-defined namelist
     644       READ ( 11, canopy_par )
     645
     646!
     647!--    Set flag that indicates that the radiation model is switched on
     648       plant_canopy = .TRUE.
     649
     650 10    CONTINUE
     651       
     652
     653    END SUBROUTINE pcm_parin
     654
     655
     656
     657!------------------------------------------------------------------------------!
     658! Description:
     659! ------------
     660!
     661!> Loads 3D plant canopy data from file. File format is as follows:
     662!>
     663!> num_levels
     664!> dtype,x,y,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
     665!> dtype,x,y,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
     666!> dtype,x,y,value(nzb),value(nzb+1), ... ,value(nzb+num_levels-1)
     667!> ...
     668!>
     669!> i.e. first line determines number of levels and further lines represent plant
     670!> canopy data, one line per column and variable. In each data line,
     671!> dtype represents variable to be set:
     672!>
     673!> dtype=1: leaf area density (lad_s)
     674!> dtype=2: canopy drag coefficient (cdc)
     675!> dtype=3: leaf scalar exchange coefficient (lsec)
     676!> dtype=4: leaf surface concentration (lsc)
     677!>
     678!> Zeros are added automatically above num_levels until top of domain.  Any
     679!> non-specified (x,y) columns have zero values as default.
     680!------------------------------------------------------------------------------!
     681    SUBROUTINE pcm_read_plant_canopy_3d
     682        USE control_parameters, &
     683            ONLY: passive_scalar, message_string
     684        IMPLICIT NONE
     685
     686        INTEGER(iwp)                            :: i, j, dtype, nzp, nzpltop, nzpl, kk
     687        REAL(wp), DIMENSION(:), ALLOCATABLE     :: col
     688       
     689        lad_s = 0.0_wp
     690!         cdc = 0.0_wp
     691!         if ( passive_scalar )  then
     692!            lsc = 0.0_wp
     693!            lsec = 0.0_wp
     694!         endif
     695
     696        WRITE(9,*) 'Reading PLANT_CANOPY_DATA_3D', nzt
     697        FLUSH(9)
     698        OPEN(152, file='PLANT_CANOPY_DATA_3D', access='SEQUENTIAL', &
     699                action='READ', status='OLD', form='FORMATTED', err=515)
     700        READ(152, *, err=516, end=517) nzp   !< read first line = number of vertical layers
     701        ALLOCATE(col(1:nzp))
     702        nzpltop = MIN(nzt+1, nzb+nzp-1)
     703        nzpl = nzpltop - nzb + 1    !< no. of layers to assign
     704
     705        DO
     706            READ(152, *, err=516, end=517) dtype, i, j, col(:)
     707            IF ( i < nxlg .or. i > nxrg .or. j < nysg .or. j > nyng ) CYCLE
     708            WRITE(9,*) 'Read ', i,j,nzb_s_inner(j,i),col(:)
     709            FLUSH(9)
     710
     711            SELECT CASE (dtype)
     712              CASE( 1 ) !< leaf area density
     713                !-- only lad_s has flat z-coordinate, others have regular
     714                kk = nzb_s_inner(j, i)
     715                lad_s(nzb:nzpltop-kk, j, i) = col(1+kk:nzpl)
     716!               CASE( 2 ) !< canopy drag coefficient
     717!                 cdc(nzb:nzpltop, j, i) = col(1:nzpl)
     718!               CASE( 3 ) !< leaf scalar exchange coefficient
     719!                 lsec(nzb:nzpltop, j, i) = col(1:nzpl)
     720!               CASE( 4 ) !< leaf surface concentration
     721!                 lsc(nzb:nzpltop, j, i) = col(1:nzpl)
     722              CASE DEFAULT
     723                write(message_string, '(a,i2,a)')   &
     724                    'Unknown record type in file PLANT_CANOPY_DATA_3D: "', dtype, '"'
     725                CALL message( 'pcm_read_plant_canopy_3d', 'PA0530', 1, 2, 0, 6, 0 )
     726            END SELECT
     727        ENDDO
     728
     729515     message_string = 'error opening file PLANT_CANOPY_DATA_3D'
     730        CALL message( 'pcm_read_plant_canopy_3d', 'PA0531', 1, 2, 0, 6, 0 )
     731
     732516     message_string = 'error reading file PLANT_CANOPY_DATA_3D'
     733        CALL message( 'pcm_read_plant_canopy_3d', 'PA0532', 1, 2, 0, 6, 0 )
     734
     735517     CLOSE(152)
     736        DEALLOCATE(col)
     737       
     738    END SUBROUTINE pcm_read_plant_canopy_3d
     739   
     740   
    587741
    588742!------------------------------------------------------------------------------!
     
    9131067! Description:
    9141068! ------------
    915 !> Parin for &canopy_par for plant canopy model
    916 !------------------------------------------------------------------------------!
    917     SUBROUTINE pcm_parin
    918 
    919 
    920        IMPLICIT NONE
    921 
    922        CHARACTER (LEN=80) ::  line  !< dummy string that contains the current line of the parameter file
    923        
    924         NAMELIST /canopy_par/     alpha_lad, beta_lad, canopy_drag_coeff,      &
    925                                   canopy_mode, cthf,                           &
    926                                   lad_surface,                                 &
    927                                   lad_vertical_gradient,                       &
    928                                   lad_vertical_gradient_level,                 &
    929                                   lai_beta,                                    &
    930                                   leaf_scalar_exch_coeff,                      &
    931                                   leaf_surface_conc, pch_index
    932        
    933        line = ' '
    934        
    935 !
    936 !--    Try to find radiation model package
    937        REWIND ( 11 )
    938        line = ' '
    939        DO   WHILE ( INDEX( line, '&canopy_par' ) == 0 )
    940           READ ( 11, '(A)', END=10 )  line
    941        ENDDO
    942        BACKSPACE ( 11 )
    943 
    944 !
    945 !--    Read user-defined namelist
    946        READ ( 11, canopy_par )
    947 
    948 !
    949 !--    Set flag that indicates that the radiation model is switched on
    950        plant_canopy = .TRUE.
    951 
    952  10    CONTINUE
    953        
    954 
    955     END SUBROUTINE pcm_parin   
    956    
    957 
    958 
    959 !------------------------------------------------------------------------------!
    960 ! Description:
    961 ! ------------
    9621069!> Calculation of the tendency terms, accounting for the effect of the plant
    9631070!> canopy on momentum and scalar quantities.
     
    12491356    END SUBROUTINE pcm_tendency_ij
    12501357
     1358
     1359
    12511360 END MODULE plant_canopy_model_mod
  • palm/trunk/SOURCE/prognostic_equations.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added pt tendency calculation based on energy balance at urban surfaces
     23! (new urban surface model)
    2324!
    2425! Former revisions:
     
    321322        ONLY:  subsidence
    322323
     324    USE urban_surface_mod,                                                     &
     325        ONLY:  urban_surface, usm_wall_heat_flux
     326
    323327    USE user_actions_mod,                                                      &
    324328        ONLY:  user_actions
     
    614618
    615619!
     620!--          Tendency pt from wall heat flux from urban surface
     621             IF ( urban_surface )  THEN
     622                CALL usm_wall_heat_flux( i, j )
     623             ENDIF
     624
     625!
    616626!--          If required compute heating/cooling due to long wave radiation
    617627!--          processes
     
    13461356
    13471357       CALL diffusion_s( pt, shf, tswst, wall_heatflux )
     1358
     1359!
     1360!--    Tendency pt from wall heat flux from urban surface
     1361       IF ( urban_surface )  THEN
     1362          CALL usm_wall_heat_flux
     1363       ENDIF
    13481364
    13491365!
     
    22722288
    22732289!
     2290!--    Tendency pt from wall heat flux from urban surface
     2291       IF ( urban_surface )  THEN
     2292          CALL usm_wall_heat_flux
     2293       ENDIF
     2294
     2295!
    22742296!--    If required compute heating/cooling due to long wave radiation processes
    22752297       IF ( cloud_top_radiation )  THEN
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added calculation of solar directional vector for new urban surface
     23! model,
     24! accounted for urban_surface model in radiation_check_parameters,
     25! correction of comments for zenith angle.
    2326!
    2427! Former revisions:
     
    114117 
    115118    USE arrays_3d,                                                             &
    116         ONLY:  dzw, hyp, pt, q, ql, zw
     119        ONLY:  dzw, hyp, pt, q, ql, zu, zw
    117120
    118121    USE cloud_parameters,                                                      &
     
    199202                radiation = .FALSE.,                  & !< flag parameter indicating whether the radiation model is used
    200203                sun_up    = .TRUE.,                   & !< flag parameter indicating whether the sun is up or down
    201                 sw_radiation = .TRUE.                   !< flag parameter indicing whether shortwave radiation shall be calculated
     204                sw_radiation = .TRUE.,                 & !< flag parameter indicing whether shortwave radiation shall be calculated
     205                sun_direction = .FALSE.                 !< flag parameter indicing whether solar direction shall be calculated
    202206
    203207
     
    227231                time_utc_init = 43200.0_wp         !< UTC time at model start (noon)
    228232
    229     REAL(wp), DIMENSION(0:0) ::  zenith        !< solar zenith angle
     233    REAL(wp), DIMENSION(0:0) ::  zenith,         & !< cosine of solar zenith angle
     234                                 sun_dir_lat,    & !< solar directional vector in latitudes
     235                                 sun_dir_lon       !< solar directional vector in longitudes
    230236
    231237    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
     
    468474           rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av, rad_sw_in,  &
    469475           rad_sw_in_av, rad_sw_out, rad_sw_out_av, rad_sw_cs_hr,              &
    470            rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av,                           &
    471            skip_time_do_radiation, time_radiation, unscheduled_radiation_calls
     476           rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av, sigma_sb,                 &
     477           skip_time_do_radiation, time_radiation, unscheduled_radiation_calls,&
     478           zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon,       &
     479           day_init, time_utc_init
    472480
    473481
     
    761769   
    762770       IMPLICIT NONE
     771       
     772       LOGICAL ::  urban_surface_af = .FALSE.  !< auxiliary flag used for parameter check
     773
    763774
    764775       IF ( radiation_scheme /= 'constant'   .AND.                             &
     
    805816       ENDIF
    806817
    807        IF ( topography /= 'flat' )  THEN
     818!
     819!--    The following paramter check is temporarily extended by the urban_surface
     820!--    flag, until a better solution comes up to omit this check in case of
     821!--    urban surface model is used.
     822!--    Routine get_usm_info provides the value for the urban_surface flag,
     823!--    because the value cannot be retrieved via USE due to circular dependencies
     824!--    between modules radiation_model_mod and urban_surface_mod.
     825       CALL get_usm_info( urban_surface_af )
     826       IF ( topography /= 'flat'  .AND.  .NOT.  urban_surface_af )  THEN
    808827          message_string = 'radiation scheme cannot be used ' //               &
    809828                           'in combination with  topography /= "flat"'
     
    15651584
    15661585!
    1567 !--    Calculate zenith angle
     1586!--    Calculate cosine of solar zenith angle
    15681587       zenith(0) = SIN(lat) * SIN(declination) + COS(lat) * COS(declination)      &
    15691588                                            * COS(hour_angle)
    15701589       zenith(0) = MAX(0.0_wp,zenith(0))
     1590
     1591!
     1592!--    Calculate solar directional vector
     1593       IF ( sun_direction )  THEN
     1594!--       Direction in longitudes equals to sin(solar_azimuth) * sin(zenith)
     1595          sun_dir_lon(0) = -SIN(hour_angle) * COS(declination)
     1596!--       Direction in latitues equals to cos(solar_azimuth) * sin(zenith)
     1597          sun_dir_lat(0) = SIN(declination) * COS(lat) - COS(hour_angle) &
     1598                              * COS(declination) * SIN(lat)
     1599       ENDIF
    15711600
    15721601!
  • palm/trunk/SOURCE/sum_up_3d_data.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added support for new urban surface model (temporary modifications of
     23! SELECT CASE ( ) necessary, see variable trimvar),
     24! added comments in variable declaration section
    2325!
    2426! Former revisions:
     
    150152        ONLY:  radiation, radiation_3d_data_averaging
    151153
     154    USE urban_surface_mod,                                                     &
     155        ONLY:  urban_surface, usm_average_3d_data
     156
    152157
    153158    IMPLICIT NONE
    154159
    155     INTEGER(iwp) ::  i   !<
    156     INTEGER(iwp) ::  ii  !<
    157     INTEGER(iwp) ::  j   !<
    158     INTEGER(iwp) ::  k   !<
     160    INTEGER(iwp) ::  i   !< running index
     161    INTEGER(iwp) ::  ii  !< running index
     162    INTEGER(iwp) ::  j   !< running index
     163    INTEGER(iwp) ::  k   !< running index
    159164    INTEGER(iwp) ::  n   !<
    160     INTEGER(iwp) ::  psi !<
    161165
    162166    REAL(wp)     ::  mean_r !<
    163167    REAL(wp)     ::  s_r2   !<
    164168    REAL(wp)     ::  s_r3   !<
     169
     170    CHARACTER (LEN=20) ::  trimvar  !< TRIM of output-variable string
     171
    165172
    166173    CALL cpu_log (log_point(34),'sum_up_3d_data','start')
     
    174181
    175182       DO  ii = 1, doav_n
    176 
    177           SELECT CASE ( TRIM( doav(ii) ) )
     183!
     184!--       Temporary solution to account for data output within the new urban
     185!--       surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
     186          trimvar = TRIM( doav(ii) )
     187          IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     188             trimvar = 'usm_output'
     189          ENDIF
     190       
     191          SELECT CASE ( trimvar )
    178192
    179193             CASE ( 'e' )
     
    374388                ENDIF
    375389                z0q_av = 0.0_wp
     390!             
     391!--          Block of urban surface model outputs
     392             CASE ( 'usm_output' )
     393
     394                CALL usm_average_3d_data( 'allocate', doav(ii) )
     395             
    376396
    377397             CASE DEFAULT
     
    402422!-- Loop of all variables to be averaged.
    403423    DO  ii = 1, doav_n
    404 
     424!
     425!--       Temporary solution to account for data output within the new urban
     426!--       surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar )
     427          trimvar = TRIM( doav(ii) )
     428          IF ( urban_surface  .AND.  trimvar(1:3) == 'us_' )  THEN
     429             trimvar = 'usm_output'
     430          ENDIF
    405431!
    406432!--    Store the array chosen on the temporary array.
    407        SELECT CASE ( TRIM( doav(ii) ) )
     433       SELECT CASE ( trimvar )
    408434
    409435          CASE ( 'e' )
     
    724750                ENDDO
    725751             ENDDO
     752!             
     753!--       Block of urban surface model outputs
     754          CASE ( 'usm_output' )
     755             CALL usm_average_3d_data( 'sum', doav(ii) )
    726756
    727757          CASE DEFAULT
  • palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Account for urban surface model in computation of vertical kinematic heatflux
    2323!
    2424! Former revisions:
     
    183183    USE land_surface_model_mod,                                                &
    184184        ONLY:  land_surface, skip_time_do_lsm
     185       
     186    USE urban_surface_mod,                                                     &
     187        ONLY:  urban_surface
     188       
    185189
    186190    IMPLICIT NONE
     
    10571061!
    10581062!--    Compute the vertical kinematic heat flux
    1059        IF (  .NOT.  constant_heatflux .AND.  ( simulated_time <=               &
    1060             skip_time_do_lsm  .OR.  .NOT.  land_surface ) )  THEN
     1063       IF (  .NOT.  constant_heatflux  .AND.  ( simulated_time <=            &
     1064            skip_time_do_lsm  .OR.  .NOT.  land_surface )  .AND.             &
     1065            .NOT.  urban_surface )  THEN
    10611066          !$OMP PARALLEL DO
    10621067          !$acc kernels loop independent present( shf, ts, us )
  • palm/trunk/SOURCE/swap_timelevel.f90

    r2001 r2007  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added swapping of urban surface model quantities,
     23! removed redundance for land surface model
    2324!
    2425! Former revisions:
     
    116117    USE pmc_interface,                                                         &
    117118        ONLY: nested_run, pmci_set_swaplevel
     119
     120    USE urban_surface_mod,                                                     &
     121        ONLY:  urban_surface, usm_swap_timelevel
    118122
    119123
     
    182186    ENDIF
    183187
     188    IF ( urban_surface )  THEN
     189       CALL usm_swap_timelevel ( 0 )
     190    ENDIF
     191
    184192
    185193    CALL cpu_log( log_point(28), 'swap_timelevel (nop)', 'stop' )
     
    214222          ENDIF
    215223
    216           IF ( land_surface )  THEN
    217              CALL lsm_swap_timelevel ( MOD( timestep_count, 2) )
    218           ENDIF
    219 
    220224          swap_level = 1
    221225
     
    245249          ENDIF
    246250
    247           IF ( land_surface )  THEN
    248              CALL lsm_swap_timelevel ( MOD( timestep_count, 2) )
    249           ENDIF
    250 
    251251          swap_level = 2
    252252
    253253    END SELECT
     254
     255    IF ( land_surface )  THEN
     256       CALL lsm_swap_timelevel ( MOD( timestep_count, 2) )
     257    ENDIF
     258
     259    IF ( urban_surface )  THEN
     260       CALL usm_swap_timelevel ( MOD( timestep_count, 2) )
     261    ENDIF
    254262
    255263!
  • palm/trunk/SOURCE/time_integration.f90

    r2001 r2007  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added CALLs for new urban surface model
    2323!
    2424! Former revisions:
     
    342342        ONLY:  surface_layer_fluxes
    343343
     344    USE urban_surface_mod,                                                     &
     345        ONLY:  urban_surface, usm_material_heat_model, usm_material_model,     &
     346               usm_radiation, usm_surface_energy_balance             
     347
    344348    USE user_actions_mod,                                                      &
    345349        ONLY:  user_actions
     
    873877                CALL cpu_log( log_point(54), 'land_surface', 'stop' )
    874878             ENDIF
     879
     880!
     881!--          If required, solve the energy balance for urban surfaces and run
     882!--          the material heat model
     883             IF (urban_surface) THEN
     884                CALL cpu_log( log_point(74), 'urban_surface', 'start' )
     885                CALL usm_surface_energy_balance
     886                IF ( usm_material_model )  THEN
     887                   CALL usm_material_heat_model
     888                ENDIF
     889                CALL cpu_log( log_point(74), 'urban_surface', 'stop' )
     890             ENDIF
     891
    875892!
    876893!--          Compute the diffusion coefficients
     
    909926
    910927                CALL cpu_log( log_point(50), 'radiation', 'stop' )
     928
     929                IF (urban_surface)  THEN
     930                   CALL cpu_log( log_point(75), 'usm_radiation', 'start' )
     931                   CALL usm_radiation
     932                   CALL cpu_log( log_point(75), 'usm_radiation', 'stop' )
     933                ENDIF
     934
    911935             ENDIF
    912936          ENDIF
Note: See TracChangeset for help on using the changeset viewer.