Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 3785


Ignore:
Timestamp:
Mar 6, 2019 10:41:14 AM (6 years ago)
Author:
eckhard
Message:

inifor: Removed unused variables, improved coding style

Location:
palm/trunk/UTIL/inifor
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/UTIL/inifor/Makefile

    r3716 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3716 2019-02-05 17:02:38Z eckhard
    2731# Added __netcdf preprocessor flag
    2832#

  • palm/trunk/UTIL/inifor/Makefile.gnu

    r3716 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3716 2019-02-05 17:02:38Z eckhard
    2731# Added __netcdf preprocessor flag
    2832#

  • palm/trunk/UTIL/inifor/Makefile.ifort

    r3716 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3716 2019-02-05 17:02:38Z eckhard
    2731# Added __netcdf preprocessor flag
    2832#

  • palm/trunk/UTIL/inifor/src/inifor.f90

    r3779 r3785  
    130130
    131131    LOGICAL, SAVE ::  ug_vg_have_been_computed = .FALSE. !< flag for managing geostrophic wind allocation and computation
    132     LOGICAL, SAVE ::  debugging_output = .TRUE.          !< flag controllging output of internal variables
     132    !LOGICAL, SAVE ::  debugging_output = .TRUE.          !< flag controllging output of internal variables
    133133   
    134134!> \mainpage About INIFOR
    … …  
    163163!
    164164!-- Add the output variables to the netCDF output file
    165     CALL setup_netcdf_variables(output_file % name, output_var_table,          &
    166                                 cfg % debug)
     165    CALL setup_netcdf_variables(output_file % name, output_var_table)
    167166
    168167    CALL setup_io_groups()
    … …  
    193192                   "' could not be preprocessed sucessfully."
    194193                CALL inifor_abort('main loop', message)
    195              END IF
     194             ENDIF
    196195
    197196!------------------------------------------------------------------------------
    … …  
    276275                               output_arr(0,0,:), rho_centre,                  &
    277276                               output_var % averaging_grid)
    278                          END IF
    279 
    280                       END IF
     277                         ENDIF
     278
     279                      ENDIF
    281280 CALL run_control('time', 'comp')
    282281
    … …  
    349348                            input_buffer(output_var % input_id) % array(:,:,:),&
    350349                            internal_arr(:),                                   &
    351                             cosmo_grid, output_var % averaging_grid            &
     350                            output_var % averaging_grid                        &
    352351                         )
    353352
    … …  
    363362                      !   ALLOCATE( output_arr(1,1,1:output_var % grid % nz) )
    364363                      !   output_arr(1,1,:) = internal_arr(:)
    365                       !END IF
     364                      !ENDIF
    366365 CALL run_control('time', 'comp')
    367366
    … …  
    395394                            CALL interpolate_1d( vg_cosmo, vg_palm,             &
    396395                                                 output_var % grid )
    397                          END IF
     396                         ENDIF
    398397
    399398                         ug_vg_have_been_computed = .TRUE.
    400399
    401                       END IF
     400                      ENDIF
    402401
    403402!
    … …  
    467466                                         output_file, cfg)
    468467 CALL run_control('time', 'write')
    469                    END IF
     468                   ENDIF
    470469
    471470                   IF (ALLOCATED(output_arr))  DEALLOCATE(output_arr)
    472471 CALL run_control('time', 'alloc')
    473472
    474                 END IF
     473                ENDIF
    475474
    476475!
    477476!--          output variable loop
    478              END DO
     477             ENDDO
    479478
    480479             ug_vg_have_been_computed = .FALSE.
    … …  
    494493                   DEALLOCATE( p_east )
    495494                   DEALLOCATE( p_west )
    496                 END IF
    497              END IF
     495                ENDIF
     496             ENDIF
    498497
    499498!
    … …  
    505504                CALL report('main loop', 'Deallocating input buffer', cfg % debug)
    506505                DEALLOCATE(input_buffer)
    507              END IF
     506             ENDIF
    508507 CALL run_control('time', 'alloc')
    509508
    510509!
    511510!--       time steps / input files loop
    512           END DO
     511          ENDDO
    513512
    514513          IF (ALLOCATED(input_buffer))  THEN
    515514             CALL report('main loop', 'Deallocating input buffer', cfg % debug)
    516515             DEALLOCATE(input_buffer)
    517           END IF
     516          ENDIF
    518517 CALL run_control('time', 'alloc')
    519518
    … …  
    524523              message = TRIM(message) // " with input variable '" //           &
    525524              TRIM(group % in_var_list(1) % name) // "'."
    526           END IF
     525          ENDIF
    527526
    528527          CALL report('main loop', message, cfg % debug)
    … …  
    530529!
    531530!--    IO group % to_be_processed conditional
    532        END IF
     531       ENDIF
    533532
    534533!
    535534!-- IO groups loop
    536     END DO
     535    ENDDO
    537536
    538537!------------------------------------------------------------------------------

  • palm/trunk/UTIL/inifor/src/inifor_control.f90

    r3779 r3785  
    110110       ELSE
    111111          OPEN( NEWUNIT=u, FILE='inifor.log', POSITION='append', STATUS='old' )
    112        END IF
     112       ENDIF
    113113         
    114114
    … …  
    116116       IF ( PRESENT(debug) )  THEN
    117117          IF ( .NOT. debug )  suppress_message = .TRUE.
    118        END IF
     118       ENDIF
    119119
    120120       IF ( .NOT. suppress_message )  THEN
    121121          PRINT *, "inifor: " // TRIM(message) // "  [ " // TRIM(routine) // " ]"
    122122          WRITE(u, *)  TRIM(message) // "  [ " // TRIM(routine) // " ]"
    123        END IF
     123       ENDIF
    124124
    125125       CLOSE(u)

  • palm/trunk/UTIL/inifor/src/inifor_grid.f90

    r3779 r3785  
    440440                    "has not been implemented, yet."
    441441          CALL inifor_abort('setup_parameters', message)
    442        END IF
     442       ENDIF
    443443
    444444!
    … …  
    525525                                  // TRIM(cfg % namelist_file) // "'"
    526526
    527        END IF
     527       ENDIF
    528528       origin_lon = origin_lon * TO_RADIANS
    529529       origin_lat = origin_lat * TO_RADIANS
    … …  
    566566          hfl(:,:,k) = 0.5_dp * ( hhl(:,:,k) +                                 &
    567567                                  hhl(:,:,k+1) )
    568        END DO
     568       ENDDO
    569569 CALL run_control('time', 'comp')
    570570
    … …  
    10411041                  x0=x0, y0=y0, z0 = z0,                                          &
    10421042                  nx = nx, ny = ny, nz = nlev - 1)
    1043        END IF
     1043       ENDIF
    10441044
    10451045!                                                                             
    … …  
    11171117          CALL setup_interpolation(cosmo_grid, scalars_south_grid, scalars_south_intermediate, interp_mode)
    11181118          CALL setup_interpolation(cosmo_grid, scalars_top_grid, scalars_top_intermediate, interp_mode)
    1119        END IF
     1119       ENDIF
    11201120
    11211121       interp_mode = 'u'
    … …  
    11271127          CALL setup_interpolation(cosmo_grid, u_south_grid, u_south_intermediate, interp_mode)
    11281128          CALL setup_interpolation(cosmo_grid, u_top_grid, u_top_intermediate, interp_mode)
    1129        END IF
     1129       ENDIF
    11301130
    11311131       interp_mode = 'v'
    … …  
    11371137          CALL setup_interpolation(cosmo_grid, v_south_grid, v_south_intermediate, interp_mode)
    11381138          CALL setup_interpolation(cosmo_grid, v_top_grid, v_top_intermediate, interp_mode)
    1139        END IF
     1139       ENDIF
    11401140
    11411141       interp_mode = 'w'
    … …  
    11471147          CALL setup_interpolation(cosmo_grid, w_south_grid, w_south_intermediate, interp_mode)
    11481148          CALL setup_interpolation(cosmo_grid, w_top_grid, w_top_intermediate, interp_mode)
    1149        END IF
     1149       ENDIF
    11501150
    11511151       IF (TRIM(cfg % ic_mode) == 'profile')  THEN
    11521152           !TODO: remove this conditional if not needed.
    1153        END IF
     1153       ENDIF
    11541154       
    11551155
    … …  
    12411241       IF (PRESENT(ic_mode))  THEN
    12421242          IF (TRIM(ic_mode) == 'profile')  setup_volumetric = .FALSE.
    1243        END IF
     1243       ENDIF
    12441244
    12451245       IF (setup_volumetric)  THEN
    … …  
    12541254          CALL interpolate_2d(cosmo_h, intermediate_grid % h, intermediate_grid)
    12551255          CALL find_vertical_neighbours_and_weights_interp(grid, intermediate_grid)
    1256        END IF
     1256       ENDIF
    12571257       
    12581258    END SUBROUTINE setup_interpolation
    … …  
    13171317              message = "z has not been passed but is required for 'boundary' grids"
    13181318              CALL inifor_abort('init_grid_definition', message)
    1319            END IF
     1319           ENDIF
    13201320
    13211321           ALLOCATE( grid % x(0:nx) )
    … …  
    13351335              ALLOCATE( grid % w_verti(0:nx, 0:ny, 1:nz, 2) )
    13361336              grid % w_verti(:,:,:,:) = 0.0_dp
    1337            END IF
     1337           ENDIF
    13381338       
    13391339        CASE('boundary intermediate')
    … …  
    13741374              message = "z has not been passed but is required for 'palm' grids"
    13751375              CALL inifor_abort('init_grid_definition', message)
    1376            END IF
     1376           ENDIF
    13771377
    13781378           IF (.NOT.PRESENT(zw))  THEN
    13791379              message = "zw has not been passed but is required for 'palm' grids"
    13801380              CALL inifor_abort('init_grid_definition', message)
    1381            END IF
     1381           ENDIF
    13821382
    13831383           grid % name(1) = 'x and lon'
    … …  
    14071407              ALLOCATE( grid % w_verti(0:nx, 0:ny, 1:nz, 2) )
    14081408              grid % w_verti(:,:,:,:) = 0.0_dp
    1409            END IF
     1409           ENDIF
    14101410
    14111411        CASE('palm intermediate')
    … …  
    16021602                          avg_grid % iii, avg_grid % jjj)
    16031603
    1604        END IF
     1604       ENDIF
    16051605
    16061606!
    … …  
    16741674          avg_grid % iii(l) = i
    16751675          avg_grid % jjj(l) = j
    1676        END DO
    1677        END DO
     1676       ENDDO
     1677       ENDDO
    16781678
    16791679    END SUBROUTINE get_cosmo_averaging_region
    … …  
    20832083        DO k = 1, UBOUND(zw, 1)
    20842084           zw(k) = 0.5_dp * (z(k-1) + z(k))
    2085         END DO
     2085        ENDDO
    20862086
    20872087    END SUBROUTINE midpoints
    … …  
    22912291       ELSE
    22922292          group % n_output_quantities = group % n_inputs
    2293        END IF
     2293       ENDIF
    22942294
    22952295       ALLOCATE(group % in_var_list(group % n_inputs))
    … …  
    23472347          message = 'Simulation start date has not been set.'
    23482348          CALL inifor_abort('setup_variable_tables', message)
    2349        END IF
     2349       ENDIF
    23502350
    23512351       nc_source_text = 'COSMO-DE analysis from ' // TRIM(cfg % start_date)
    … …  
    24912491       IF (TRIM(ic_mode) == 'profile')  THEN
    24922492          output_var_table(3) % averaging_grid => averaged_initial_scalar_profile
    2493        END IF
     2493       ENDIF
    24942494
    24952495       output_var_table(4) = init_nc_var(                                      &
    … …  
    25672567       IF (TRIM(ic_mode) == 'profile')  THEN
    25682568          output_var_table(9) % averaging_grid => averaged_initial_scalar_profile
    2569        END IF
     2569       ENDIF
    25702570
    25712571       output_var_table(10) = init_nc_var(                                     &
    … …  
    26432643       IF (TRIM(ic_mode) == 'profile')  THEN
    26442644          output_var_table(15) % averaging_grid => averaged_initial_scalar_profile
    2645        END IF
     2645       ENDIF
    26462646
    26472647       output_var_table(16) = init_nc_var(                                     &
    … …  
    27192719       IF (TRIM(ic_mode) == 'profile')  THEN
    27202720          output_var_table(21) % averaging_grid => averaged_initial_scalar_profile
    2721        END IF
     2721       ENDIF
    27222722
    27232723       output_var_table(22) = init_nc_var(                                     &
    … …  
    27952795       IF (TRIM(ic_mode) == 'profile')  THEN
    27962796          output_var_table(27) % averaging_grid => averaged_initial_w_profile
    2797        END IF
     2797       ENDIF
    27982798
    27992799       output_var_table(28) = init_nc_var(                                     &
    … …  
    33153315       IF (PRESENT(is_profile))  THEN
    33163316          IF (is_profile)  out_var_kind = TRIM(kind) // ' profile'
    3317        END IF
     3317       ENDIF
    33183318
    33193319       var % name              = name
    … …  
    37343734                               u = input_buffer(1) % array(i,j,k),             &
    37353735                               v = input_buffer(2) % array(i,j,k) )
    3736              END DO
    3737              END DO
    3738              END DO
     3736             ENDDO
     3737             ENDDO
     3738             ENDDO
    37393739
    37403740          CASE DEFAULT
    … …  
    37883788                   basic_state_pressure(:)
    37893789
    3790              END DO
    3791              END DO
     3790             ENDDO
     3791             ENDDO
    37923792 CALL run_control('time', 'comp')
    37933793
    … …  
    37973797             group % in_var_list(2) % name = 'P'
    37983798
    3799           END IF
     3799          ENDIF
    38003800!
    38013801!--       mark pressure as preprocessed
    … …  
    38753875             input_buffer(1) % array(i,j,k) =                                  &
    38763876                 input_buffer(1) % array(i,j,k) * d_depth_rho_inv(k)
    3877           END DO
    3878           END DO
    3879           END DO
     3877          ENDDO
     3878          ENDDO
     3879          ENDDO
    38803880
    38813881          message = "Converted soil water from [kg/m^2] to [m^3/m^3]"
    … …  
    40544054                      n_cells = n_cells + 1
    40554055                      column(:) = column(:) + array(ii,jj,:)
    4056                    END IF
    4057 
    4058                 END DO
     4056                   ENDIF
     4057
     4058                ENDDO
    40594059
    40604060!
    … …  
    40634063                   array(i,j,:) = column(:) / n_cells
    40644064                   new_soiltyp(i,j) = 0
    4065                 END IF
    4066 
    4067              END IF
    4068 
    4069           END DO
    4070           END DO
     4065                ENDIF
     4066
     4067             ENDIF
     4068
     4069          ENDDO
     4070          ENDDO
    40714071
    40724072          old_soiltyp(:,:) = new_soiltyp(:,:)
    40734073
    4074        END DO
     4074       ENDDO
    40754075
    40764076       DEALLOCATE(old_soiltyp, new_soiltyp)

  • palm/trunk/UTIL/inifor/src/inifor_io.f90

    r3779 r3785  
    177177          CALL inifor_abort('get_netcdf_variable', message)
    178178
    179        END IF
     179       ENDIF
    180180
    181181       CALL check(nf90_close(ncid))
    … …  
    221221          CALL inifor_abort('get_netcdf_variable', message)
    222222
    223        END IF
     223       ENDIF
    224224
    225225       CALL check(nf90_close(ncid))
    … …  
    259259          CALL inifor_abort('get_netcdf_dim_vector', message)
    260260
    261        END IF
     261       ENDIF
    262262
    263263    END SUBROUTINE get_netcdf_dim_vector
    … …  
    291291                                             name = in_var % dimname(i),       &
    292292                                             len  = in_var % dimlen(i) ))
    293        END DO
     293       ENDDO
    294294
    295295    END SUBROUTINE get_input_dimensions
    … …  
    318318          CALL inifor_abort('get_netcdf_start_and_count', message)
    319319
    320        END IF
     320       ENDIF
    321321
    322322       start = (/ 1, 1, 1 /)
    … …  
    329329!--       Start reading from second level, e.g. depth = 0.005 instead of 0.0
    330330          start(3) = 2
    331        END IF
     331       ENDIF
    332332
    333333       IF (in_var % ndim .EQ. 2)  THEN
    … …  
    358358        IF ( var % lod .GE. 0 )  THEN
    359359           CALL check(nf90_put_att(ncid, var % varid, "lod",           var % lod))
    360         END IF
     360        ENDIF
    361361        CALL check(nf90_put_att(ncid, var % varid, "source",        var % source))
    362362        CALL check(nf90_put_att(ncid, var % varid, "_FillValue",    NF90_FILL_REAL))
    … …  
    383383                                             name = null, &
    384384                                             len  = var % dimlen(i)  ) )
    385         END DO
     385        ENDDO
    386386
    387387    END SUBROUTINE netcdf_get_dimensions
    … …  
    538538             i = i + 1
    539539
    540           END DO
     540          ENDDO
    541541
    542542       ELSE
    … …  
    545545          CALL report('parse_command_line_arguments', message)
    546546
    547        END IF
     547       ENDIF
    548548
    549549   END SUBROUTINE parse_command_line_arguments
    … …  
    574574                          TRIM(date_string) // TRIM(suffix) // '.nc'
    575575
    576       END DO
     576      ENDDO
    577577
    578578   END SUBROUTINE get_datetime_file_list
    … …  
    594594      LOGICAL, OPTIONAL, INTENT(IN)    ::  nocheck
    595595
    596       INTEGER             ::  number_of_intervals, hour, i
    597       CHARACTER(LEN=DATE) ::  date_string
    598       CHARACTER(LEN=PATH) ::  file_name
    599       LOGICAL             ::  check_files
     596      INTEGER ::  i
     597      LOGICAL ::  check_files
    600598
    601599      CALL get_datetime_file_list( start_date_string, start_hour, end_hour,    &
    … …  
    606604      IF ( PRESENT ( nocheck ) )  THEN
    607605         IF ( nocheck )  check_files = .FALSE.
    608       END IF
     606      ENDIF
    609607
    610608      IF ( check_files )  THEN
    … …  
    615613         DO i = 1, SIZE(file_list)
    616614             CALL verify_file(file_list(i), 'input', tip)
    617          END DO
    618 
    619       END IF
     615         ENDDO
     616
     617      ENDIF
    620618
    621619   END SUBROUTINE get_input_file_list
    … …  
    645643            IF (PRESENT(tip))  THEN
    646644               message = TRIM(message) // " " // TRIM(tip)
    647             END IF
    648 
    649          END IF
     645            ENDIF
     646
     647         ENDIF
    650648
    651649         CALL inifor_abort('verify_file', message)
    652650
    653       END IF
     651      ENDIF
    654652
    655653      message = "Set up input file name '" // TRIM(file_name) // "'"
    … …  
    691689      IF (TRIM(cfg % static_driver_file) .NE. '')  THEN
    692690         CALL verify_file(cfg % static_driver_file, 'static driver')
    693       END IF
     691      ENDIF
    694692
    695693      SELECT CASE( TRIM(cfg % ic_mode) )
    … …  
    739737                   "wind. Please specify either both or none."
    740738         CALL inifor_abort( 'validate_config', message )
    741       END IF
     739      ENDIF
    742740
    743741   END SUBROUTINE validate_config
    … …  
    958956!> Defines the netCDF variables to be written to the dynamic driver file
    959957!------------------------------------------------------------------------------!
    960     SUBROUTINE setup_netcdf_variables(filename, output_variable_table, debug)
     958    SUBROUTINE setup_netcdf_variables(filename, output_variable_table)
    961959
    962960       CHARACTER (LEN=*), INTENT(IN)        ::  filename
    963961       TYPE(nc_var), INTENT(INOUT), TARGET  ::  output_variable_table(:)
    964        LOGICAL, INTENT(IN)                  ::  debug
    965962
    966963       TYPE(nc_var), POINTER                ::  var
    … …  
    988985             CALL netcdf_define_variable(var, ncid)
    989986             CALL netcdf_get_dimensions(var, ncid)
    990           END IF
     987          ENDIF
    991988           
    992        END DO
     989       ENDDO
    993990
    994991       CALL check(nf90_enddef(ncid))
    … …  
    10431040                       TRIM( str(SIZE(group % in_var_list)) ) // "."
    10441041             CALL inifor_abort('read_input_variables | accumulation', message)
    1045           END IF
     1042          ENDIF
    10461043
    10471044!
    … …  
    10951092                input_var % name = TRIM( get_pressure_varname(input_file) )
    10961093 CALL run_control('time', 'read')
    1097              END IF
     1094             ENDIF
    10981095
    10991096             CALL get_netcdf_variable(input_file, input_var, buffer(ivar) % array)
    … …  
    11021099 CALL run_control('time', 'comp')
    11031100
    1104           END DO
    1105        END IF
     1101          ENDDO
     1102       ENDIF
    11061103
    11071104    END SUBROUTINE read_input_variables
    … …  
    11591156          CALL inifor_abort('get_pressure_var', message)
    11601157
    1161        END IF
     1158       ENDIF
    11621159
    11631160       CALL check(nf90_close(ncid))
    … …  
    11891186          CALL inifor_abort('get_netcdf_attribute', message)
    11901187
    1191        END IF
     1188       ENDIF
    11921189
    11931190    END FUNCTION get_netcdf_attribute
    … …  
    12521249                 SIZE(array, 2), ")."
    12531250             STOP
    1254           END IF
     1251          ENDIF
    12551252         
    12561253
    … …  
    13031300                                      start=start(1:ndim+1),                   &
    13041301                                      count=count(1:ndim) ) )
    1305           END IF
     1302          ENDIF
    13061303
    13071304       CASE ( 'large-scale scalar forcing', 'large-scale w forcing' )
    … …  
    13361333                    TRIM( nf90_strerror(status) )
    13371334          CALL inifor_abort('io.check', message)
    1338        END IF
     1335       ENDIF
    13391336
    13401337    END SUBROUTINE check

  • palm/trunk/UTIL/inifor/src/inifor_transform.f90

    r3779 r3785  
    121121       REAL(dp), INTENT(OUT)             ::  out_arr(:)
    122122
    123        INTEGER :: i, j, k, l, nz
     123       INTEGER :: k, l, nz
    124124
    125125       nz = UBOUND(out_arr, 1)
    … …  
    139139                out_arr(k) = out_arr(k) +                                      &
    140140                    outgrid % w(1,k,l) * in_arr(outgrid % kkk(1,k,l) )
    141              END DO
    142           END IF
    143        END DO
     141             ENDDO
     142          ENDIF
     143       ENDDO
    144144
    145145    END SUBROUTINE interpolate_1d
    … …  
    195195                    outgrid % w_verti(i,j,k,l) *                               &
    196196                    in_arr(i,j,outgrid % kk(i,j,k, l) )
    197              END DO
    198           END IF
    199        END DO
    200        END DO
    201        END DO
     197             ENDDO
     198          ENDIF
     199       ENDDO
     200       ENDDO
     201       ENDDO
    202202    END SUBROUTINE interpolate_1d_arr
    203203
    … …  
    245245              TRIM(str(UBOUND(invar, 3))) // ")."
    246246           CALL inifor_abort('interpolate_2d', message)
    247        END IF
     247       ENDIF
    248248
    249249       DO k = 0, UBOUND(outvar, 3)
    … …  
    257257                                                  outgrid % jj(i,j,l),         &
    258258                                                  k )
    259           END DO
    260        END DO
    261        END DO
    262        END DO
     259          ENDDO
     260       ENDDO
     261       ENDDO
     262       ENDDO
    263263       
    264264    END SUBROUTINE interpolate_2d
    … …  
    284284             NEW_LINE(' ') // "jj has " // str(SIZE(jj)) // "."
    285285          CALL inifor_abort('average_2d', message)
    286        END IF
     286       ENDIF
    287287
    288288       IF (SIZE(ii) == 0)  THEN
    … …  
    290290                    "size of index lists 'ii' and 'jj' is zero."
    291291          CALL inifor_abort('average_2d', message)
    292        END IF
     292       ENDIF
    293293
    294294       DO k = 0, UBOUND(out_arr, 1)
    … …  
    299299             j = jj(l)
    300300             out_arr(k) = out_arr(k) + in_arr(i, j, k)
    301           END DO
    302 
    303        END DO
     301          ENDDO
     302
     303       ENDDO
    304304
    305305       ni = 1.0_dp / SIZE(ii)
    … …  
    385385!
    386386!--          Loop over vertical interpolation neighbours m
    387              END DO
     387             ENDDO
    388388
    389389!
    390390!--       Loop over PALM levels k_profile
    391           END DO
     391          ENDDO
    392392
    393393!
    394394!--    Loop over horizontal neighbours l
    395        END DO
     395       ENDDO
    396396
    397397       ni_columns = 1.0_dp / avg_grid % n_columns
    … …  
    411411!> averaging grid 'avg_grid' and store the result in 'profile_array'.
    412412!------------------------------------------------------------------------------!
    413     SUBROUTINE average_profile( source_array, profile_array,                   &
    414                                 source_grid, avg_grid )
    415 
    416        TYPE(grid_definition), INTENT(IN)          ::  source_grid, avg_grid
     413    SUBROUTINE average_profile( source_array, profile_array, avg_grid )
     414
     415       TYPE(grid_definition), INTENT(IN)          ::  avg_grid
    417416       REAL(dp), DIMENSION(:,:,:), INTENT(IN)     ::  source_array
    418417       REAL(dp), DIMENSION(:), INTENT(OUT)        ::  profile_array
    419418
    420        INTEGER ::  i_source, j_source, k_profile, k_source, l, m, nz, nlev
    421 
    422        REAL                            ::  ni_columns
     419       INTEGER ::  i_source, j_source, l, nz, nlev
     420
     421       REAL(dp) ::  ni_columns
    423422
    424423       nlev = SIZE( source_array, 3 )
    … …  
    442441                           + source_array(i_source, j_source, :)
    443442
    444        END DO
     443       ENDDO
    445444
    446445       ni_columns = 1.0_dp / avg_grid % n_columns
    … …  
    464463       REAL(dp), DIMENSION(:), INTENT(OUT)        ::  profile_array
    465464
    466        INTEGER ::  i_source, j_source, k_profile, k_source, l, m, nz, nlev
     465       INTEGER ::  i_source, j_source, l, nz, nlev
    467466
    468467       REAL(dp)                            ::  ni_columns
    … …  
    497496!
    498497!--    Loop over horizontal neighbours l
    499        END DO
     498       ENDDO
    500499
    501500       DEALLOCATE( basic_state_pressure )
    … …  
    554553          p(k) = constant_density_pressure(p(k_min), zk, rhok, drhodz,         &
    555554                                           avg_grid % z(k), G)
    556        END DO
     555       ENDDO
    557556
    558557    END SUBROUTINE extrapolate_pressure
    … …  
    706705       IF (phi_c > 0.0_dp)  THEN
    707706          lamc_to_lamn = lam_c - SIGN(PI, lam_c)
    708        END IF
     707       ENDIF
    709708
    710709    END FUNCTION lamc_to_lamn
    … …  
    731730       ELSE
    732731           gamma_from_hemisphere = 0.0_dp
    733        END IF
     732       ENDIF
    734733    END FUNCTION gamma_from_hemisphere
    735734
    … …  
    773772          PRINT *, "inifor: rotate_to_cosmo: lam: ", SIZE(lam, 1), SIZE(lam, 2)
    774773          STOP
    775        END IF
     774       ENDIF
    776775
    777776       IF ( SIZE(phir) .NE. SIZE(phi, 2) .OR. &
    … …  
    781780          PRINT *, "inifor: rotate_to_cosmo: lamr: ", SIZE(lamr), SIZE(phi, 1)
    782781          STOP
    783        END IF
     782       ENDIF
    784783       
    785784       DO j = 0, UBOUND(phir, 1)
    … …  
    797796                                   gam  * TO_DEGREES) * TO_RADIANS
    798797
    799           END DO
    800        END DO
     798          ENDDO
     799       ENDDO
    801800
    802801    END SUBROUTINE rotate_to_cosmo
    … …  
    831830          y(i) = v_rot(2)
    832831
    833        END DO
     832       ENDDO
    834833
    835834    END SUBROUTINE rotate_vector_field
    … …  
    941940                ", PALM lat " // TRIM(real_to_str(palm_clat(i,j)*TO_DEGREES))
    942941             CALL inifor_abort('find_horizontal_neighbours', message)
    943           END IF
     942          ENDIF
    944943
    945944          palm_ii(i,j,1) = FLOOR(lonpos)
    … …  
    952951          palm_jj(i,j,3) = CEILING(latpos)
    953952          palm_jj(i,j,4) = FLOOR(latpos)
    954        END DO
    955        END DO
     953       ENDDO
     954       ENDDO
    956955
    957956    END SUBROUTINE find_horizontal_neighbours
    … …  
    10421041                      current_height <  h_top                                  &
    10431042                   )
    1044                 END DO
     1043                ENDDO
    10451044
    10461045                IF (k_intermediate > nlev-1)  THEN
    … …  
    10481047                             " is above intermediate grid range."
    10491048                   CALL inifor_abort('find_vertical_neighbours', message)
    1050                 END IF
     1049                ENDIF
    10511050   
    10521051                palm_grid % kk(i,j,k,1) = k_intermediate
    … …  
    10581057                palm_grid % w_verti(i,j,k,1) = weight
    10591058                palm_grid % w_verti(i,j,k,2) = 1.0_dp - weight
    1060              END IF
    1061 
    1062           END DO
    1063 
    1064        END DO
    1065        END DO
     1059             ENDIF
     1060
     1061          ENDDO
     1062
     1063       ENDDO
     1064       ENDDO
    10661065
    10671066    END SUBROUTINE find_vertical_neighbours_and_weights_interp
    … …  
    11031102       ELSE
    11041103          cosmo_h => avg_grid % cosmo_h
    1105        END IF
     1104       ENDIF
    11061105
    11071106!
    … …  
    11151114             i = avg_grid % iii(l)
    11161115             j = avg_grid % jjj(l)
    1117           END IF
     1116          ENDIF
    11181117
    11191118          column_base = cosmo_h(i,j,1)
    … …  
    11761175                      current_height <  h_top                                  &
    11771176                   )
    1178                 END DO
     1177                ENDDO
    11791178
    11801179!
    … …  
    11851184                             " is above intermediate grid range."
    11861185                   CALL inifor_abort('find_vertical_neighbours', message)
    1187                 END IF
     1186                ENDIF
    11881187   
    11891188                avg_grid % kkk(l,k_palm,1) = k_intermediate
    … …  
    11951194                avg_grid % w(l,k_palm,1) = weight
    11961195                avg_grid % w(l,k_palm,2) = 1.0_dp - weight
    1197              END IF
     1196             ENDIF
    11981197
    11991198!
    12001199!--       Loop over PALM levels k
    1201           END DO
     1200          ENDDO
    12021201
    12031202!
    12041203!--       Loop over averaging columns l
    1205        END DO
     1204       ENDDO
    12061205 
    12071206    END SUBROUTINE find_vertical_neighbours_and_weights_average
    … …  
    12831282                        " is out bounds."
    12841283              CALL inifor_abort('compute_horizontal_interp_weights', message)
    1285           END IF
     1284          ENDIF
    12861285          IF (wp > 1.0_dp .OR. wp < 0.0_dp)  THEN
    12871286              message = "Horizontal weight wp = " // TRIM(real_to_str(wp)) //   &
    12881287                        " is out bounds."
    12891288              CALL inifor_abort('compute_horizontal_interp_weights', message)
    1290           END IF
     1289          ENDIF
    12911290
    12921291          palm_w_horiz(i,j,1) = wl * wp
    … …  
    12951294          palm_w_horiz(i,j,4) = 1.0_dp - SUM( palm_w_horiz(i,j,1:3) )
    12961295
    1297        END DO
    1298        END DO
     1296       ENDDO
     1297       ENDDO
    12991298       
    13001299    END SUBROUTINE compute_horizontal_interp_weights
    … …  
    13521351       ELSE
    13531352          zrlas = rlarot
    1354        END IF
     1353       ENDIF
    13551354       zrlas = zrlas * TO_RADIANS
    13561355     
    … …  
    13621361       ELSE
    13631362          zarg = zcospol * COS (zphis) * COS (zrlas) + zsinpol * SIN (zphis)
    1364        END IF
     1363       ENDIF
    13651364     
    13661365       phirot2phi = ASIN (zarg) * TO_DEGREES
    … …  
    13941393       ELSE
    13951394          zrla1 = rla
    1396        END IF
     1395       ENDIF
    13971396       zrla = zrla1 * TO_RADIANS
    13981397       
    … …  
    14311430       ELSE
    14321431          zrlas = rlarot
    1433        END IF
     1432       ENDIF
    14341433       zrlas   = TO_RADIANS * zrlas
    14351434     
    … …  
    14521451                                      zcospol *              SIN(zphis)) +     &
    14531452                    SIN (zlampol) *             SIN(zrlas) * COS(zphis)
    1454        END IF
     1453       ENDIF
    14551454     
    14561455       IF (zarg2 == 0.0_dp)  zarg2 = 1.0E-20_dp
    … …  
    14871486       ELSE
    14881487          zrla1 = rla
    1489        END IF
     1488       ENDIF
    14901489       zrla = zrla1 * TO_RADIANS
    14911490       
    … …  
    15001499          rla2rlarot = polgam + rla2rlarot
    15011500          IF (rla2rlarot > 180._dp)  rla2rlarot = rla2rlarot - 360.0_dp
    1502        END IF
     1501       ENDIF
    15031502       
    15041503    END FUNCTION rla2rlarot

  • palm/trunk/UTIL/inifor/src/inifor_util.f90

    r3779 r3785  
    250250          DO i = 0, n
    251251             array(i) = start + REAL(i, dp) / n * (stop - start)
    252           END DO
    253 
    254        END IF
     252          ENDDO
     253
     254       ENDIF
    255255       
    256256    END SUBROUTINE linspace
    … …  
    366366        ELSE
    367367           WRITE(real_to_str, '(E11.4)') val
    368         END IF
     368        ENDIF
    369369        real_to_str = ADJUSTL(real_to_str)
    370370
    … …  
    416416        IF (path(n:n) .NE. '/')  THEN
    417417           path = TRIM(path) // '/'
    418         END IF
     418        ENDIF
    419419
    420420    END SUBROUTINE

  • palm/trunk/UTIL/inifor/tests/Makefile

    r3618 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3618 2018-12-10 13:25:22Z eckhard
    2731# Prefixed INIFOR modules with inifor_
    2832#

  • palm/trunk/UTIL/inifor/tests/Makefile.gnu

    r3618 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3618 2018-12-10 13:25:22Z eckhard
    2731# Prefixed INIFOR modules with inifor_
    2832#

  • palm/trunk/UTIL/inifor/tests/Makefile.ifort

    r3618 r3785  
    1414# PALM. If not, see <http://www.gnu.org/licenses/>.
    1515#
    16 # Copyright 2017-2018 Leibniz Universitaet Hannover
    17 # Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     16# Copyright 2017-2019 Leibniz Universitaet Hannover
     17# Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1818#------------------------------------------------------------------------------#
    1919#
    … …  
    2525# -----------------
    2626# $Id$
     27# Updated copyright note
     28#
     29#
     30# 3618 2018-12-10 13:25:22Z eckhard
    2731# Prefixed INIFOR modules with inifor_
    2832#

  • palm/trunk/UTIL/inifor/tests/test-boundaries.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    104104   
    105105       CALL fini_grid_definition(boundary_grid)
    106     END DO
     106    ENDDO
    107107
    108108    CALL end_test(title, res)

  • palm/trunk/UTIL/inifor/tests/test-centre-velocities.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    7575       res = res .AND. assert_equal(u_centre(:,i,1), u_ref(:,i,1), 'centering u')
    7676       res = res .AND. assert_equal(v_centre(i,:,1), v_ref(i,:,1), 'centering v')
    77     END DO
     77    ENDDO
    7878
    7979    CALL end_test(title, res)

  • palm/trunk/UTIL/inifor/tests/test-grid.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    7474       xu(i) = real(i) / (nx+1) * lx
    7575       x(i)  = 0.5*dx + xu(i)
    76     END DO
     76    ENDDO
    7777
    7878    dy = ly / (ny + 1)
    … …  
    8080       yv(i) = real(i) / (ny+1) * ly
    8181       y(i)  = 0.5*dy + yv(i)
    82     END DO
     82    ENDDO
    8383
    8484    dz(:) = lz / (nz + 1)
    … …  
    8686       IF (i < nz)  zw(i) = real(i) / (nz+1) * lz
    8787       z(i) = 0.5*dz(1) + zw(i)
    88     END DO
     88    ENDDO
    8989
    9090    ! Act

  • palm/trunk/UTIL/inifor/tests/test-input-files.f90

    r3681 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    9090    DO i = 1, 6
    9191       res = res .AND. (TRIM(ref_list(i)) .EQ. TRIM(file_list(i)))
    92     END DO
     92    ENDDO
    9393
    9494    DEALLOCATE( ref_list, file_list )
    … …  
    115115    DO i = 1, 2
    116116       res = res .AND. (TRIM(ref_list(i)) .EQ. TRIM(file_list(i)))
    117     END DO
     117    ENDDO
    118118
    119119    DEALLOCATE( ref_list, file_list )
    … …  
    145145    DO i = 1, 2
    146146       res = res .AND. (TRIM(ref_list(i)) .EQ. TRIM(file_list(i)))
    147     END DO
     147    ENDDO
    148148
    149149    DEALLOCATE( ref_list, file_list )

  • palm/trunk/UTIL/inifor/tests/test-interpolation.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    146146       PRINT *, "jj     : ", palm_grid%jj(i,j,:)
    147147       PRINT *, "jj_ref : ", jj_ref(i,j,:), " indices match? ", res
    148     END DO
    149     END DO
     148    ENDDO
     149    ENDDO
    150150
    151151    CALL end_test(title, res)
    … …  
    180180    DO i = 0, 1
    181181       PRINT *, "PALM lon, lat: ", palm_grid % clon(i,j) * TO_DEGREES, palm_grid % clat(i,j)*TO_DEGREES
    182     END DO
    183     END DO
     182    ENDDO
     183    ENDDO
    184184
    185185    ! Act
    … …  
    203203       PRINT *, "jj     : ", palm_grid%jj(i,j,:)
    204204       PRINT *, "jj_ref : ", jj_ref(i,j,:), " indices match? ", res
    205     END DO
    206     END DO
     205    ENDDO
     206    ENDDO
    207207
    208208    ! asserting that all four weights equal, 0.5, 0.25, 1./6., and 1./12., resp.

  • palm/trunk/UTIL/inifor/tests/test-prototype.f90

    r3183 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!

  • palm/trunk/UTIL/inifor/tests/test-stretching.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!

  • palm/trunk/UTIL/inifor/tests/test-transform.f90

    r3618 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!

  • palm/trunk/UTIL/inifor/tests/util.f90

    r3183 r3785  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2017-2018 Leibniz Universitaet Hannover
    18 ! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
     17! Copyright 2017-2019 Leibniz Universitaet Hannover
     18! Copyright 2017-2019 Deutscher Wetterdienst Offenbach
    1919!------------------------------------------------------------------------------!
    2020!
    … …  
    7171          msg = 'failed.'
    7272          label = ' [XX]'
    73        END IF
     73       ENDIF
    7474
    7575       PRINT '(/A, A, A, A)', TRIM(label) // "  Test '", TRIM(title), "' ", TRIM(msg)
    … …  
    8787       ELSE
    8888           assert_equal = assert(a, b, 'eq')
    89        END IF
     89       ENDIF
    9090
    9191       IF (assert_equal .eqv. .TRUE.)  THEN
    … …  
    9494           PRINT *, "Equality assertion for ", msg, " failed. Maximum error is ",               &
    9595              MAXVAL( ABS( a - b))
    96        END IF
     96       ENDIF
    9797
    9898    END FUNCTION assert_equal
    … …  
    125125                mag    = MAX( ABS(a(i)), ABS(b(i)) )
    126126                assert = assert .AND. (diff < mag * max_rel_diff )
    127              END DO
    128           END IF
     127             ENDDO
     128          ENDIF
    129129
    130130       CASE DEFAULT
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |