Changeset 3435 for palm/trunk/SOURCE


Ignore:
Timestamp:
Oct 26, 2018 6:25:44 PM (6 years ago)
Author:
gronemeier
Message:

new: terrain-following masked output; bugfixes: increase vertical dimension of gamma_w_green_sat by 1, add checks for masked output for chemistry_model and radiation_model, reordered calls to xxx_define_netcdf_grid in masked output part

Location:
palm/trunk/SOURCE
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r3421 r3435  
    2525# -----------------
    2626# $Id$
     27# - Add surface_mod to data_output_mask
     28# - Add chemistry_model_mod and surface_mod to init_masks
     29#
     30# 3421 2018-10-24 18:39:32Z gronemeier
    2731# Add netcdf_data_input_mod to netcdf_interface_mod
    2832# bugfix: add dependencies to chemistry_model_mod
     
    879883        mod_particle_attributes.o \
    880884        modules.o \
    881         netcdf_interface_mod.o
     885        netcdf_interface_mod.o \
     886        surface_mod.o
    882887data_output_profiles.o: \
    883888        cpulog_mod.o \
     
    10871092init_masks.o: \
    10881093        bulk_cloud_model_mod.o \
    1089         mod_kinds.o \
    1090         modules.o \
    1091         netcdf_interface_mod.o
     1094        chemistry_model_mod.o \
     1095        mod_kinds.o \
     1096        modules.o \
     1097        netcdf_interface_mod.o \
     1098        radiation_model_mod.o
    10921099init_pegrid.o: \
    10931100        mod_kinds.o \
  • palm/trunk/SOURCE/chemistry_model_mod.f90

    r3373 r3435  
    2727! -----------------
    2828! $Id$
     29! Add terrain-following masked output
     30!
     31! 3373 2018-10-18 15:25:56Z kanani
    2932! Remove MPI_Abort, replace by message
    3033!
     
    11491152       USE kinds
    11501153       USE pegrid,             ONLY: myid, threads_per_task
    1151 
     1154       USE surface_mod,        ONLY: get_topography_top_index_ji
    11521155
    11531156       IMPLICIT NONE
     1157
     1158       CHARACTER(LEN=5) ::  grid        !< flag to distinquish between staggered grids
    11541159
    11551160       CHARACTER (LEN=*)::  variable    !<
     
    11661171       INTEGER(iwp) ::  j               !< grid index along y-direction
    11671172       INTEGER(iwp) ::  k               !< grid index along z-direction
     1173       INTEGER(iwp) ::  topo_top_ind    !< k index of highest horizontal surface
     1174
    11681175       found = .TRUE.
     1176       grid  = 's'
    11691177
    11701178       spec_name = TRIM( variable(4:) )
     
    11781186!                                                           TRIM(chem_species(lsp)%name)       
    11791187             IF (av == 0) THEN
    1180                 DO  i = 1, mask_size_l(mid,1)
    1181                    DO  j = 1, mask_size_l(mid,2)
    1182                       DO  k = 1, mask_size(mid,3)
    1183                           local_pf(i,j,k) = chem_species(lsp)%conc(mask_k(mid,k),                                    &
    1184                                               mask_j(mid,j), mask_i(mid,i))
     1188                IF ( .NOT. mask_surface(mid) )  THEN
     1189
     1190                   DO  i = 1, mask_size_l(mid,1)
     1191                      DO  j = 1, mask_size_l(mid,2)
     1192                         DO  k = 1, mask_size(mid,3)
     1193                             local_pf(i,j,k) = chem_species(lsp)%conc(  &
     1194                                                  mask_k(mid,k),        &
     1195                                                  mask_j(mid,j),        &
     1196                                                  mask_i(mid,i)      )
     1197                         ENDDO
    11851198                      ENDDO
    11861199                   ENDDO
    1187                 ENDDO
    1188            
    1189              ELSE
    1190                 DO  i = 1, mask_size_l(mid,1)
    1191                    DO  j = 1, mask_size_l(mid,2)
    1192                       DO  k =  1, mask_size_l(mid,3)
    1193                           local_pf(i,j,k) = chem_species(lsp)%conc_av(mask_k(mid,k),                &
    1194                                              mask_j(mid,j), mask_i(mid,i))
     1200
     1201                ELSE
     1202!             
     1203!--                Terrain-following masked output
     1204                   DO  i = 1, mask_size_l(mid,1)
     1205                      DO  j = 1, mask_size_l(mid,2)
     1206!             
     1207!--                      Get k index of highest horizontal surface
     1208                         topo_top_ind = get_topography_top_index_ji( &
     1209                                           mask_j(mid,j),  &
     1210                                           mask_i(mid,i),  &
     1211                                           grid                    )
     1212!             
     1213!--                      Save output array
     1214                         DO  k = 1, mask_size_l(mid,3)
     1215                            local_pf(i,j,k) = chem_species(lsp)%conc( &
     1216                                                 MIN( topo_top_ind+mask_k(mid,k), &
     1217                                                      nzt+1 ),        &
     1218                                                 mask_j(mid,j),       &
     1219                                                 mask_i(mid,i)      )
     1220                         ENDDO
    11951221                      ENDDO
    11961222                   ENDDO
    1197                 ENDDO
     1223
     1224                ENDIF
     1225             ELSE
     1226                IF ( .NOT. mask_surface(mid) )  THEN
     1227
     1228                   DO  i = 1, mask_size_l(mid,1)
     1229                      DO  j = 1, mask_size_l(mid,2)
     1230                         DO  k =  1, mask_size_l(mid,3)
     1231                             local_pf(i,j,k) = chem_species(lsp)%conc_av(  &
     1232                                                  mask_k(mid,k),           &
     1233                                                  mask_j(mid,j),           &
     1234                                                  mask_i(mid,i)         )
     1235                         ENDDO
     1236                      ENDDO
     1237                   ENDDO
     1238
     1239                ELSE
     1240!             
     1241!--                Terrain-following masked output
     1242                   DO  i = 1, mask_size_l(mid,1)
     1243                      DO  j = 1, mask_size_l(mid,2)
     1244!             
     1245!--                      Get k index of highest horizontal surface
     1246                         topo_top_ind = get_topography_top_index_ji( &
     1247                                           mask_j(mid,j),  &
     1248                                           mask_i(mid,i),  &
     1249                                           grid                    )
     1250!             
     1251!--                      Save output array
     1252                         DO  k = 1, mask_size_l(mid,3)
     1253                            local_pf(i,j,k) = chem_species(lsp)%conc_av(  &
     1254                                                 MIN( topo_top_ind+mask_k(mid,k), &
     1255                                                      nzt+1 ),            &
     1256                                                 mask_j(mid,j),           &
     1257                                                 mask_i(mid,i)         )
     1258                         ENDDO
     1259                      ENDDO
     1260                   ENDDO
     1261
     1262                ENDIF
     1263
     1264
    11981265             ENDIF
    11991266             found = .FALSE.
  • palm/trunk/SOURCE/data_output_mask.f90

    r3421 r3435  
    2525! -----------------
    2626! $Id$
     27! Add terrain-following output
     28!
     29! 3421 2018-10-24 18:39:32Z gronemeier
    2730! Renamed output variables
    2831!
     
    155158        ONLY:  air_chemistry, domask, domask_no, domask_time_count, mask_i,    &
    156159               mask_j, mask_k, mask_size, mask_size_l, mask_start_l,           &
     160               mask_surface,                                                   &
    157161               max_masks, message_string, mid, nz_do3d, simulated_time
    158162    USE cpulog,                                                                &
     
    160164
    161165    USE indices,                                                               &
    162         ONLY:  nbgp, nxl, nxr, nyn, nys, nzb
     166        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
    163167
    164168    USE kinds
     
    182186        ONLY:  radiation, radiation_data_output_mask
    183187
     188    USE surface_mod,                                                           &
     189        ONLY :  surf_def_h, surf_lsm_h, surf_usm_h, get_topography_top_index_ji
     190
    184191    IMPLICIT NONE
    185192
    186     INTEGER(iwp) ::  av       !<
    187     INTEGER(iwp) ::  ngp      !<
    188     INTEGER(iwp) ::  i        !<
    189     INTEGER(iwp) ::  ivar     !<
    190     INTEGER(iwp) ::  j        !<
    191     INTEGER(iwp) ::  k        !<
    192     INTEGER(iwp) ::  n        !<
     193    CHARACTER(LEN=5) ::  grid !< flag to distinquish between staggered grids
     194
     195    INTEGER(iwp) ::  av                      !<
     196    INTEGER(iwp) ::  ngp                     !<
     197    INTEGER(iwp) ::  i                       !<
     198    INTEGER(iwp) ::  ivar                    !<
     199    INTEGER(iwp) ::  j                       !<
     200    INTEGER(iwp) ::  k                       !<
     201    INTEGER(iwp) ::  kk                      !<
     202    INTEGER(iwp) ::  n                       !<
    193203    INTEGER(iwp) ::  netcdf_data_format_save !<
    194     INTEGER(iwp) ::  sender   !<
    195     INTEGER(iwp) ::  ind(6)   !<
    196    
    197     LOGICAL ::  found         !<
    198     LOGICAL ::  resorted      !<
    199    
    200     REAL(wp) ::  mean_r       !<
    201     REAL(wp) ::  s_r2         !<
    202     REAL(wp) ::  s_r3         !<
     204    INTEGER(iwp) ::  sender                  !<
     205    INTEGER(iwp) ::  topo_top_ind            !< k index of highest horizontal surface
     206    INTEGER(iwp) ::  ind(6)                  !<
     207
     208    LOGICAL ::  found     !<
     209    LOGICAL ::  resorted  !<
     210
     211    REAL(wp) ::  mean_r   !<
     212    REAL(wp) ::  s_r2     !<
     213    REAL(wp) ::  s_r3     !<
    203214   
    204215    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !<
     
    261272       ENDIF
    262273!
     274!--    Set default grid for terrain-following output
     275       grid = 's'
     276!
    263277!--    Set flag to steer output of radiation, land-surface, or user-defined
    264278!--    quantities
     
    308322                tend = prt_count
    309323                CALL exchange_horiz( tend, nbgp )
    310                 DO  i = 1, mask_size_l(mid,1)
    311                    DO  j = 1, mask_size_l(mid,2)
    312                       DO  k = 1, mask_size_l(mid,3)
    313                          local_pf(i,j,k) =  tend(mask_k(mid,k), &
    314                                    mask_j(mid,j),mask_i(mid,i))
    315                       ENDDO
    316                    ENDDO
    317                 ENDDO
     324                IF ( .NOT. mask_surface(mid) )  THEN
     325                   DO  i = 1, mask_size_l(mid,1)
     326                      DO  j = 1, mask_size_l(mid,2)
     327                         DO  k = 1, mask_size_l(mid,3)
     328                            local_pf(i,j,k) =  tend(mask_k(mid,k), &
     329                                      mask_j(mid,j),mask_i(mid,i))
     330                         ENDDO
     331                      ENDDO
     332                   ENDDO
     333                ELSE
     334!
     335!--                Terrain-following masked output
     336                   DO  i = 1, mask_size_l(mid,1)
     337                      DO  j = 1, mask_size_l(mid,2)
     338!
     339!--                      Get k index of highest horizontal surface
     340                         topo_top_ind =  &
     341                            get_topography_top_index_ji( mask_j(mid,j),  &
     342                                                         mask_i(mid,i),  &
     343                                                         grid )
     344                         DO  k = 1, mask_size_l(mid,3)
     345                            kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
     346                            local_pf(i,j,k) =  &
     347                               tend(kk,mask_j(mid,j),mask_i(mid,i))
     348                         ENDDO
     349                      ENDDO
     350                   ENDDO
     351                ENDIF
    318352                resorted = .TRUE.
    319353             ELSE
     
    354388                   tend = 0.0_wp
    355389                ENDIF
    356                 DO  i = 1, mask_size_l(mid,1)
    357                    DO  j = 1, mask_size_l(mid,2)
    358                       DO  k = 1, mask_size_l(mid,3)
    359                          local_pf(i,j,k) =  tend(mask_k(mid,k), &
    360                                    mask_j(mid,j),mask_i(mid,i))
    361                       ENDDO
    362                    ENDDO
    363                 ENDDO
     390                IF ( .NOT. mask_surface(mid) )  THEN
     391                   DO  i = 1, mask_size_l(mid,1)
     392                      DO  j = 1, mask_size_l(mid,2)
     393                         DO  k = 1, mask_size_l(mid,3)
     394                            local_pf(i,j,k) =  tend(mask_k(mid,k), &
     395                                      mask_j(mid,j),mask_i(mid,i))
     396                         ENDDO
     397                      ENDDO
     398                   ENDDO
     399                ELSE
     400!
     401!--                Terrain-following masked output
     402                   DO  i = 1, mask_size_l(mid,1)
     403                      DO  j = 1, mask_size_l(mid,2)
     404!
     405!--                      Get k index of highest horizontal surface
     406                         topo_top_ind =  &
     407                            get_topography_top_index_ji( mask_j(mid,j),  &
     408                                                         mask_i(mid,i),  &
     409                                                         grid )
     410                         DO  k = 1, mask_size_l(mid,3)
     411                            kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
     412                            local_pf(i,j,k) =  &
     413                               tend(kk,mask_j(mid,j),mask_i(mid,i))
     414                         ENDDO
     415                      ENDDO
     416                   ENDDO
     417                ENDIF
    364418                resorted = .TRUE.
    365419             ELSE
     
    373427                   to_be_resorted => pt
    374428                ELSE
    375                    DO  i = 1, mask_size_l(mid,1)
    376                       DO  j = 1, mask_size_l(mid,2)
    377                          DO  k = 1, mask_size_l(mid,3)
    378                             local_pf(i,j,k) =  &
    379                                  pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
    380                                  + lv_d_cp * d_exner(mask_k(mid,k)) *          &
    381                                    ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
    382                          ENDDO
    383                       ENDDO
    384                    ENDDO
     429                   IF ( .NOT. mask_surface(mid) )  THEN
     430                      DO  i = 1, mask_size_l(mid,1)
     431                         DO  j = 1, mask_size_l(mid,2)
     432                            DO  k = 1, mask_size_l(mid,3)
     433                               local_pf(i,j,k) =  &
     434                                  pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
     435                                  + lv_d_cp * d_exner(mask_k(mid,k)) *          &
     436                                    ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
     437                            ENDDO
     438                         ENDDO
     439                      ENDDO
     440                   ELSE
     441!
     442!--                   Terrain-following masked output
     443                      DO  i = 1, mask_size_l(mid,1)
     444                         DO  j = 1, mask_size_l(mid,2)
     445!
     446!--                         Get k index of highest horizontal surface
     447                            topo_top_ind =  &
     448                               get_topography_top_index_ji( mask_j(mid,j),  &
     449                                                            mask_i(mid,i),  &
     450                                                            grid )
     451                            DO  k = 1, mask_size_l(mid,3)
     452                               kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
     453                               local_pf(i,j,k) =  &
     454                                    pt(kk,mask_j(mid,j),mask_i(mid,i) ) &
     455                                    + lv_d_cp * d_exner(kk) *           &
     456                                      ql(kk,mask_j(mid,j),mask_i(mid,i))
     457                            ENDDO
     458                         ENDDO
     459                      ENDDO
     460                   ENDIF                   
    385461                   resorted = .TRUE.
    386462                ENDIF
     
    447523                   tend = 0.0_wp
    448524                ENDIF
    449                 DO  i = 1, mask_size_l(mid,1)
    450                    DO  j = 1, mask_size_l(mid,2)
    451                       DO  k = 1, mask_size_l(mid,3)
    452                          local_pf(i,j,k) =  tend(mask_k(mid,k), &
    453                                    mask_j(mid,j),mask_i(mid,i))
    454                       ENDDO
    455                    ENDDO
    456                 ENDDO
     525                IF ( .NOT. mask_surface(mid) )  THEN
     526                   DO  i = 1, mask_size_l(mid,1)
     527                      DO  j = 1, mask_size_l(mid,2)
     528                         DO  k = 1, mask_size_l(mid,3)
     529                            local_pf(i,j,k) =  tend(mask_k(mid,k), &
     530                                      mask_j(mid,j),mask_i(mid,i))
     531                         ENDDO
     532                      ENDDO
     533                   ENDDO
     534                ELSE
     535!
     536!--                Terrain-following masked output
     537                   DO  i = 1, mask_size_l(mid,1)
     538                      DO  j = 1, mask_size_l(mid,2)
     539!
     540!--                      Get k index of highest horizontal surface
     541                         topo_top_ind =  &
     542                            get_topography_top_index_ji( mask_j(mid,j),  &
     543                                                         mask_i(mid,i),  &
     544                                                         grid )
     545                         DO  k = 1, mask_size_l(mid,3)
     546                            kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
     547                            local_pf(i,j,k) =  &
     548                               tend(kk,mask_j(mid,j),mask_i(mid,i))
     549                         ENDDO
     550                      ENDDO
     551                   ENDDO
     552                ENDIF
    457553                resorted = .TRUE.
    458554             ELSE
     
    463559          CASE ( 'qv' )
    464560             IF ( av == 0 )  THEN
    465                 DO  i = 1, mask_size_l(mid,1)
    466                    DO  j = 1, mask_size_l(mid,2)
    467                       DO  k = 1, mask_size_l(mid,3)
    468                          local_pf(i,j,k) =  &
    469                               q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -  &
    470                               ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
    471                       ENDDO
    472                    ENDDO
    473                 ENDDO
     561                IF ( .NOT. mask_surface(mid) )  THEN
     562                   DO  i = 1, mask_size_l(mid,1)
     563                      DO  j = 1, mask_size_l(mid,2)
     564                         DO  k = 1, mask_size_l(mid,3)
     565                            local_pf(i,j,k) =  &
     566                                 q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -  &
     567                                 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
     568                         ENDDO
     569                      ENDDO
     570                   ENDDO
     571                ELSE
     572!
     573!--                Terrain-following masked output
     574                   DO  i = 1, mask_size_l(mid,1)
     575                      DO  j = 1, mask_size_l(mid,2)
     576!
     577!--                      Get k index of highest horizontal surface
     578                         topo_top_ind =  &
     579                            get_topography_top_index_ji( mask_j(mid,j),  &
     580                                                         mask_i(mid,i),  &
     581                                                         grid )
     582                         DO  k = 1, mask_size_l(mid,3)
     583                            kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
     584                            local_pf(i,j,k) =  &
     585                                 q(kk,mask_j(mid,j),mask_i(mid,i)) -  &
     586                                 ql(kk,mask_j(mid,j),mask_i(mid,i))
     587                         ENDDO
     588                      ENDDO
     589                   ENDDO
     590                ENDIF
    474591                resorted = .TRUE.
    475592             ELSE
     
    527644
    528645          CASE ( 'w' )
     646             grid = 'w'
    529647             IF ( av == 0 )  THEN
    530648                to_be_resorted => w
     
    566684!--    Resort the array to be output, if not done above
    567685       IF ( .NOT. resorted )  THEN
    568           DO  i = 1, mask_size_l(mid,1)
    569              DO  j = 1, mask_size_l(mid,2)
    570                 DO  k = 1, mask_size_l(mid,3)
    571                    local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
    572                                       mask_j(mid,j),mask_i(mid,i))
     686          IF ( .NOT. mask_surface(mid) )  THEN
     687!
     688!--          Default masked output
     689             DO  i = 1, mask_size_l(mid,1)
     690                DO  j = 1, mask_size_l(mid,2)
     691                   DO  k = 1, mask_size_l(mid,3)
     692                      local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
     693                                         mask_j(mid,j),mask_i(mid,i))
     694                   ENDDO
    573695                ENDDO
    574696             ENDDO
    575           ENDDO
     697
     698          ELSE
     699!
     700!--          Terrain-following masked output
     701             DO  i = 1, mask_size_l(mid,1)
     702                DO  j = 1, mask_size_l(mid,2)
     703!
     704!--                Get k index of highest horizontal surface
     705                   topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
     706                                                               mask_i(mid,i), &
     707                                                               grid )
     708!
     709!--                Save output array
     710                   DO  k = 1, mask_size_l(mid,3)
     711                      local_pf(i,j,k) = to_be_resorted(                       &
     712                                             MIN( topo_top_ind+mask_k(mid,k), &
     713                                                  nzt+1 ),                    &
     714                                             mask_j(mid,j),                   &
     715                                             mask_i(mid,i)                     )
     716                   ENDDO
     717                ENDDO
     718             ENDDO
     719
     720          ENDIF
    576721       ENDIF
    577722
     
    710855#endif
    711856
     857
    712858 END SUBROUTINE data_output_mask
  • palm/trunk/SOURCE/init_masks.f90

    r3421 r3435  
    2525! -----------------
    2626! $Id$
     27! Add checks for chemistry and radiation model
     28! Set indices for terrain-following masked output
     29!
     30! 3421 2018-10-24 18:39:32Z gronemeier
    2731! Renamed output variables
    2832!
     
    142146        ONLY:  zu, zw
    143147
     148    USE bulk_cloud_model_mod,                                                  &
     149        ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
     150
     151    USE chemistry_model_mod,                                                   &
     152        ONLY:  chem_check_data_output
     153
    144154    USE control_parameters,                                                    &
    145         ONLY:  constant_diffusion, cloud_droplets,                             &
     155        ONLY:  air_chemistry,                                                  &
     156               constant_diffusion, cloud_droplets,                             &
    146157               data_output_masks, data_output_masks_user,                      &
    147158               doav, doav_n, domask, domask_no, dz, dz_stretch_level_start,    &
    148159               humidity, mask, masks, mask_scale, mask_i,                      &
    149160               mask_i_global, mask_j, mask_j_global, mask_k, mask_k_global,    &
    150                mask_loop, mask_size, mask_size_l, mask_start_l, mask_x,        &
     161               mask_k_over_surface,                                            &
     162               mask_loop, mask_size, mask_size_l, mask_start_l,                &
     163               mask_surface, mask_x,                                           &
    151164               mask_x_loop, mask_xyz_dimension, mask_y, mask_y_loop, mask_z,   &
    152165               mask_z_loop, max_masks,  message_string, mid,                   &
    153166               passive_scalar, ocean_mode, varnamelength
    154167
    155 
    156168    USE grid_variables,                                                        &
    157169        ONLY:  dx, dy
     
    162174    USE kinds
    163175
    164     USE bulk_cloud_model_mod,                                                  &
    165         ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
    166 
    167176    USE netcdf_interface,                                                      &
    168177        ONLY:  domask_unit, netcdf_data_format
     
    172181
    173182    USE pegrid
     183
     184    USE radiation_model_mod,                                                   &
     185        ONLY:  radiation, radiation_check_data_output
    174186
    175187    IMPLICIT NONE
     
    181193    CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) ::  do_mask_user !<
    182194
     195    INTEGER(iwp) ::  count        !< counting masking indices along a dimension
    183196    INTEGER(iwp) ::  i            !<
    184197    INTEGER(iwp) ::  ilen         !<
     
    187200    INTEGER(iwp) ::  j            !<
    188201    INTEGER(iwp) ::  k            !<
     202    INTEGER(iwp) ::  m            !< mask index
    189203    INTEGER(iwp) ::  n            !<
    190204    INTEGER(iwp) ::  sender       !<
     
    232246       mask      (mid,2,:) = mask_y(mid,:)
    233247       mask      (mid,3,:) = mask_z(mid,:)
    234        
     248!
     249!--    Flag a mask as terrain following
     250       IF ( mask_k_over_surface(mid,1) /= -1_iwp )  THEN
     251          mask_surface(mid) = .TRUE.
     252       ENDIF
     253
    235254       IF ( mask_x_loop(mid,1) == -1.0_wp  .AND.  mask_x_loop(mid,2) == -1.0_wp&
    236255            .AND.  mask_x_loop(mid,3) == -1.0_wp )  THEN
     
    456475
    457476             CASE DEFAULT
     477             
    458478                CALL user_check_data_output( var, unit )
     479
     480                IF ( unit == 'illegal'  .AND.  air_chemistry                   &
     481                     .AND.  (var(1:3) == 'kc_' .OR. var(1:3) == 'em_') )  THEN
     482                   CALL chem_check_data_output( var, unit, 0, 0, 0 )
     483                ENDIF
     484
     485                IF ( unit == 'illegal' )  THEN
     486                   CALL radiation_check_data_output( var, unit, 0, 0, 0 )
     487                ENDIF
    459488
    460489                IF ( unit == 'illegal' )  THEN
     
    505534       CALL set_mask_locations( 1, dx, 'dx', nx, 'nx', nxl, nxr )
    506535       CALL set_mask_locations( 2, dy, 'dy', ny, 'ny', nys, nyn )
    507        CALL set_mask_locations( 3, dz(1), 'dz', nz, 'nz', nzb, nzt )
     536       IF ( .NOT. mask_surface(mid) )  THEN
     537          CALL set_mask_locations( 3, dz(1), 'dz', nz, 'nz', nzb, nzt )
     538       ELSE
     539!
     540!--       Set vertical mask locations and size in case of terrain-following
     541!--       output
     542          count = 0
     543          DO  WHILE ( mask_k_over_surface(mid, count+1) >= 0 )
     544             m = mask_k_over_surface(mid, count+1)
     545             IF ( m > nz+1 )  THEN
     546                WRITE ( message_string, '(I3,A,I3,A,I1,3A,I3)' )               &
     547                     m,' in mask ',mid,' along dimension ', 3,                 &
     548                     ' exceeds (nz+1) = ',nz+1
     549                CALL message( 'init_masks', 'PA0331', 1, 2, 0, 6, 0 )
     550             ENDIF
     551             count = count + 1
     552             mask_k(mid,count) = mask_k_over_surface(mid, count)
     553             IF ( count == mask_xyz_dimension )  EXIT
     554          ENDDO
     555          mask_start_l(mid,3) = 1
     556          mask_size(mid,3)    = count
     557          mask_size_l(mid,3)  = count
     558       ENDIF
    508559!
    509560!--    Set global masks along all three dimensions (required by
  • palm/trunk/SOURCE/modules.f90

    r3422 r3435  
    2525! -----------------
    2626! $Id$
     27! +mask_k_over_surface, mask_surface
     28!
     29! 3422 2018-10-24 19:01:57Z gronemeier
    2730! bugfix: increase number of blanks in output string
    2831!
     
    12831286    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_j_global  !< global grid index of masked output point on y-dimension
    12841287    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  mask_k_global  !< global grid index of masked output point on z-dimension
     1288
     1289    INTEGER(iwp), DIMENSION(max_masks,mask_xyz_dimension) ::  mask_k_over_surface = -1  !< namelist parameter, k index of height over surface
    12851290
    12861291    LOGICAL ::  agent_time_unlimited = .FALSE.                   !< namelist parameter
     
    13931398    LOGICAL ::  data_output_xz(0:1) = .FALSE.                !< output of xz cross-section data?
    13941399    LOGICAL ::  data_output_yz(0:1) = .FALSE.                !< output of yz cross-section data?
     1400
     1401    LOGICAL, DIMENSION(max_masks) ::  mask_surface = .FALSE.      !< flag for surface-following masked output
    13951402
    13961403    REAL(wp) ::  advected_distance_x = 0.0_wp                  !< advected distance of model domain along x
  • palm/trunk/SOURCE/netcdf_interface_mod.f90

    r3421 r3435  
    2525! -----------------
    2626! $Id$
     27! Bugfix: corrected order of calls to define_netcdf_grid for masked output
     28! Add vertical dimensions to masked output in case of terrain-following output
     29!
     30! 3421 2018-10-24 18:39:32Z gronemeier
    2731! Bugfix: move ocean output variables to ocean_mod
    2832! Renamed output variables
     
    589593               do3d_time_count, domask_time_count, end_time, land_surface,     &
    590594               mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global,      &
    591                mask_k_global, message_string, mid, ntdim_2d_xy, ntdim_2d_xz,   &
     595               mask_k_global, mask_surface,                                    &
     596               message_string, mid, ntdim_2d_xy, ntdim_2d_xz,                  &
    592597               ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy,       &
    593598               run_description_header, section, simulated_time,                &
     
    873878!
    874879!--       Define spatial dimensions and coordinates:
    875 !--       Define vertical coordinate grid (zu grid)
    876           CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d',                &
    877                                   mask_size(mid,3), id_dim_zu_mask(mid,av),    &
    878                                   470 )
    879           CALL netcdf_create_var( id_set_mask(mid,av),                         &
    880                                   (/ id_dim_zu_mask(mid,av) /), 'zu_3d',       &
    881                                   NF90_DOUBLE, id_var_zu_mask(mid,av),         &
    882                                   'meters', '', 471, 472, 000 )
    883 !
    884 !--       Define vertical coordinate grid (zw grid)
    885           CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d',                &
    886                                   mask_size(mid,3), id_dim_zw_mask(mid,av),    &
    887                                   473 )
    888           CALL netcdf_create_var( id_set_mask(mid,av),                         &
    889                                   (/ id_dim_zw_mask(mid,av) /), 'zw_3d',       &
    890                                   NF90_DOUBLE, id_var_zw_mask(mid,av),         &
    891                                  'meters', '', 474, 475, 000 )
     880          IF ( mask_surface(mid) )  THEN
     881!
     882!--          In case of terrain-following output, the vertical dimensions are
     883!--          indices, not meters
     884             CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf',     &
     885                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
     886                                     470 )
     887             CALL netcdf_create_var( id_set_mask(mid,av),                      &
     888                                     (/ id_dim_zu_mask(mid,av) /),             &
     889                                     'ku_above_surf',                          &
     890                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
     891                                     '1', 'grid point above terrain',          &
     892                                     471, 472, 000 )
     893             CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf',     &
     894                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
     895                                     473 )
     896             CALL netcdf_create_var( id_set_mask(mid,av),                      &
     897                                     (/ id_dim_zw_mask(mid,av) /),             &
     898                                     'kw_above_surf',                          &
     899                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
     900                                    '1', 'grid point above terrain',           &
     901                                    474, 475, 000 )
     902          ELSE
     903!
     904!--          Define vertical coordinate grid (zu grid)
     905             CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d',             &
     906                                     mask_size(mid,3), id_dim_zu_mask(mid,av), &
     907                                     470 )
     908             CALL netcdf_create_var( id_set_mask(mid,av),                      &
     909                                     (/ id_dim_zu_mask(mid,av) /), 'zu_3d',    &
     910                                     NF90_DOUBLE, id_var_zu_mask(mid,av),      &
     911                                     'meters', '', 471, 472, 000 )
     912!
     913!--          Define vertical coordinate grid (zw grid)
     914             CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d',             &
     915                                     mask_size(mid,3), id_dim_zw_mask(mid,av), &
     916                                     473 )
     917             CALL netcdf_create_var( id_set_mask(mid,av),                      &
     918                                     (/ id_dim_zw_mask(mid,av) /), 'zw_3d',    &
     919                                     NF90_DOUBLE, id_var_zw_mask(mid,av),      &
     920                                    'meters', '', 474, 475, 000 )
     921          ENDIF
    892922!
    893923!--       Define x-axis (for scalar position)
     
    10681098!
    10691099!--                Check for quantities defined in other modules
     1100                   CALL tcm_define_netcdf_grid( domask( mid,av,i), found,      &
     1101                                                        grid_x, grid_y, grid_z )
     1102
    10701103                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
    10711104                      CALL chem_define_netcdf_grid( domask(mid,av,i), found,   &
     
    11051138                                                         grid_z )
    11061139                   ENDIF
    1107 
    1108                    CALL tcm_define_netcdf_grid( domask( mid,av,i), found,      &
    1109                                                         grid_x, grid_y, grid_z )
    1110 
    11111140!
    11121141!--                Now check for user-defined quantities
     
    13431372          ALLOCATE( netcdf_data(mask_size(mid,3)) )
    13441373
    1345           netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) )
    1346 
    1347           nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
    1348                                   netcdf_data, start = (/ 1 /), &
    1349                                   count = (/ mask_size(mid,3) /) )
    1350           CALL netcdf_handle_error( 'netcdf_define_header', 503 )
    1351 
    1352           netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) )
    1353 
    1354           nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
    1355                                   netcdf_data, start = (/ 1 /), &
    1356                                   count = (/ mask_size(mid,3) /) )
    1357           CALL netcdf_handle_error( 'netcdf_define_header', 504 )
     1374          IF ( mask_surface(mid) )  THEN
     1375
     1376             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
     1377
     1378             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
     1379                                     netcdf_data, start = (/ 1 /), &
     1380                                     count = (/ mask_size(mid,3) /) )
     1381             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
     1382
     1383             netcdf_data = mask_k_global(mid,:mask_size(mid,3))
     1384
     1385             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
     1386                                     netcdf_data, start = (/ 1 /), &
     1387                                     count = (/ mask_size(mid,3) /) )
     1388             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
     1389
     1390          ELSE
     1391
     1392             netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) )
     1393
     1394             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &
     1395                                     netcdf_data, start = (/ 1 /), &
     1396                                     count = (/ mask_size(mid,3) /) )
     1397             CALL netcdf_handle_error( 'netcdf_define_header', 503 )
     1398
     1399             netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) )
     1400
     1401             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &
     1402                                     netcdf_data, start = (/ 1 /), &
     1403                                     count = (/ mask_size(mid,3) /) )
     1404             CALL netcdf_handle_error( 'netcdf_define_header', 504 )
     1405
     1406          ENDIF
    13581407
    13591408          DEALLOCATE( netcdf_data )
  • palm/trunk/SOURCE/parin.f90

    r3421 r3435  
    2525! -----------------
    2626! $Id$
     27! Add mask_k_over_surface
     28!
     29! 3421 2018-10-24 18:39:32Z gronemeier
    2730! Added module for data output at surfaces
    2831!
     
    698701             dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy,         &
    699702             dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart,              &
    700              dt_run_control,end_time, force_print_header, mask_scale_x,        &
     703             dt_run_control,end_time, force_print_header, mask_k_over_surface, &
     704             mask_scale_x,        &
    701705             mask_scale_y, mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop,  &
    702706             mask_y_loop, mask_z_loop, netcdf_data_format, netcdf_deflate,     &
     
    719723             dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy,         &
    720724             dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart,              &
    721              dt_run_control,end_time, force_print_header, mask_scale_x,        &
     725             dt_run_control,end_time, force_print_header, mask_k_over_surface, &
     726             mask_scale_x,        &
    722727             mask_scale_y, mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop,  &
    723728             mask_y_loop, mask_z_loop, netcdf_data_format, netcdf_deflate,     &
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r3424 r3435  
    2828! -----------------
    2929! $Id$
     30! - workaround: return unit=illegal in check_data_output for certain variables
     31!   when check called from init_masks
     32! - Use pointer in masked output to reduce code redundancies
     33! - Add terrain-following masked output
     34!
     35! 3424 2018-10-25 07:29:10Z gronemeier
    3036! bugfix: add rad_lw_in, rad_lw_out, rad_sw_out to radiation_check_data_output
    3137!
     
    12501256                 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*',     &
    12511257                 'rad_sw_out*')
     1258             IF ( i == 0 .AND. ilen == 0 .AND. k == 0)  THEN
     1259                ! Workaround for masked output (calls with i=ilen=k=0)
     1260                unit = 'illegal'
     1261                RETURN
     1262             ENDIF
    12521263             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
    12531264                message_string = 'illegal value for data_output: "' //         &
     
    12811292
    12821293          CASE ( 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw'  )
     1294
     1295             IF ( i == 0 .AND. ilen == 0 .AND. k == 0)  THEN
     1296                ! Workaround for masked output (calls with i=ilen=k=0)
     1297                unit = 'illegal'
     1298                RETURN
     1299             ENDIF
     1300
    12831301             IF ( .NOT.  radiation ) THEN
    12841302                message_string = 'output of "' // TRIM( var ) // '" require'&
     
    88908908    found  = .TRUE.
    88918909
    8892 
    88938910!
    88948911!-- Check for the grid
     
    96349651    CHARACTER (LEN=*) ::  variable   !<
    96359652
    9636     INTEGER(iwp) ::  av   !<
    9637     INTEGER(iwp) ::  i    !<
    9638     INTEGER(iwp) ::  j    !<
    9639     INTEGER(iwp) ::  k    !<
    9640 
    9641     LOGICAL ::  found     !<
     9653    CHARACTER(LEN=5) ::  grid        !< flag to distinquish between staggered grids
     9654
     9655    INTEGER(iwp) ::  av              !<
     9656    INTEGER(iwp) ::  i               !<
     9657    INTEGER(iwp) ::  j               !<
     9658    INTEGER(iwp) ::  k               !<
     9659    INTEGER(iwp) ::  topo_top_ind    !< k index of highest horizontal surface
     9660
     9661    LOGICAL ::  found                !< true if output array was found
     9662    LOGICAL ::  resorted             !< true if array is resorted
     9663
    96429664
    96439665    REAL(wp),                                                                  &
     
    96459667          local_pf   !<
    96469668
    9647 
    9648     found = .TRUE.
     9669    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which needs to be resorted for output
     9670
     9671
     9672    found    = .TRUE.
     9673    grid     = 's'
     9674    resorted = .FALSE.
    96499675
    96509676    SELECT CASE ( TRIM( variable ) )
     
    96539679       CASE ( 'rad_lw_in' )
    96549680          IF ( av == 0 )  THEN
    9655              DO  i = 1, mask_size_l(mid,1)
    9656                 DO  j = 1, mask_size_l(mid,2)
    9657                    DO  k = 1, mask_size_l(mid,3)
    9658                        local_pf(i,j,k) = rad_lw_in(mask_k(mid,k),              &
    9659                                             mask_j(mid,j),mask_i(mid,i))
    9660                     ENDDO
    9661                  ENDDO
    9662               ENDDO
     9681             to_be_resorted => rad_lw_in
    96639682          ELSE
    9664              DO  i = 1, mask_size_l(mid,1)
    9665                 DO  j = 1, mask_size_l(mid,2)
    9666                    DO  k = 1, mask_size_l(mid,3)
    9667                        local_pf(i,j,k) = rad_lw_in_av(mask_k(mid,k),           &
    9668                                                mask_j(mid,j),mask_i(mid,i))
    9669                    ENDDO
     9683             to_be_resorted => rad_lw_in_av
     9684          ENDIF
     9685
     9686       CASE ( 'rad_lw_out' )
     9687          IF ( av == 0 )  THEN
     9688             to_be_resorted => rad_lw_out
     9689          ELSE
     9690             to_be_resorted => rad_lw_out_av
     9691          ENDIF
     9692
     9693       CASE ( 'rad_lw_cs_hr' )
     9694          IF ( av == 0 )  THEN
     9695             to_be_resorted => rad_lw_cs_hr
     9696          ELSE
     9697             to_be_resorted => rad_lw_cs_hr_av
     9698          ENDIF
     9699
     9700       CASE ( 'rad_lw_hr' )
     9701          IF ( av == 0 )  THEN
     9702             to_be_resorted => rad_lw_hr
     9703          ELSE
     9704             to_be_resorted => rad_lw_hr_av
     9705          ENDIF
     9706
     9707       CASE ( 'rad_sw_in' )
     9708          IF ( av == 0 )  THEN
     9709             to_be_resorted => rad_sw_in
     9710          ELSE
     9711             to_be_resorted => rad_sw_in_av
     9712          ENDIF
     9713
     9714       CASE ( 'rad_sw_out' )
     9715          IF ( av == 0 )  THEN
     9716             to_be_resorted => rad_sw_out
     9717          ELSE
     9718             to_be_resorted => rad_sw_out_av
     9719          ENDIF
     9720
     9721       CASE ( 'rad_sw_cs_hr' )
     9722          IF ( av == 0 )  THEN
     9723             to_be_resorted => rad_sw_cs_hr
     9724          ELSE
     9725             to_be_resorted => rad_sw_cs_hr_av
     9726          ENDIF
     9727
     9728       CASE ( 'rad_sw_hr' )
     9729          IF ( av == 0 )  THEN
     9730             to_be_resorted => rad_sw_hr
     9731          ELSE
     9732             to_be_resorted => rad_sw_hr_av
     9733          ENDIF
     9734
     9735       CASE DEFAULT
     9736          found = .FALSE.
     9737
     9738    END SELECT
     9739
     9740!
     9741!-- Resort the array to be output, if not done above
     9742    IF ( .NOT. resorted )  THEN
     9743       IF ( .NOT. mask_surface(mid) )  THEN
     9744!
     9745!--       Default masked output
     9746          DO  i = 1, mask_size_l(mid,1)
     9747             DO  j = 1, mask_size_l(mid,2)
     9748                DO  k = 1, mask_size_l(mid,3)
     9749                   local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
     9750                                      mask_j(mid,j),mask_i(mid,i))
    96709751                ENDDO
    96719752             ENDDO
    9672           ENDIF
    9673 
    9674        CASE ( 'rad_lw_out' )
    9675           IF ( av == 0 )  THEN
    9676              DO  i = 1, mask_size_l(mid,1)
    9677                 DO  j = 1, mask_size_l(mid,2)
    9678                    DO  k = 1, mask_size_l(mid,3)
    9679                        local_pf(i,j,k) = rad_lw_out(mask_k(mid,k),             &
    9680                                             mask_j(mid,j),mask_i(mid,i))
    9681                     ENDDO
    9682                  ENDDO
    9683               ENDDO
    9684           ELSE
    9685              DO  i = 1, mask_size_l(mid,1)
    9686                 DO  j = 1, mask_size_l(mid,2)
    9687                    DO  k = 1, mask_size_l(mid,3)
    9688                        local_pf(i,j,k) = rad_lw_out_av(mask_k(mid,k),          &
    9689                                                mask_j(mid,j),mask_i(mid,i))
    9690                    ENDDO
     9753          ENDDO
     9754
     9755       ELSE
     9756!
     9757!--       Terrain-following masked output
     9758          DO  i = 1, mask_size_l(mid,1)
     9759             DO  j = 1, mask_size_l(mid,2)
     9760!
     9761!--             Get k index of highest horizontal surface
     9762                topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
     9763                                                            mask_i(mid,i), &
     9764                                                            grid )
     9765!
     9766!--             Save output array
     9767                DO  k = 1, mask_size_l(mid,3)
     9768                   local_pf(i,j,k) = to_be_resorted(                       &
     9769                                          MIN( topo_top_ind+mask_k(mid,k), &
     9770                                               nzt+1 ),                    &
     9771                                          mask_j(mid,j),                   &
     9772                                          mask_i(mid,i)                     )
    96919773                ENDDO
    96929774             ENDDO
    9693           ENDIF
    9694 
    9695        CASE ( 'rad_lw_cs_hr' )
    9696           IF ( av == 0 )  THEN
    9697              DO  i = 1, mask_size_l(mid,1)
    9698                 DO  j = 1, mask_size_l(mid,2)
    9699                    DO  k = 1, mask_size_l(mid,3)
    9700                        local_pf(i,j,k) = rad_lw_cs_hr(mask_k(mid,k),           &
    9701                                             mask_j(mid,j),mask_i(mid,i))
    9702                     ENDDO
    9703                  ENDDO
    9704               ENDDO
    9705           ELSE
    9706              DO  i = 1, mask_size_l(mid,1)
    9707                 DO  j = 1, mask_size_l(mid,2)
    9708                    DO  k = 1, mask_size_l(mid,3)
    9709                        local_pf(i,j,k) = rad_lw_cs_hr_av(mask_k(mid,k),        &
    9710                                                mask_j(mid,j),mask_i(mid,i))
    9711                    ENDDO
    9712                 ENDDO
    9713              ENDDO
    9714           ENDIF
    9715 
    9716        CASE ( 'rad_lw_hr' )
    9717           IF ( av == 0 )  THEN
    9718              DO  i = 1, mask_size_l(mid,1)
    9719                 DO  j = 1, mask_size_l(mid,2)
    9720                    DO  k = 1, mask_size_l(mid,3)
    9721                        local_pf(i,j,k) = rad_lw_hr(mask_k(mid,k),              &
    9722                                             mask_j(mid,j),mask_i(mid,i))
    9723                     ENDDO
    9724                  ENDDO
    9725               ENDDO
    9726           ELSE
    9727              DO  i = 1, mask_size_l(mid,1)
    9728                 DO  j = 1, mask_size_l(mid,2)
    9729                    DO  k = 1, mask_size_l(mid,3)
    9730                        local_pf(i,j,k) = rad_lw_hr_av(mask_k(mid,k),           &
    9731                                                mask_j(mid,j),mask_i(mid,i))
    9732                    ENDDO
    9733                 ENDDO
    9734              ENDDO
    9735           ENDIF
    9736 
    9737        CASE ( 'rad_sw_in' )
    9738           IF ( av == 0 )  THEN
    9739              DO  i = 1, mask_size_l(mid,1)
    9740                 DO  j = 1, mask_size_l(mid,2)
    9741                    DO  k = 1, mask_size_l(mid,3)
    9742                        local_pf(i,j,k) = rad_sw_in(mask_k(mid,k),              &
    9743                                             mask_j(mid,j),mask_i(mid,i))
    9744                     ENDDO
    9745                  ENDDO
    9746               ENDDO
    9747           ELSE
    9748              DO  i = 1, mask_size_l(mid,1)
    9749                 DO  j = 1, mask_size_l(mid,2)
    9750                    DO  k = 1, mask_size_l(mid,3)
    9751                        local_pf(i,j,k) = rad_sw_in_av(mask_k(mid,k),           &
    9752                                                mask_j(mid,j),mask_i(mid,i))
    9753                    ENDDO
    9754                 ENDDO
    9755              ENDDO
    9756           ENDIF
    9757 
    9758        CASE ( 'rad_sw_out' )
    9759           IF ( av == 0 )  THEN
    9760              DO  i = 1, mask_size_l(mid,1)
    9761                 DO  j = 1, mask_size_l(mid,2)
    9762                    DO  k = 1, mask_size_l(mid,3)
    9763                        local_pf(i,j,k) = rad_sw_out(mask_k(mid,k),             &
    9764                                             mask_j(mid,j),mask_i(mid,i))
    9765                     ENDDO
    9766                  ENDDO
    9767               ENDDO
    9768           ELSE
    9769              DO  i = 1, mask_size_l(mid,1)
    9770                 DO  j = 1, mask_size_l(mid,2)
    9771                    DO  k = 1, mask_size_l(mid,3)
    9772                        local_pf(i,j,k) = rad_sw_out_av(mask_k(mid,k),          &
    9773                                                mask_j(mid,j),mask_i(mid,i))
    9774                    ENDDO
    9775                 ENDDO
    9776              ENDDO
    9777           ENDIF
    9778 
    9779        CASE ( 'rad_sw_cs_hr' )
    9780           IF ( av == 0 )  THEN
    9781              DO  i = 1, mask_size_l(mid,1)
    9782                 DO  j = 1, mask_size_l(mid,2)
    9783                    DO  k = 1, mask_size_l(mid,3)
    9784                        local_pf(i,j,k) = rad_sw_cs_hr(mask_k(mid,k),           &
    9785                                             mask_j(mid,j),mask_i(mid,i))
    9786                     ENDDO
    9787                  ENDDO
    9788               ENDDO
    9789           ELSE
    9790              DO  i = 1, mask_size_l(mid,1)
    9791                 DO  j = 1, mask_size_l(mid,2)
    9792                    DO  k = 1, mask_size_l(mid,3)
    9793                        local_pf(i,j,k) = rad_sw_cs_hr_av(mask_k(mid,k),        &
    9794                                                mask_j(mid,j),mask_i(mid,i))
    9795                    ENDDO
    9796                 ENDDO
    9797              ENDDO
    9798           ENDIF
    9799 
    9800        CASE ( 'rad_sw_hr' )
    9801           IF ( av == 0 )  THEN
    9802              DO  i = 1, mask_size_l(mid,1)
    9803                 DO  j = 1, mask_size_l(mid,2)
    9804                    DO  k = 1, mask_size_l(mid,3)
    9805                        local_pf(i,j,k) = rad_sw_hr(mask_k(mid,k),              &
    9806                                             mask_j(mid,j),mask_i(mid,i))
    9807                     ENDDO
    9808                  ENDDO
    9809               ENDDO
    9810           ELSE
    9811              DO  i = 1, mask_size_l(mid,1)
    9812                 DO  j = 1, mask_size_l(mid,2)
    9813                    DO  k = 1, mask_size_l(mid,3)
    9814                        local_pf(i,j,k) = rad_sw_hr_av(mask_k(mid,k),           &
    9815                                                mask_j(mid,j),mask_i(mid,i))
    9816                    ENDDO
    9817                 ENDDO
    9818              ENDDO
    9819           ENDIF
    9820 
    9821        CASE DEFAULT
    9822           found = .FALSE.
    9823 
    9824     END SELECT
     9775          ENDDO
     9776
     9777       ENDIF
     9778    ENDIF
     9779
    98259780
    98269781
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3418 r3435  
    2828! -----------------
    2929! $Id$
     30! Bugfix: allocate gamma_w_green_sat until nzt_wall+1
     31!
     32! 3418 2018-10-24 16:07:39Z kanani
    3033! (rvtils, srissman)
    3134! -Updated building databse, two green roof types (ind_green_type_roof)
     
    13761379        ALLOCATE ( surf_usm_h%alpha_vg_green(1:surf_usm_h%ns)     )
    13771380        ALLOCATE ( surf_usm_h%l_vg_green(1:surf_usm_h%ns)     )
    1378         ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
     1381        ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
    13791382        ALLOCATE ( surf_usm_h%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
    13801383        ALLOCATE ( surf_usm_h%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
  • palm/trunk/SOURCE/user_data_output_mask.f90

    r2718 r3435  
    2525! -----------------
    2626! $Id$
     27! Add terrain-following output
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
     
    6265    USE kinds
    6366   
     67    USE surface_mod,                                                           &
     68        ONLY:  get_topography_top_index_ji
     69   
    6470    USE user
    6571
    6672    IMPLICIT NONE
    6773
    68     CHARACTER (LEN=*) ::  variable   !<
     74    CHARACTER (LEN=*) ::  variable  !<
     75    CHARACTER (LEN=5) ::  grid      !< flag to distinquish between staggered grids
    6976
    70     INTEGER(iwp) ::  av   !<
    71     INTEGER(iwp) ::  i    !<
    72     INTEGER(iwp) ::  j    !<
    73     INTEGER(iwp) ::  k    !<
     77    INTEGER(iwp) ::  av             !<
     78    INTEGER(iwp) ::  i              !<
     79    INTEGER(iwp) ::  j              !<
     80    INTEGER(iwp) ::  k              !<
     81    INTEGER(iwp) ::  topo_top_ind   !< k index of highest horizontal surface
    7482
    75     LOGICAL ::  found     !<
     83    LOGICAL ::  found               !<
    7684
    7785    REAL(wp),                                                                  &
     
    8189
    8290    found = .TRUE.
     91    grid  = 's'
    8392
    8493    SELECT CASE ( TRIM( variable ) )
     
    9099!       CASE ( 'u2' )
    91100!          IF ( av == 0 )  THEN
    92 !            DO  i = 1, mask_size_l(mid,1)
    93 !               DO  j = 1, mask_size_l(mid,2)
    94 !                  DO  k = 1, mask_size_l(mid,3)
    95 !                      local_pf(i,j,k) = u2(mask_k(mid,k),                       &
    96 !                                           mask_j(mid,j),mask_i(mid,i))
     101!             IF ( .NOT. mask_surface(mid) )  THEN
     102!!
     103!!--             Default masked output
     104!                DO  i = 1, mask_size_l(mid,1)
     105!                   DO  j = 1, mask_size_l(mid,2)
     106!                      DO  k = 1, mask_size_l(mid,3)
     107!                         local_pf(i,j,k) = u2(mask_k(mid,k),                  &
     108!                                              mask_j(mid,j),                  &
     109!                                              mask_i(mid,i))
     110!                      ENDDO
    97111!                   ENDDO
    98112!                ENDDO
    99 !             ENDDO
    100 !          ELSE
    101 !            DO  i = 1, mask_size_l(mid,1)
    102 !               DO  j = 1, mask_size_l(mid,2)
    103 !                  DO  k = 1, mask_size_l(mid,3)
    104 !                      local_pf(i,j,k) = u2_av(mask_k(mid,k),                    &
    105 !                                              mask_j(mid,j),mask_i(mid,i))
     113!             ELSE
     114!!
     115!!--             Terrain-following masked output
     116!                DO  i = 1, mask_size_l(mid,1)
     117!                   DO  j = 1, mask_size_l(mid,2)
     118!!
     119!!--                   Get k index of highest horizontal surface
     120!                      topo_top_ind = get_topography_top_index_ji( &
     121!                                        mask_j(mid,j), &
     122!                                        mask_i(mid,i), &
     123!                                        grid )
     124!!
     125!!--                   Save output array
     126!                      DO  k = 1, mask_size_l(mid,3)
     127!                         local_pf(i,j,k) = u2(MIN( topo_top_ind+mask_k(mid,k),&
     128!                                                   nzt+1 ),                   &
     129!                                              mask_j(mid,j),                  &
     130!                                              mask_i(mid,i)                   )
     131!                      ENDDO
    106132!                   ENDDO
    107133!                ENDDO
    108 !             ENDDO
     134!             ENDIF
     135!          ELSE
     136!             IF ( .NOT. mask_surface(mid) )  THEN
     137!!
     138!!--             Default masked output
     139!                DO  i = 1, mask_size_l(mid,1)
     140!                   DO  j = 1, mask_size_l(mid,2)
     141!                      DO  k = 1, mask_size_l(mid,3)
     142!                          local_pf(i,j,k) = u2_av(mask_k(mid,k),              &
     143!                                                  mask_j(mid,j),              &
     144!                                                  mask_i(mid,i) )
     145!                       ENDDO
     146!                    ENDDO
     147!                 ENDDO
     148!             ELSE
     149!!
     150!!--             Terrain-following masked output
     151!                DO  i = 1, mask_size_l(mid,1)
     152!                   DO  j = 1, mask_size_l(mid,2)
     153!!
     154!!--                   Get k index of highest horizontal surface
     155!                      topo_top_ind = get_topography_top_index_ji( &
     156!                                        mask_j(mid,j), &
     157!                                        mask_i(mid,i), &
     158!                                        grid )
     159!!
     160!!--                   Save output array
     161!                      DO  k = 1, mask_size_l(mid,3)
     162!                         local_pf(i,j,k) = u2_av(                             &
     163!                                              MIN( topo_top_ind+mask_k(mid,k),&
     164!                                                   nzt+1 ),                   &
     165!                                              mask_j(mid,j),                  &
     166!                                              mask_i(mid,i)                   )
     167!                      ENDDO
     168!                   ENDDO
     169!                ENDDO
     170!             ENDIF
    109171!          ENDIF
    110172
Note: See TracChangeset for help on using the changeset viewer.