Changeset 2209


Ignore:
Timestamp:
Apr 19, 2017 9:34:46 AM (4 years ago)
Author:
kanani
Message:

small bugfix, formatting and new PCM output

Location:
palm/trunk/SOURCE
Files:
5 edited

Legend:

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

    r2201 r2209  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Check for plant canopy model output
    2323!
    2424! Former revisions:
     
    476476    USE pegrid
    477477    USE plant_canopy_model_mod,                                                &
    478         ONLY:  pcm_check_parameters, plant_canopy
     478        ONLY:  pcm_check_data_output, pcm_check_parameters, plant_canopy
    479479       
    480480    USE pmc_interface,                                                         &
     
    32133213             ENDIF
    32143214
     3215!
     3216!--          Block of plant canopy model outputs
     3217             IF ( unit == 'illegal' .AND. plant_canopy .AND. var(1:4) == 'pcm_' ) THEN
     3218                 CALL pcm_check_data_output( var, unit )
     3219             ENDIF
     3220             
    32153221             IF ( unit == 'illegal' )  THEN
    32163222                unit = ''
  • palm/trunk/SOURCE/data_output_3d.f90

    r2101 r2209  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added plant canopy model output
    2323!
    2424! Former revisions:
     
    188188    USE pegrid
    189189
     190    USE plant_canopy_model_mod,                                                &
     191        ONLY:  pcm_data_output_3d, plant_canopy
     192       
    190193    USE radiation_model_mod,                                                   &
    191194        ONLY:  radiation, radiation_data_output_3d
     
    620623             IF ( .NOT. found  .AND.  radiation )  THEN
    621624                CALL radiation_data_output_3d( av, do3d(av,if), found,         &
     625                                               local_pf )
     626                resorted = .TRUE.
     627             ENDIF
     628
     629!
     630!--          Plant canopy model output
     631             IF ( .NOT. found  .AND.  plant_canopy )  THEN
     632                CALL pcm_data_output_3d( av, do3d(av,if), found,         &
    622633                                               local_pf )
    623634                resorted = .TRUE.
  • palm/trunk/SOURCE/netcdf_interface_mod.f90

    r2201 r2209  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! Added support for plant canopy model output
    2323!
    2424! Former revisions:
     
    461461        ONLY:  maximum_number_of_particles, number_of_particle_groups
    462462
     463    USE plant_canopy_model_mod,                                                &
     464        ONLY:  pcm_define_netcdf_grid, plant_canopy
     465
    463466    USE profil_parameter,                                                      &
    464467        ONLY:  crmax, cross_profiles, dopr_index, profile_columns, profile_rows
     
    839842                                                   grid_x, grid_y, grid_z )
    840843                   ENDIF
     844                   
     845!
     846!--                Check for plant canopy quantities
     847                   IF ( plant_canopy )  THEN
     848                      CALL pcm_define_netcdf_grid( domask(mid,av,i), found,    &
     849                                                   grid_x, grid_y, grid_z )
     850                   ENDIF
    841851
    842852!
     
    13611371                   ENDIF
    13621372
     1373!
     1374!--                Check for plant canopy quantities
     1375                   IF ( plant_canopy )  THEN
     1376                      CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
     1377                                                   grid_y, grid_z )
     1378                   ENDIF
     1379                   
    13631380!
    13641381!--                Check for radiation quantities
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r2101 r2209  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Added 3d output of leaf area density (pcm_lad) and canopy
     23! heat rate (pcm_heatrate)
    2324!
    2425! Former revisions:
     
    166167!
    167168!-- Public functions
    168     PUBLIC pcm_check_parameters, pcm_header, pcm_init, pcm_parin, pcm_tendency
     169    PUBLIC pcm_check_data_output, pcm_check_parameters, pcm_data_output_3d,    &
     170           pcm_define_netcdf_grid, pcm_header, pcm_init, pcm_parin, pcm_tendency
    169171
    170172!
     
    174176           
    175177
    176 
     178    INTERFACE pcm_check_data_output
     179       MODULE PROCEDURE pcm_check_data_output
     180    END INTERFACE pcm_check_data_output
     181   
    177182    INTERFACE pcm_check_parameters
    178183       MODULE PROCEDURE pcm_check_parameters
    179     END INTERFACE pcm_check_parameters     
     184    END INTERFACE pcm_check_parameters
     185
     186    INTERFACE pcm_data_output_3d
     187       MODULE PROCEDURE pcm_data_output_3d
     188    END INTERFACE pcm_data_output_3d
     189
     190    INTERFACE pcm_define_netcdf_grid
     191       MODULE PROCEDURE pcm_define_netcdf_grid
     192    END INTERFACE pcm_define_netcdf_grid
    180193   
    181194     INTERFACE pcm_header
     
    203216 CONTAINS
    204217
     218
     219!------------------------------------------------------------------------------!
     220! Description:
     221! ------------
     222!> Check data output for plant canopy model
     223!------------------------------------------------------------------------------!
     224 SUBROUTINE pcm_check_data_output( var, unit )
     225 
     226 
     227    USE control_parameters,                                                 &
     228        ONLY:  data_output, message_string
     229
     230    IMPLICIT NONE
     231
     232    CHARACTER (LEN=*) ::  unit  !<
     233    CHARACTER (LEN=*) ::  var   !<
     234
     235
     236    SELECT CASE ( TRIM( var ) )
     237
     238       CASE ( 'pcm_heatrate' )
     239          unit = 'K s-1'
     240   
     241       CASE ( 'pcm_lad' )
     242          unit = 'm2 m-3'
     243
     244
     245       CASE DEFAULT
     246          unit = 'illegal'
     247
     248    END SELECT
     249
     250
     251 END SUBROUTINE pcm_check_data_output
     252 
    205253 
    206254!------------------------------------------------------------------------------!
     
    259307 
    260308
     309!------------------------------------------------------------------------------!
     310!
     311! Description:
     312! ------------
     313!> Subroutine defining 3D output variables
     314!------------------------------------------------------------------------------!
     315 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf )
     316 
     317    USE control_parameters,                                                    &
     318        ONLY :  nz_do3d
     319 
     320    USE indices
     321
     322    USE kinds
     323
     324
     325    IMPLICIT NONE
     326
     327    CHARACTER (LEN=*) ::  variable !<
     328
     329    INTEGER(iwp) ::  av    !<
     330    INTEGER(iwp) ::  i     !<
     331    INTEGER(iwp) ::  j     !<
     332    INTEGER(iwp) ::  k     !<
     333
     334    LOGICAL      ::  found !<
     335
     336    REAL(sp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) ::  local_pf !<
     337
     338
     339    found = .TRUE.
     340
     341
     342    SELECT CASE ( TRIM( variable ) )
     343
     344      CASE ( 'pcm_heatrate' )
     345         IF ( av == 0 )  THEN
     346            DO  i = nxlg, nxrg
     347               DO  j = nysg, nyng
     348                  DO  k = nzb_s_inner(j,i), nz_do3d
     349                     local_pf(i,j,k) = pc_heating_rate(k,j,i)
     350                  ENDDO
     351               ENDDO
     352            ENDDO
     353         ENDIF
     354   
     355   
     356      CASE ( 'pcm_lad' )
     357
     358         IF ( av == 0 )  THEN
     359            DO  i = nxlg, nxrg
     360               DO  j = nysg, nyng
     361                  DO  k = nzb_s_inner(j,i), nz_do3d
     362                     local_pf(i,j,k) = lad_s(k,j,i)
     363                  ENDDO
     364               ENDDO
     365            ENDDO
     366         ENDIF
     367                 
     368         
     369       CASE DEFAULT
     370          found = .FALSE.
     371
     372    END SELECT
     373
     374
     375 END SUBROUTINE pcm_data_output_3d
     376         
     377!------------------------------------------------------------------------------!
     378!
     379! Description:
     380! ------------
     381!> Subroutine defining appropriate grid for netcdf variables.
     382!> It is called from subroutine netcdf.
     383!------------------------------------------------------------------------------!
     384 SUBROUTINE pcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
     385   
     386     IMPLICIT NONE
     387
     388     CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
     389     LOGICAL, INTENT(OUT)           ::  found       !<
     390     CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
     391     CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
     392     CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
     393
     394     found  = .TRUE.
     395
     396!
     397!--  Check for the grid
     398     SELECT CASE ( TRIM( var ) )
     399
     400        CASE ( 'pcm_heatrate', 'pcm_lad' )
     401           grid_x = 'x'
     402           grid_y = 'y'
     403           grid_z = 'zu'
     404
     405        CASE DEFAULT
     406           found  = .FALSE.
     407           grid_x = 'none'
     408           grid_y = 'none'
     409           grid_z = 'none'
     410     END SELECT
     411
     412 END SUBROUTINE pcm_define_netcdf_grid
     413 
     414 
    261415!------------------------------------------------------------------------------!
    262416! Description:
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r2114 r2209  
    2121! Current revisions:
    2222! ------------------
    23 !
     23! cpp switch __mpi3 removed,
     24! minor formatting,
     25! small bugfix for division by zero (Krc)
    2426!
    2527! Former revisions:
     
    14891491        CALL location_message( '    calculation of SVF and CSF', .TRUE. )
    14901492
    1491 #if defined( __mpi3 )
     1493
    14921494!--     precalculate face areas for different face directions using normal vector
    14931495        DO d = 0, 9
     
    19641966        CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 )
    19651967       
    1966 #endif
     1968
    19671969    END SUBROUTINE usm_calc_svf
    19681970
     
    24872489!------------------------------------------------------------------------------!
    24882490    PURE SUBROUTINE usm_find_boundary_face(origin, uvect, bdycross)
    2489         IMPLICIT NONE
    2490         REAL(wp), DIMENSION(3), INTENT(in)      :: origin    !< ray origin
    2491         REAL(wp), DIMENSION(3), INTENT(in)      :: uvect     !< ray unit vector
    2492         INTEGER(iwp), DIMENSION(4), INTENT(out) :: bdycross  !< found boundary crossing (d, z, y, x)
    2493         REAL(wp), DIMENSION(3)                  :: crossdist !< crossing distance
    2494         INTEGER(iwp), DIMENSION(3)              :: bdyd      !< boundary direction
    2495         REAL(wp)                                :: bdydim    !<
    2496         REAL(wp)                                :: dist      !<
    2497         INTEGER(iwp)                            :: seldim    !< found fist crossing index
    2498         INTEGER(iwp)                            :: d         !<
    2499 
    2500         bdydim = nzut + .5_wp !< top boundary
    2501         bdyd(1) = isky
    2502         crossdist(1) = (bdydim - origin(1)) / uvect(1)
    2503 
    2504         IF ( uvect(2) >= 0._wp )  THEN
    2505             bdydim = ny + .5_wp !< north global boundary
    2506             bdyd(2) = inorthb
    2507         ELSE
    2508             bdydim = -.5_wp !< south global boundary
    2509             bdyd(2) = isouthb
    2510         ENDIF
    2511         crossdist(2) = (bdydim - origin(2)) / uvect(2)
    2512 
    2513         IF ( uvect(3) >= 0._wp )  THEN
    2514             bdydim = nx + .5_wp !< east global boundary
    2515             bdyd(3) = ieastb
    2516         ELSE
    2517             bdydim = -.5_wp !< west global boundary
    2518             bdyd(3) = iwestb
    2519         ENDIF
    2520         crossdist(3) = (bdydim - origin(3)) / uvect(3)
    2521 
    2522         seldim = minloc(crossdist, 1)
    2523         dist = crossdist(seldim)
    2524         d = bdyd(seldim)
    2525 
    2526         bdycross(1) = d
    2527         bdycross(2:4) = NINT( origin(:) + uvect(:)*dist &
    2528                         + .5_wp * (/ kdir(d), jdir(d), idir(d) /) )
     2491   
     2492       IMPLICIT NONE
     2493       
     2494       INTEGER(iwp) ::  d       !<
     2495       INTEGER(iwp) ::  seldim  !< found fist crossing index
     2496
     2497       INTEGER(iwp), DIMENSION(3)              ::  bdyd      !< boundary direction       
     2498       INTEGER(iwp), DIMENSION(4), INTENT(out) ::  bdycross  !< found boundary crossing (d, z, y, x)
     2499       
     2500       REAL(wp)                                ::  bdydim  !<
     2501       REAL(wp)                                ::  dist    !<
     2502       
     2503       REAL(wp), DIMENSION(3)             ::  crossdist  !< crossing distance
     2504       REAL(wp), DIMENSION(3), INTENT(in) ::  origin     !< ray origin
     2505       REAL(wp), DIMENSION(3), INTENT(in) ::  uvect      !< ray unit vector
     2506 
     2507
     2508       bdydim       = nzut + .5_wp  !< top boundary
     2509       bdyd(1)      = isky
     2510       crossdist(1) = ( bdydim - origin(1) ) / uvect(1)  !< subroutine called only when uvect(1)>0
     2511
     2512       IF ( uvect(2) == 0._wp )  THEN
     2513          crossdist(2) = huge(1._wp)
     2514       ELSE
     2515          IF ( uvect(2) >= 0._wp )  THEN
     2516             bdydim  = ny + .5_wp  !< north global boundary
     2517             bdyd(2) = inorthb
     2518          ELSE
     2519             bdydim  = -.5_wp  !< south global boundary
     2520             bdyd(2) = isouthb
     2521          ENDIF
     2522          crossdist(2) = ( bdydim - origin(2) ) / uvect(2)
     2523       ENDIF
     2524
     2525       IF ( uvect(3) == 0._wp )  THEN
     2526          crossdist(3) = huge(1._wp)
     2527       ELSE
     2528          IF ( uvect(3) >= 0._wp )  THEN
     2529             bdydim  = nx + .5_wp  !< east global boundary
     2530             bdyd(3) = ieastb
     2531          ELSE
     2532             bdydim  = -.5_wp  !< west global boundary
     2533             bdyd(3) = iwestb
     2534          ENDIF
     2535          crossdist(3) = ( bdydim - origin(3) ) / uvect(3)
     2536       ENDIF
     2537
     2538       seldim = minloc(crossdist, 1)
     2539       dist   = crossdist(seldim)
     2540       d      = bdyd(seldim)
     2541
     2542       bdycross(1)   = d
     2543       bdycross(2:4) = NINT( origin(:) + uvect(:) * dist &
     2544                                       + .5_wp * (/ kdir(d), jdir(d), idir(d) /) )
     2545                       
    25292546    END SUBROUTINE
    25302547
     
    28642881       urban_surface = .TRUE.
    28652882       
    2866 !
    2867 !--    Check whether pre-processor (cpp) option "__mpi3" is set. It is required
    2868 !--    for the full functionality of the USM. "__mpi3" directive is implemented,
    2869 !--    because some compilers cannot handle MPI-3 operations, hence, these parts
    2870 !--    of code shall only be compiled if explicitly enabled.
    2871 #if ! defined ( __mpi3 )
    2872           message_string = 'urban surface model requires compilation of ' //   &
    2873                            'PALM with pre-processor directive -D__mpi3'
    2874           CALL message( 'usm_parin', 'PA0503', 1, 2, 0, 6, 0 )
    2875 #endif
    2876 
    28772883
    28782884 10    CONTINUE
     
    32203226        REAL(wp), PARAMETER                    :: grow_factor = 1.5_wp !< factor of expansion of grow arrays
    32213227
    3222 #if defined( __mpi3 )
     3228
    32233229!--     Maximum number of gridboxes visited equals to maximum number of boundaries crossed in each dimension plus one. That's also
    32243230!--     the maximum number of plant canopy boxes written. We grow the acsf array accordingly using exponential factor.
     
    33633369       
    33643370        visible = .TRUE.
    3365        
    3366 #else
    3367         visible      = .FALSE.                          !Set variables to avoid compiler warnimngs
    3368         transparency = 0.0
    3369 #endif
     3371
     3372       
    33703373    END SUBROUTINE usm_raytrace
    33713374   
     
    39363939        REAL(wp)                              :: acoef              !< actual coefficient of diurnal profile of anthropogenic heat
    39373940
    3938 #if defined( __mpi3 )
     3941
    39393942        dxdir = (/dz,dy,dy,dx,dx/)
    39403943       
     
    41474150       ENDIF
    41484151
    4149 #endif
     4152
    41504153    END SUBROUTINE usm_surface_energy_balance
    41514154
Note: See TracChangeset for help on using the changeset viewer.