Changeset 3769 for palm


Ignore:
Timestamp:
Feb 28, 2019 10:16:49 AM (5 years ago)
Author:
moh.hefny
Message:

removed unused variables from urban_surface_mod radiation_model_mod and part of module_interface

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r3767 r3769  
    2424! Former revisions:
    2525! -----------------
    26 ! $Id$
     26! $ID: MODULE_INTERFACE.F90 3767 2019-02-27 08:18:02Z Mohamed $
     27! removed unused variables in module_interface_check_data_output_ts
     28! 3767 08:18:02Z raasch
    2729! unused variable file_index removed from subroutine parameter list
    2830!
     
    553555
    554556    IF ( radiation )  THEN
    555        CALL radiation_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
     557       CALL radiation_check_data_output_ts( dots_max, dots_num )
    556558    ENDIF
    557559
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3767 r3769  
    2323! Current revisions:
    2424! ------------------
    25 ! 
     25!
    2626!
    2727! Former revisions:
    2828! -----------------
    2929! $Id$
     30! removed unused variables and subroutine radiation_radflux_gridbox
     31!
     32! 3767 2019-02-27 08:18:02Z raasch
    3033! unused variable for file index removed from rrd-subroutines parameter list
    3134!
     
    12411244    END INTERFACE radiation_presimulate_solar_pos
    12421245
    1243     INTERFACE radiation_radflux_gridbox
    1244        MODULE PROCEDURE radiation_radflux_gridbox
    1245     END INTERFACE radiation_radflux_gridbox
    1246 
    12471246    INTERFACE radiation_calc_svf
    12481247       MODULE PROCEDURE radiation_calc_svf
     
    12721271           radiation_define_netcdf_grid, radiation_wrd_local,                  &
    12731272           radiation_rrd_local, radiation_data_output_mask,                    &
    1274            radiation_radflux_gridbox, radiation_calc_svf, radiation_write_svf, &
     1273           radiation_calc_svf, radiation_write_svf,                            &
    12751274           radiation_interaction, radiation_interaction_init,                  &
    12761275           radiation_read_svf, radiation_presimulate_solar_pos
     
    13521351       CHARACTER (LEN=*) ::  variable      !<
    13531352
    1354        INTEGER(iwp) :: i, j, k, l
     1353       INTEGER(iwp) :: i, k
    13551354       INTEGER(iwp) :: ilen
    13561355       CHARACTER(LEN=varnamelength) :: var          !< TRIM(variable)
     
    14811480!> Set module-specific timeseries units and labels
    14821481!------------------------------------------------------------------------------!
    1483  SUBROUTINE radiation_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
     1482 SUBROUTINE radiation_check_data_output_ts( dots_max, dots_num )
    14841483
    14851484
    14861485   INTEGER(iwp),      INTENT(IN)     ::  dots_max
    14871486   INTEGER(iwp),      INTENT(INOUT)  ::  dots_num
    1488    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_label
    1489    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_unit
    14901487
    14911488!
     
    49604957     IMPLICIT NONE
    49614958
    4962      INTEGER(iwp)                      :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll
     4959     INTEGER(iwp)                      :: i, j, k, kk, d, refstep, m, mm, l, ll
    49634960     INTEGER(iwp)                      :: isurf, isurfsrc, isvf, icsf, ipcgb
    49644961     INTEGER(iwp)                      :: imrt, imrtf
     
    87888785    END FUNCTION searchsorted
    87898786
    8790 !------------------------------------------------------------------------------!
    8791 ! Description:
    8792 ! ------------
    8793 !
    8794 !> radiation_radflux_gridbox subroutine gives the sw and lw radiation fluxes at the
    8795 !> faces of a gridbox defined at i,j,k and located in the urban layer.
    8796 !> The total sw and the diffuse sw radiation as well as the lw radiation fluxes at
    8797 !> the gridbox 6 faces are stored in sw_gridbox, swd_gridbox, and lw_gridbox arrays,
    8798 !> respectively, in the following order:
    8799 !>  up_face, down_face, north_face, south_face, east_face, west_face
    8800 !>
    8801 !> The subroutine reports also how successful was the search process via the parameter
    8802 !> i_feedback as follow:
    8803 !> - i_feedback =  1 : successful
    8804 !> - i_feedback = -1 : unsuccessful; the requisted point is outside the urban domain
    8805 !> - i_feedback =  0 : uncomplete; some gridbox faces fluxes are missing
    8806 !>
    8807 !>
    8808 !> It is called outside from usm_urban_surface_mod whenever the radiation fluxes
    8809 !> are needed.
    8810 !>
    8811 !> This routine is not used so far. However, it may serve as an interface for radiation
    8812 !> fluxes of urban and land surfaces
    8813 !>
    8814 !> TODO:
    8815 !>    - Compare performance when using some combination of the Fortran intrinsic
    8816 !>      functions, e.g. MINLOC, MAXLOC, ALL, ANY and COUNT functions, which search
    8817 !>      surfl array for elements meeting user-specified criterion, i.e. i,j,k
    8818 !>    - Report non-found or incomplete radiation fluxes arrays , if any, at the
    8819 !>      gridbox faces in an error message form
    8820 !>
    8821 !------------------------------------------------------------------------------!
    8822     SUBROUTINE radiation_radflux_gridbox(i,j,k,sw_gridbox,swd_gridbox,lw_gridbox,i_feedback)
    8823        
    8824         IMPLICIT NONE
    8825 
    8826         INTEGER(iwp),                 INTENT(in)  :: i,j,k                 !< gridbox indices at which fluxes are required
    8827         INTEGER(iwp)                              :: ii,jj,kk,d            !< surface indices and type
    8828         INTEGER(iwp)                              :: l                     !< surface id
    8829         REAL(wp)    , DIMENSION(1:6), INTENT(out) :: sw_gridbox,lw_gridbox !< total sw and lw radiation fluxes of 6 faces of a gridbox, w/m2
    8830         REAL(wp)    , DIMENSION(1:6), INTENT(out) :: swd_gridbox           !< diffuse sw radiation from sky and model boundary of 6 faces of a gridbox, w/m2
    8831         INTEGER(iwp),                 INTENT(out) :: i_feedback            !< feedback to report how the search was successful
    8832 
    8833 
    8834 !-- initialize variables
    8835         i_feedback  = -999999
    8836         sw_gridbox  = -999999.9_wp
    8837         lw_gridbox  = -999999.9_wp
    8838         swd_gridbox = -999999.9_wp
    8839        
    8840 !-- check the requisted grid indices
    8841         IF ( k < nzb   .OR.  k > nzut  .OR.   &
    8842              j < nysg  .OR.  j > nyng  .OR.   &
    8843              i < nxlg  .OR.  i > nxrg         &
    8844              ) THEN
    8845            i_feedback = -1
    8846            RETURN
    8847         ENDIF
    8848 
    8849 !-- search for the required grid and formulate the fluxes at the 6 gridbox faces
    8850         DO l = 1, nsurfl
    8851             ii = surfl(ix,l)
    8852             jj = surfl(iy,l)
    8853             kk = surfl(iz,l)
    8854 
    8855             IF ( ii == i  .AND.  jj == j  .AND.  kk == k ) THEN
    8856                d = surfl(id,l)
    8857 
    8858                SELECT CASE ( d )
    8859 
    8860                CASE (iup_u,iup_l)                          !- gridbox up_facing face
    8861                   sw_gridbox(1) = surfinsw(l)
    8862                   lw_gridbox(1) = surfinlw(l)
    8863                   swd_gridbox(1) = surfinswdif(l)
    8864 
    8865                CASE (inorth_u,inorth_l)                    !- gridbox north_facing face
    8866                   sw_gridbox(3) = surfinsw(l)
    8867                   lw_gridbox(3) = surfinlw(l)
    8868                   swd_gridbox(3) = surfinswdif(l)
    8869 
    8870                CASE (isouth_u,isouth_l)                    !- gridbox south_facing face
    8871                   sw_gridbox(4) = surfinsw(l)
    8872                   lw_gridbox(4) = surfinlw(l)
    8873                   swd_gridbox(4) = surfinswdif(l)
    8874 
    8875                CASE (ieast_u,ieast_l)                      !- gridbox east_facing face
    8876                   sw_gridbox(5) = surfinsw(l)
    8877                   lw_gridbox(5) = surfinlw(l)
    8878                   swd_gridbox(5) = surfinswdif(l)
    8879 
    8880                CASE (iwest_u,iwest_l)                      !- gridbox west_facing face
    8881                   sw_gridbox(6) = surfinsw(l)
    8882                   lw_gridbox(6) = surfinlw(l)
    8883                   swd_gridbox(6) = surfinswdif(l)
    8884 
    8885                END SELECT
    8886 
    8887             ENDIF
    8888 
    8889         IF ( ALL( sw_gridbox(:)  /= -999999.9_wp )  ) EXIT
    8890         ENDDO
    8891 
    8892 !-- check the completeness of the fluxes at all gidbox faces       
    8893 !-- TODO: report non-found or incomplete rad fluxes arrays in an error message form
    8894         IF ( ANY( sw_gridbox(:)  <= -999999.9_wp )  .OR.   &
    8895              ANY( swd_gridbox(:) <= -999999.9_wp )  .OR.   &
    8896              ANY( lw_gridbox(:)  <= -999999.9_wp ) ) THEN
    8897            i_feedback = 0
    8898         ELSE
    8899            i_feedback = 1
    8900         ENDIF
    8901        
    8902         RETURN
    8903        
    8904     END SUBROUTINE radiation_radflux_gridbox
    89058787
    89068788!------------------------------------------------------------------------------!
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3767 r3769  
    2828! -----------------
    2929! $Id$
     30! removed unused variables
     31!
     32! 3767 2019-02-27 08:18:02Z raasch
    3033! unused variables removed from rrd-subroutines parameter list
    3134!
     
    529532                field_capacity = 9999999.9_wp,          &  !< NAMELIST fc
    530533                hydraulic_conductivity = 9999999.9_wp,  &  !< NAMELIST gamma_w_green_sat
    531                 lambda_h_green_sat = 0.0_wp,            &  !< heat conductivity for saturated soil
    532534                l_vangenuchten = 9999999.9_wp,          &  !< NAMELIST l_vg
    533535                n_vangenuchten = 9999999.9_wp,          &  !< NAMELIST n_vg
     
    28422844        REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)     ::  temp_pf    !< temp array for urban surface output procedure
    28432845       
    2844         CHARACTER (len=varnamelength)                          :: var     !< trimmed variable name
    2845         INTEGER(iwp), PARAMETER                                :: nd = 5  !< number of directions
    2846         CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER         :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
    2847         INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
    2848         INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: diridx =  (/       -1,        1,        0,        3,        2 /)
    2849                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
    2850         INTEGER(iwp)                                           :: ids,idsint,idsidx,isvf
    2851         INTEGER(iwp)                                           :: i,j,k,iwl,istat, l, m  !< running indices
     2846        CHARACTER (len=varnamelength)                      :: var     !< trimmed variable name
     2847        INTEGER(iwp), PARAMETER                            :: nd = 5  !< number of directions
     2848        CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER     :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
     2849        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: dirint =  (/    iup_u, isouth_u, inorth_u,  iwest_u,  ieast_u /)
     2850        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER         :: diridx =  (/       -1,        1,        0,        3,        2 /)
     2851                                                                      !< index for surf_*_v: 0:3 = (North, South, East, West)
     2852        INTEGER(iwp)                   :: ids,idsint,idsidx
     2853        INTEGER(iwp)                   :: i,j,k,iwl,istat, l, m  !< running indices
    28522854
    28532855        found = .TRUE.
     
    40264028        INTEGER(iwp) ::  st                  !< dummy 
    40274029
    4028         REAL(wp)     ::  c, d, tin, twin
     4030        REAL(wp)     ::  c, tin, twin
    40294031        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
    40304032        REAL(wp)     ::  z_agl                        !< height above ground
Note: See TracChangeset for help on using the changeset viewer.