Changeset 3241 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Sep 12, 2018 3:02:00 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3233 r3241 28 28 ! ----------------- 29 29 ! $Id$ 30 ! unused variables removed or commented 31 ! 32 ! 3233 2018-09-07 13:21:24Z schwenkel 30 33 ! Adapted for the use of cloud_droplets 31 34 ! … … 883 886 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw !< array of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection 884 887 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw !< array of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection 885 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf !< array of total radiation flux incoming to minus outgoing from local surface886 888 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfemitlwl !< array of emitted lw radiation for local surface used to calculate effective surface temperature for radiation model 887 889 … … 1217 1219 CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit 1218 1220 1219 INTEGER(iwp) :: user_pr_index !<1220 1221 INTEGER(iwp) :: var_count !< 1221 1222 … … 1375 1376 1376 1377 USE control_parameters, & 1377 ONLY: land_surface, message_string, topography,urban_surface1378 ONLY: land_surface, message_string, urban_surface 1378 1379 1379 1380 USE netcdf_data_input_mod, & … … 1469 1470 1470 1471 INTEGER(iwp) :: i !< running index x-direction 1471 INTEGER(iwp) :: ind_type !< running index for subgrid-surface tiles1472 1472 INTEGER(iwp) :: ioff !< offset in x between surface element reference grid point in atmosphere and actual surface 1473 1473 INTEGER(iwp) :: j !< running index y-direction 1474 1474 INTEGER(iwp) :: joff !< offset in y between surface element reference grid point in atmosphere and actual surface 1475 1475 INTEGER(iwp) :: l !< running index for orientation of vertical surfaces 1476 INTEGER(iwp) :: m !< running index for surface elements 1476 INTEGER(iwp) :: m !< running index for surface elements 1477 #if defined( __rrtmg ) 1478 INTEGER(iwp) :: ind_type !< running index for subgrid-surface tiles 1479 #endif 1477 1480 1478 1481 ! … … 2732 2735 11 FORMAT (/' --> Shortwave radiation is disabled.') 2733 2736 12 FORMAT (' Timestep: dt_radiation = ', F6.2, ' s') 2734 13 FORMAT (/' Albedo is set individually for each xy-location, according ' 2737 13 FORMAT (/' Albedo is set individually for each xy-location, according ', & 2735 2738 'to given surface type.') 2736 2739 … … 2838 2841 SUBROUTINE radiation_rrtmg 2839 2842 2843 #if defined ( __rrtmg ) 2840 2844 USE indices, & 2841 2845 ONLY: nbgp … … 2847 2851 IMPLICIT NONE 2848 2852 2849 #if defined ( __rrtmg )2850 2853 2851 2854 INTEGER(iwp) :: i, j, k, l, m, n !< loop indices … … 4461 4464 4462 4465 IMPLICIT NONE 4463 4464 INTEGER(iwp) :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll 4465 INTEGER(iwp) :: nzubl, nzutl, isurf, isurfsrc, isvf, icsf, ipcgb 4466 INTEGER(iwp) :: i, j, k, kk, d, refstep, m, mm, l, ll 4467 INTEGER(iwp) :: isurf, isurfsrc, isvf, icsf, ipcgb 4466 4468 INTEGER(iwp) :: isd !< solar direction number 4467 4469 INTEGER(iwp) :: pc_box_dimshift !< transform for best accuracy … … 4477 4479 REAL(wp), PARAMETER :: alpha = 0._wp !< grid rotation (TODO: add to namelist or remove) 4478 4480 REAL(wp) :: pc_box_area, pc_abs_frac, pc_abs_eff 4479 REAL(wp) :: count_surfaces !< number of all surfaces in model domain4480 REAL(wp) :: count_surfaces_l !< number of all surfaces in sub-domain4481 REAL(wp) :: pt_surf_urb !< mean surface temperature of all surfaces in model domain, temporal work-around4482 REAL(wp) :: pt_surf_urb_l !< mean surface temperature of all surfaces in sub-domain, temporal work-around4481 ! REAL(wp) :: count_surfaces !< number of all surfaces in model domain 4482 ! REAL(wp) :: count_surfaces_l !< number of all surfaces in sub-domain 4483 ! REAL(wp) :: pt_surf_urb !< mean surface temperature of all surfaces in model domain, temporal work-around 4484 ! REAL(wp) :: pt_surf_urb_l !< mean surface temperature of all surfaces in sub-domain, temporal work-around 4483 4485 4484 4486 REAL(wp), DIMENSION(0:nsurf_type) :: facearea … … 4497 4499 REAL(wp) :: area_surfl !< total area of surfaces in local processor 4498 4500 REAL(wp) :: area_surf !< total area of surfaces in all processor 4499 REAL(wp) :: area_horl !< total horizontal area of domain in local processor4500 4501 REAL(wp) :: area_hor !< total horizontal area of domain in all processor 4501 4502 … … 4716 4717 surfoutlw = surfoutll 4717 4718 surfemitlwl = surfoutll 4718 ! surfhf = surfinsw + surfinlw - surfoutsw - surfoutlw4719 4719 4720 4720 IF ( .NOT. surface_reflections ) THEN … … 4772 4772 surfoutsw = surfoutsw + surfoutsl 4773 4773 surfoutlw = surfoutlw + surfoutll 4774 ! surfhf = surfinsw + surfinlw - surfoutsw - surfoutlw4775 4774 4776 4775 ENDDO … … 5215 5214 5216 5215 USE plant_canopy_model_mod, & 5217 ONLY: pch_index, pc_heating_rate,lad_s5216 ONLY: pch_index, lad_s 5218 5217 5219 5218 IMPLICIT NONE 5220 5219 5221 INTEGER(iwp) :: i, j, k, d, l, ir, jr, ids, m5220 INTEGER(iwp) :: i, j, k, l, m 5222 5221 INTEGER(iwp) :: k_topo !< vertical index indicating topography top for given (j,i) 5223 INTEGER(iwp) :: k_topo2 !< vertical index indicating topography top for given (j,i)5224 5222 INTEGER(iwp) :: nzptl, nzubl, nzutl, isurf, ipcgb 5225 INTEGER(iwp) :: procid5226 5223 REAL(wp) :: mrl 5227 5224 … … 5555 5552 IMPLICIT NONE 5556 5553 5557 INTEGER(iwp) :: i, j, k, l,d, ip, jp5554 INTEGER(iwp) :: i, j, k, d, ip, jp 5558 5555 INTEGER(iwp) :: isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrtt, imrtf, ipcgb 5559 INTEGER(iwp) :: sd, td , ioln, iproc5556 INTEGER(iwp) :: sd, td 5560 5557 INTEGER(iwp) :: iaz, izn !< azimuth, zenith counters 5561 5558 INTEGER(iwp) :: naz, nzn !< azimuth, zenith num of steps … … 5581 5578 REAL(wp) :: transparency, rirrf, sqdist, svfsum 5582 5579 INTEGER(iwp) :: isurflt, isurfs, isurflt_prev 5583 INTEGER(iwp) :: itx, ity, itz5584 5580 INTEGER(idp) :: ray_skip_maxdist, ray_skip_minval !< skipped raytracing counts 5585 5581 INTEGER(iwp) :: max_track_len !< maximum 2d track length 5586 CHARACTER(len=7) :: pid_char = ''5587 5582 INTEGER(iwp) :: win_lad, minfo 5588 5583 REAL(wp), DIMENSION(:,:,:), POINTER :: lad_s_rma !< fortran pointer, but lower bounds are 1 … … 5593 5588 ! 5594 5589 INTEGER(iwp), DIMENSION(0:svfnorm_report_num) :: svfnorm_counts 5595 CHARACTER(200) :: msg5590 ! CHARACTER(200) :: msg 5596 5591 5597 5592 !-- calculation of the SVF … … 6260 6255 RETURN 6261 6256 6262 301WRITE( message_string, * ) &6263 'I/O error when processing shape view factors / ', &6264 'plant canopy sink factors / direct irradiance factors.'6265 CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 )6257 ! WRITE( message_string, * ) & 6258 ! 'I/O error when processing shape view factors / ', & 6259 ! 'plant canopy sink factors / direct irradiance factors.' 6260 ! CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 ) 6266 6261 6267 6262 END SUBROUTINE radiation_calc_svf … … 6295 6290 REAL(wp), INTENT(out) :: transparency !< along whole path 6296 6291 INTEGER(iwp), INTENT(in) :: win_lad 6297 INTEGER(iwp) :: i, j,k, d6292 INTEGER(iwp) :: i, k, d 6298 6293 INTEGER(iwp) :: seldim !< dimension to be incremented 6299 6294 INTEGER(iwp) :: ncsb !< no of written plant canopy sinkboxes … … 7269 7264 INTEGER(iwp) :: iread, iwrite 7270 7265 TYPE(t_csf), DIMENSION(:), POINTER :: acsfnew 7271 CHARACTER(100) :: msg7266 ! CHARACTER(100) :: msg 7272 7267 7273 7268 IF ( newsize == -1 ) THEN … … 9370 9365 !> Subroutine writes debug information 9371 9366 !------------------------------------------------------------------------------! 9372 SUBROUTINE radiation_write_debug_log ( message )9367 ! SUBROUTINE radiation_write_debug_log ( message ) 9373 9368 !> it writes debug log with time stamp 9374 CHARACTER(*) :: message9375 CHARACTER(15) :: dtc9376 CHARACTER(8) :: date9377 CHARACTER(10) :: time9378 CHARACTER(5) :: zone9379 CALL date_and_time(date, time, zone)9380 dtc = date(7:8)//','//time(1:2)//':'//time(3:4)//':'//time(5:10)9381 WRITE(9,'(2A)') dtc, TRIM(message)9382 FLUSH(9)9383 END SUBROUTINE radiation_write_debug_log9369 ! CHARACTER(*) :: message 9370 ! CHARACTER(15) :: dtc 9371 ! CHARACTER(8) :: date 9372 ! CHARACTER(10) :: time 9373 ! CHARACTER(5) :: zone 9374 ! CALL date_and_time(date, time, zone) 9375 ! dtc = date(7:8)//','//time(1:2)//':'//time(3:4)//':'//time(5:10) 9376 ! WRITE(9,'(2A)') dtc, TRIM(message) 9377 ! FLUSH(9) 9378 ! END SUBROUTINE radiation_write_debug_log 9384 9379 9385 9380 END MODULE radiation_model_mod
Note: See TracChangeset
for help on using the changeset viewer.
