Changeset 3767 for palm


Ignore:
Timestamp:
Feb 27, 2019 8:18:02 AM (5 years ago)
Author:
raasch
Message:

unused variables removed from rrd-subroutines parameter list

Location:
palm/trunk/SOURCE
Files:
12 edited

Legend:

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

    r3724 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable for file index removed from rrd-subroutines parameter list
     28!
     29! 3724 2019-02-06 16:28:23Z kanani
    2730! Correct double-used log_point_s unit
    2831!
     
    17101713!> This routine reads the respective restart data for the bulk cloud module.
    17111714!------------------------------------------------------------------------------!
    1712     SUBROUTINE bcm_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,       &
     1715    SUBROUTINE bcm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,          &
    17131716                              nxr_on_file, nynf, nync, nyn_on_file, nysf,      &
    17141717                              nysc, nys_on_file, tmp_2d, tmp_3d, found )
     
    17241727       IMPLICIT NONE
    17251728
    1726        INTEGER(iwp) ::  i               !<
    17271729       INTEGER(iwp) ::  k               !<
    17281730       INTEGER(iwp) ::  nxlc            !<
  • palm/trunk/SOURCE/chemistry_model_mod.f90

    r3738 r3767  
    2727! -----------------
    2828! $Id$
     29! unused variable for file index removed from rrd-subroutines parameter list
     30!
     31! 3738 2019-02-12 17:00:45Z suehring
    2932! Clean-up debug prints
    3033!
     
    25832586 !------------------------------------------------------------------------------!
    25842587
    2585  SUBROUTINE chem_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,         &
    2586       nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,  &
    2587       nys_on_file, tmp_3d, found )   
     2588 SUBROUTINE chem_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,             &
     2589                            nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,   &
     2590                            nys_on_file, tmp_3d, found )
    25882591
    25892592    USE control_parameters
     
    25972600    CHARACTER (LEN=20) :: spc_name_av !<   
    25982601
    2599     INTEGER(iwp) ::  i, lsp          !<
     2602    INTEGER(iwp) ::  lsp             !<
    26002603    INTEGER(iwp) ::  k               !<
    26012604    INTEGER(iwp) ::  nxlc            !<
  • palm/trunk/SOURCE/gust_mod.f90

    r3725 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable for file index removed from rrd-subroutines parameter list
     28!
     29! 3725 2019-02-07 10:11:02Z raasch
    2730! dummy statement modified to avoid compiler warnings about unused variables
    2831!
     
    549552!> This routine reads the respective restart data for the gust module.
    550553!------------------------------------------------------------------------------!
    551     SUBROUTINE gust_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,      &
     554    SUBROUTINE gust_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,         &
    552555                               nxr_on_file, nynf, nync, nyn_on_file, nysf,     &
    553556                               nysc, nys_on_file, tmp_2d, tmp_3d, found )
     
    565568       IMPLICIT NONE
    566569
    567        INTEGER(iwp) ::  i               !<
    568570       INTEGER(iwp) ::  k               !<
    569571       INTEGER(iwp) ::  nxlc            !<
     
    590592!--    You may remove them.
    591593       IF ( dummy_logical )  THEN
    592           idum = i + k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                                       &
     594          idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                       &
    593595                 tmp_2d(nys_on_file,nxl_on_file) + tmp_3d(nzb,nys_on_file,nxl_on_file)
    594596       ENDIF
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r3715 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable for file index removed from rrd-subroutines parameter list
     28!
     29! 3715 2019-02-04 17:34:55Z suehring
    2730! Revise check for saturation moisture
    2831!
     
    65446547!> Soubroutine reads lsm data from restart file(s)
    65456548!------------------------------------------------------------------------------!
    6546 SUBROUTINE lsm_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,           &
     6549SUBROUTINE lsm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,              &
    65476550                          nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,    &
    65486551                          nys_on_file, tmp_2d, found )
  • palm/trunk/SOURCE/module_interface.f90

    r3766 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable file_index removed from subroutine parameter list
     28!
     29! 3766 2019-02-26 16:23:41Z raasch
    2730! first argument removed from module_interface_rrd_*, statement added to avoid
    2831! compiler warning about unused variable, file reformatted with respect to coding
     
    11571160!> Read module-specific restart data specific to local MPI ranks
    11581161!------------------------------------------------------------------------------!
    1159  SUBROUTINE module_interface_rrd_local( file_index, map_index,                 &
     1162 SUBROUTINE module_interface_rrd_local( map_index,                             &
    11601163                                        nxlf, nxlc, nxl_on_file,               &
    11611164                                        nxrf, nxrc, nxr_on_file,               &
     
    11651168
    11661169
    1167     INTEGER(iwp),      INTENT(IN)  ::  file_index   !<
    11681170    INTEGER(iwp),      INTENT(IN)  ::  map_index    !<
    11691171    INTEGER(iwp),      INTENT(IN)  ::  nxlc         !<
     
    11901192
    11911193    IF ( .NOT. found ) CALL bcm_rrd_local(                                     &
    1192                                file_index, map_index,                          &
     1194                               map_index,                                      &
    11931195                               nxlf, nxlc, nxl_on_file,                        &
    11941196                               nxrf, nxrc, nxr_on_file,                        &
     
    11991201
    12001202    IF ( .NOT. found ) CALL chem_rrd_local(                                    &
    1201                                file_index, map_index,                          &
     1203                               map_index,                                      &
    12021204                               nxlf, nxlc, nxl_on_file,                        &
    12031205                               nxrf, nxrc, nxr_on_file,                        &
     
    12081210
    12091211    IF ( .NOT. found ) CALL gust_rrd_local(                                    &
    1210                                file_index, map_index,                          &
     1212                               map_index,                                      &
    12111213                               nxlf, nxlc, nxl_on_file,                        &
    12121214                               nxrf, nxrc, nxr_on_file,                        &
     
    12171219
    12181220    IF ( .NOT. found ) CALL lsm_rrd_local(                                     &
    1219                                file_index, map_index,                          &
     1221                               map_index,                                      &
    12201222                               nxlf, nxlc, nxl_on_file,                        &
    12211223                               nxrf, nxrc, nxr_on_file,                        &
     
    12261228
    12271229    IF ( .NOT. found ) CALL ocean_rrd_local(                                   &
    1228                                file_index, map_index,                          &
     1230                               map_index,                                      &
     1231                               nxlf, nxlc, nxl_on_file,                        &
     1232                               nxrf, nxrc, nxr_on_file,                        &
     1233                               nynf, nync, nyn_on_file,                        &
     1234                               nysf, nysc, nys_on_file,                        &
     1235                               tmp_3d, found                                   &
     1236                            ) ! ToDo: change interface to pass variable
     1237
     1238    IF ( .NOT. found ) CALL radiation_rrd_local(                               &
     1239                               map_index,                                      &
    12291240                               nxlf, nxlc, nxl_on_file,                        &
    12301241                               nxrf, nxrc, nxr_on_file,                        &
     
    12341245                            ) ! ToDo: change interface to pass variable
    12351246
    1236     IF ( .NOT. found ) CALL radiation_rrd_local(                               &
    1237                                file_index, map_index,                          &
    1238                                nxlf, nxlc, nxl_on_file,                        &
    1239                                nxrf, nxrc, nxr_on_file,                        &
    1240                                nynf, nync, nyn_on_file,                        &
    1241                                nysf, nysc, nys_on_file,                        &
    1242                                tmp_2d, tmp_3d, found                           &
    1243                             ) ! ToDo: change interface to pass variable
    1244 
    12451247    IF ( .NOT. found ) CALL salsa_rrd_local(                                   &
    1246                                file_index, map_index,                          &
     1248                               map_index,                                      &
    12471249                               nxlf, nxlc, nxl_on_file,                        &
    12481250                               nxrf, nxrc, nxr_on_file,                        &
     
    12531255
    12541256    IF ( .NOT. found ) CALL usm_rrd_local(                                     &
    1255                                file_index, map_index,                          &
     1257                               map_index,                                      &
    12561258                               nxlf, nxlc, nxl_on_file,                        &
    1257                                nxrf, nxrc, nxr_on_file,                        &
    1258                                nynf, nync, nyn_on_file,                        &
     1259                               nxrf, nxr_on_file,                              &
     1260                               nynf, nyn_on_file,                              &
    12591261                               nysf, nysc, nys_on_file,                        &
    12601262                               found                                           &
     
    12651267                           
    12661268    IF ( .NOT. found ) CALL user_rrd_local(                                    &
    1267                                file_index, map_index,                          &
     1269                               map_index,                                      &
    12681270                               nxlf, nxlc, nxl_on_file,                        &
    12691271                               nxrf, nxrc, nxr_on_file,                        &
  • palm/trunk/SOURCE/ocean_mod.f90

    r3719 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable for file index and tmp_2d removed from rrd-subroutine parameter
     28! list
     29!
     30! 3719 2019-02-06 13:10:18Z kanani
    2731! Changed log_point to log_point_s, otherwise this overlaps with
    2832! 'all progn.equations' cpu measurement.
     
    18641868!> This routine reads the respective restart data for the ocean module.
    18651869!------------------------------------------------------------------------------!
    1866  SUBROUTINE ocean_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,        &
     1870 SUBROUTINE ocean_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,           &
    18671871                             nxr_on_file, nynf, nync, nyn_on_file, nysf,       &
    1868                              nysc, nys_on_file, tmp_2d, tmp_3d, found )
     1872                             nysc, nys_on_file, tmp_3d, found )
    18691873
    18701874    USE averaging,                                                             &
     
    18821886    IMPLICIT NONE
    18831887
    1884     INTEGER(iwp) ::  i               !<
    18851888    INTEGER(iwp) ::  k               !<
    18861889    INTEGER(iwp) ::  nxlc            !<
     
    18991902    LOGICAL, INTENT(OUT)  ::  found
    19001903
    1901     REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
    19021904    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
    19031905
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3760 r3767  
    2828! -----------------
    2929! $Id$
     30! unused variable for file index removed from rrd-subroutines parameter list
     31!
     32! 3760 2019-02-21 18:47:35Z moh.hefny
    3033! Bugfix: initialized simulated_time before calculating solar position
    3134! to enable restart option with reading in SVF from file(s).
     
    1111711120!> Subroutine reads local (subdomain) restart data
    1111811121!------------------------------------------------------------------------------!
    11119  SUBROUTINE radiation_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,    &
     11122 SUBROUTINE radiation_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,       &
    1112011123                                nxr_on_file, nynf, nync, nyn_on_file, nysf,    &
    1112111124                                nysc, nys_on_file, tmp_2d, tmp_3d, found )
     
    1113311136    IMPLICIT NONE
    1113411137
    11135     INTEGER(iwp) ::  i               !<
    1113611138    INTEGER(iwp) ::  k               !<
    1113711139    INTEGER(iwp) ::  nxlc            !<
  • palm/trunk/SOURCE/read_restart_data_mod.f90

    r3766 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variables removed from rrd-subroutines parameter list
     28!
     29! 3766 2019-02-26 16:23:41Z raasch
    2730! first argument removed from module_interface_rrd_*
    2831!
     
    17911794!
    17921795!--                Read restart data of surfaces
    1793                    IF ( .NOT. found ) CALL surface_rrd_local( i, k, nxlf,      &
    1794                                            nxlc, nxl_on_file, nxrf, nxrc,      &
    1795                                            nxr_on_file, nynf, nync,            &
     1796                   IF ( .NOT. found ) CALL surface_rrd_local( k, nxlf,         &
     1797                                           nxlc, nxl_on_file, nxrf,            &
     1798                                           nxr_on_file, nynf,                  &
    17961799                                           nyn_on_file, nysf, nysc,            &
    17971800                                           nys_on_file, found )
     
    18001803!--                Read restart data of other modules
    18011804                   IF ( .NOT. found ) CALL module_interface_rrd_local(         &
    1802                                            i, k,                               &
     1805                                           k,                                  &
    18031806                                           nxlf, nxlc, nxl_on_file,            &
    18041807                                           nxrf, nxrc, nxr_on_file,            &
  • palm/trunk/SOURCE/salsa_mod.f90

    r3685 r3767  
    2626! -----------------
    2727! $Id$
     28! unused variable for file index removed from rrd-subroutines parameter list
     29!
     30! 3685 2019-01-21 01:02:11Z knoop
    2831! Some interface calls moved to module_interface + cleanup
    2932!
     
    20322035!> This routine reads the respective restart data.
    20332036!------------------------------------------------------------------------------!
    2034  SUBROUTINE salsa_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,        &
     2037 SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,           &
    20352038                             nxr_on_file, nynf, nync, nyn_on_file, nysf,       &
    20362039                             nysc, nys_on_file, tmp_3d, found )
     
    20432046    INTEGER(iwp) ::  c  !<
    20442047    INTEGER(iwp) ::  g  !<
    2045     INTEGER(iwp) ::  i  !<
    20462048    INTEGER(iwp) ::  k  !<
    20472049    INTEGER(iwp) ::  nxlc            !<
  • palm/trunk/SOURCE/surface_mod.f90

    r3761 r3767  
    2626! -----------------
    2727! $Id$
     28! unused variables removed from rrd-subroutine parameter list
     29!
     30! 3761 2019-02-25 15:31:42Z raasch
    2831! OpenACC directives added to avoid compiler warnings about unused variables,
    2932! unused variable removed
     
    38203823!> of cyclic_fill mode.
    38213824!------------------------------------------------------------------------------!
    3822     SUBROUTINE surface_rrd_local( ii, kk, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
    3823                                   nxr_on_file, nynf, nync, nyn_on_file, nysf,  &
     3825    SUBROUTINE surface_rrd_local( kk, nxlf, nxlc, nxl_on_file, nxrf,           &
     3826                                  nxr_on_file, nynf, nyn_on_file, nysf,        &
    38243827                                  nysc, nys_on_file, found )
    38253828
     
    38333836       INTEGER(iwp)       ::  m           !< running index for surface elements, refers to gathered array encompassing all surface types
    38343837       INTEGER(iwp)       ::  mm          !< running index for surface elements, refers to individual surface types
    3835        INTEGER(iwp)       ::  ii          !< running index over input files
    38363838       INTEGER(iwp)       ::  kk          !< running index over previous input files covering current local domain
    38373839       INTEGER(iwp)       ::  nxlc        !< index of left boundary on current subdomain
    38383840       INTEGER(iwp)       ::  nxlf        !< index of left boundary on former subdomain
    38393841       INTEGER(iwp)       ::  nxl_on_file !< index of left boundary on former local domain
    3840        INTEGER(iwp)       ::  nxrc        !< index of right boundary on current subdomain
    38413842       INTEGER(iwp)       ::  nxrf        !< index of right boundary on former subdomain
    38423843       INTEGER(iwp)       ::  nxr_on_file !< index of right boundary on former local domain 
    3843        INTEGER(iwp)       ::  nync        !< index of north boundary on current subdomain
    38443844       INTEGER(iwp)       ::  nynf        !< index of north boundary on former subdomain
    38453845       INTEGER(iwp)       ::  nyn_on_file !< index of norht boundary on former local domain 
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3748 r3767  
    2828! -----------------
    2929! $Id$
     30! unused variables removed from rrd-subroutines parameter list
     31!
     32! 3748 2019-02-18 10:38:31Z suehring
    3033! Revise conversion of waste-heat flux (do not divide by air density, will
    3134! be done in diffusion_s)
     
    62436246!> Soubroutine reads t_surf and t_wall data from restart files
    62446247!------------------------------------------------------------------------------!
    6245     SUBROUTINE usm_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,       &
    6246                               nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,&
    6247                               nys_on_file, found )
     6248    SUBROUTINE usm_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, nyn_on_file,    &
     6249                              nysf, nysc, nys_on_file, found )
    62486250
    62496251
     
    62536255       IMPLICIT NONE
    62546256
     6257       INTEGER(iwp)       ::  k                 !< running index over previous input files covering current local domain
    62556258       INTEGER(iwp)       ::  l                 !< index variable for surface type
    6256        INTEGER(iwp)       ::  i                 !< running index over input files
    6257        INTEGER(iwp)       ::  k                 !< running index over previous input files covering current local domain
    62586259       INTEGER(iwp)       ::  ns_h_on_file_usm  !< number of horizontal surface elements (urban type) on file
    62596260       INTEGER(iwp)       ::  nxlc              !< index of left boundary on current subdomain
    62606261       INTEGER(iwp)       ::  nxlf              !< index of left boundary on former subdomain
    62616262       INTEGER(iwp)       ::  nxl_on_file       !< index of left boundary on former local domain
    6262        INTEGER(iwp)       ::  nxrc              !< index of right boundary on current subdomain
    62636263       INTEGER(iwp)       ::  nxrf              !< index of right boundary on former subdomain
    62646264       INTEGER(iwp)       ::  nxr_on_file       !< index of right boundary on former local domain
    6265        INTEGER(iwp)       ::  nync              !< index of north boundary on current subdomain
    62666265       INTEGER(iwp)       ::  nynf              !< index of north boundary on former subdomain
    62676266       INTEGER(iwp)       ::  nyn_on_file       !< index of north boundary on former local domain
  • palm/trunk/SOURCE/user_module.f90

    r3747 r3767  
    2525! -----------------
    2626! $Id$
     27! unused variable for file index removed from rrd-subroutines parameter list
     28!
     29! 3747 2019-02-16 15:15:23Z gronemeier
    2730! Add routine user_init_arrays
    2831!
     
    11311134!> calculated in routine rrd_local.
    11321135!------------------------------------------------------------------------------!
    1133     SUBROUTINE user_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,      &
     1136    SUBROUTINE user_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,         &
    11341137                               nxr_on_file, nynf, nync, nyn_on_file, nysf,     &
    11351138                               nysc, nys_on_file, tmp_3d, found )
    11361139
    11371140
    1138        INTEGER(iwp) ::  i               !<
    11391141       INTEGER(iwp) ::  k               !<
    11401142       INTEGER(iwp) ::  nxlc            !<
Note: See TracChangeset for help on using the changeset viewer.