Changeset 4167 for palm/trunk/SOURCE


Ignore:
Timestamp:
Aug 16, 2019 11:01:48 AM (5 years ago)
Author:
suehring
Message:

Merge from branch resler: Changed behaviour of masked output over surface to follow terrain and ignore buildings

Location:
palm/trunk/SOURCE
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE

  • palm/trunk/SOURCE/Makefile

    r4127 r4167  
    2525# -----------------
    2626# $Id$
     27# Remove no longer needed dependencies on surface_mod
     28#
     29#
     30# 4127 2019-07-30 14:47:10Z suehring
    2731# Add dependency of data_output_3d on plant_canopy_model_mod
    2832# (merge from branch resler)
     
    930934        modules.o \
    931935        netcdf_interface_mod.o \
    932         salsa_mod.o \
    933         surface_mod.o
     936        salsa_mod.o
    934937data_output_netcdf4_module.o: \
    935938        mod_kinds.o
     
    987990diagnostic_output_quantities_mod.o: \
    988991        mod_kinds.o \
    989         modules.o \
    990         surface_mod.o
     992        modules.o
    991993diffusion_s.o: \
    992994        mod_kinds.o \
     
    16421644        mod_kinds.o \
    16431645        modules.o \
    1644         surface_mod.o \
    16451646        user_module.o
    16461647user_flight.o: \
  • palm/trunk/SOURCE/data_output_mask.f90

    r4069 r4167  
    2525! -----------------
    2626! $Id$
     27! Changed behaviour of masked output over surface to follow terrain and ignore
     28! buildings (J.Resler, T.Gronemeier)
     29!
     30! 4069 2019-07-01 14:05:51Z Giersch
    2731! Masked output running index mid has been introduced as a local variable to
    2832! avoid runtime error (Loop variable has been modified) in time_integration
     
    194198
    195199    USE indices,                                                               &
    196         ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
     200        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
    197201
    198202    USE kinds
     
    204208   
    205209    USE netcdf_interface,                                                      &
    206         ONLY:  id_set_mask, id_var_domask, id_var_time_mask, nc_stat,          &
    207                netcdf_data_format, netcdf_handle_error
     210        ONLY:  fill_value, id_set_mask, id_var_domask, id_var_time_mask,       &
     211               nc_stat, netcdf_data_format, netcdf_handle_error
    208212   
    209213    USE particle_attributes,                                                   &
     
    218222    USE salsa_mod,                                                             &
    219223        ONLY:  salsa_data_output_mask     
    220        
    221     USE surface_mod,                                                           &
    222         ONLY :  get_topography_top_index_ji
     224
    223225
    224226    IMPLICIT NONE
     
    232234    INTEGER(iwp) ::  j                       !< loop index
    233235    INTEGER(iwp) ::  k                       !< loop index
     236    INTEGER(iwp) ::  im                      !< loop index for masked variables
     237    INTEGER(iwp) ::  jm                      !< loop index for masked variables
    234238    INTEGER(iwp) ::  kk                      !< vertical index
    235239    INTEGER(iwp) ::  mid                     !< masked output running index
     
    237241    INTEGER(iwp) ::  netcdf_data_format_save !< value of netcdf_data_format
    238242    INTEGER(iwp) ::  sender                  !< PE id of sending PE
    239     INTEGER(iwp) ::  topo_top_ind            !< k index of highest horizontal surface
     243    INTEGER(iwp) ::  ktt                     !< k index of highest terrain surface
    240244    INTEGER(iwp) ::  ind(6)                  !< index limits (lower/upper bounds) of array 'local_2d'
    241245
     
    309313       grid = 's'
    310314!
    311 !--    Set flag to steer output of radiation, land-surface, or user-defined
    312 !--    quantities
    313        found = .FALSE.
    314 !
    315315!--    Store the variable chosen.
    316316       resorted = .FALSE.
     
    370370                   DO  i = 1, mask_size_l(mid,1)
    371371                      DO  j = 1, mask_size_l(mid,2)
    372 !
    373 !--                      Get k index of highest horizontal surface
    374                          topo_top_ind =  &
    375                             get_topography_top_index_ji( mask_j(mid,j),  &
    376                                                          mask_i(mid,i),  &
    377                                                          grid )
     372!--                      Get k index of the highest terraing surface
     373                         im = mask_i(mid,i)
     374                         jm = mask_j(mid,j)
     375                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    378376                         DO  k = 1, mask_size_l(mid,3)
    379                             kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
    380                             local_pf(i,j,k) =  &
    381                                tend(kk,mask_j(mid,j),mask_i(mid,i))
     377                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     378!--                         Set value if not in building
     379                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     380                               local_pf(i,j,k) = fill_value
     381                            ELSE
     382                               local_pf(i,j,k) =  tend(kk,jm,im)
     383                            ENDIF
    382384                         ENDDO
    383385                      ENDDO
     
    436438                   DO  i = 1, mask_size_l(mid,1)
    437439                      DO  j = 1, mask_size_l(mid,2)
    438 !
    439 !--                      Get k index of highest horizontal surface
    440                          topo_top_ind =  &
    441                             get_topography_top_index_ji( mask_j(mid,j),  &
    442                                                          mask_i(mid,i),  &
    443                                                          grid )
     440!--                      Get k index of the highest terraing surface
     441                         im = mask_i(mid,i)
     442                         jm = mask_j(mid,j)
     443                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    444444                         DO  k = 1, mask_size_l(mid,3)
    445                             kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
    446                             local_pf(i,j,k) =  &
    447                                tend(kk,mask_j(mid,j),mask_i(mid,i))
     445                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     446!--                         Set value if not in building
     447                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     448                               local_pf(i,j,k) = fill_value
     449                            ELSE
     450                               local_pf(i,j,k) =  tend(kk,jm,im)
     451                            ENDIF
    448452                         ENDDO
    449453                      ENDDO
     
    477481                      DO  i = 1, mask_size_l(mid,1)
    478482                         DO  j = 1, mask_size_l(mid,2)
    479 !
    480 !--                         Get k index of highest horizontal surface
    481                             topo_top_ind =  &
    482                                get_topography_top_index_ji( mask_j(mid,j),  &
    483                                                             mask_i(mid,i),  &
    484                                                             grid )
     483!--                         Get k index of the highest terraing surface
     484                            im = mask_i(mid,i)
     485                            jm = mask_j(mid,j)
     486                            ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    485487                            DO  k = 1, mask_size_l(mid,3)
    486                                kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
    487                                local_pf(i,j,k) =  &
    488                                     pt(kk,mask_j(mid,j),mask_i(mid,i) ) &
    489                                     + lv_d_cp * d_exner(kk) *           &
    490                                       ql(kk,mask_j(mid,j),mask_i(mid,i))
     488                               kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     489!--                            Set value if not in building
     490                               IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     491                                  local_pf(i,j,k) = fill_value
     492                               ELSE
     493                                  local_pf(i,j,k) = pt(kk,jm,im) + lv_d_cp * d_exner(kk) * ql(kk,jm,im)
     494                               ENDIF
    491495                            ENDDO
    492496                         ENDDO
     
    571575                   DO  i = 1, mask_size_l(mid,1)
    572576                      DO  j = 1, mask_size_l(mid,2)
    573 !
    574 !--                      Get k index of highest horizontal surface
    575                          topo_top_ind =  &
    576                             get_topography_top_index_ji( mask_j(mid,j),  &
    577                                                          mask_i(mid,i),  &
    578                                                          grid )
     577!--                      Get k index of the highest terraing surface
     578                         im = mask_i(mid,i)
     579                         jm = mask_j(mid,j)
     580                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    579581                         DO  k = 1, mask_size_l(mid,3)
    580                             kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
    581                             local_pf(i,j,k) =  &
    582                                tend(kk,mask_j(mid,j),mask_i(mid,i))
     582                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     583!--                         Set value if not in building
     584                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     585                               local_pf(i,j,k) = fill_value
     586                            ELSE
     587                               local_pf(i,j,k) = tend(kk,jm,im)
     588                            ENDIF
    583589                         ENDDO
    584590                      ENDDO
     
    608614                   DO  i = 1, mask_size_l(mid,1)
    609615                      DO  j = 1, mask_size_l(mid,2)
    610 !
    611 !--                      Get k index of highest horizontal surface
    612                          topo_top_ind =  &
    613                             get_topography_top_index_ji( mask_j(mid,j),  &
    614                                                          mask_i(mid,i),  &
    615                                                          grid )
     616!--                      Get k index of the highest terraing surface
     617                         im = mask_i(mid,i)
     618                         jm = mask_j(mid,j)
     619                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    616620                         DO  k = 1, mask_size_l(mid,3)
    617                             kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 )
    618                             local_pf(i,j,k) =  &
    619                                  q(kk,mask_j(mid,j),mask_i(mid,i)) -  &
    620                                  ql(kk,mask_j(mid,j),mask_i(mid,i))
     621                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     622!--                         Set value if not in building
     623                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     624                               local_pf(i,j,k) = fill_value
     625                            ELSE
     626                               local_pf(i,j,k) = q(kk,jm,im) - ql(kk,jm,im)
     627                            ENDIF
    621628                         ENDDO
    622629                      ENDDO
     
    686693
    687694          CASE DEFAULT
    688 
     695!
     696!--          Set flag to steer output of radiation, land-surface, or user-defined
     697!--          quantities
     698             found = .FALSE.
    689699!
    690700!--          Radiation quantity
    691              IF ( radiation )  THEN
     701             IF ( .NOT. found  .AND. radiation )  THEN
    692702                CALL radiation_data_output_mask(av, domask(mid,av,ivar), found,&
    693703                                                local_pf, mid )
    694704             ENDIF
    695705
    696              IF ( air_chemistry )  THEN
     706             IF ( .NOT. found  .AND. air_chemistry )  THEN
    697707                CALL chem_data_output_mask(av, domask(mid,av,ivar), found,     &
    698708                                           local_pf, mid )
     
    700710!
    701711!--          Check for diagnostic quantities
    702              CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf,   &
     712             IF ( .NOT. found )  THEN
     713                CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf,   &
    703714                                   mid)
     715             ENDIF
    704716!
    705717!--          SALSA quantities
    706              IF ( salsa )  THEN
     718             IF ( .NOT. found .AND. salsa )  THEN
    707719                CALL salsa_data_output_mask( av, domask(mid,av,ivar), found,   &
    708720                                             local_pf, mid )
     
    745757             DO  i = 1, mask_size_l(mid,1)
    746758                DO  j = 1, mask_size_l(mid,2)
    747 !
    748 !--                Get k index of highest horizontal surface
    749                    topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
    750                                                                mask_i(mid,i), &
    751                                                                grid )
    752 !
    753 !--                Save output array
     759!--                Get k index of the highest terraing surface
     760                   im = mask_i(mid,i)
     761                   jm = mask_j(mid,j)
     762                   ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    754763                   DO  k = 1, mask_size_l(mid,3)
    755                       local_pf(i,j,k) = to_be_resorted(                       &
    756                                              MIN( topo_top_ind+mask_k(mid,k), &
    757                                                   nzt+1 ),                    &
    758                                              mask_j(mid,j),                   &
    759                                              mask_i(mid,i)                     )
     764                      kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     765!--                   Set value if not in building
     766                      IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     767                         local_pf(i,j,k) = fill_value
     768                      ELSE
     769                         local_pf(i,j,k) = to_be_resorted(kk,jm,im)
     770                      ENDIF
    760771                   ENDDO
    761772                ENDDO
  • palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90

    r4157 r4167  
    2525! -----------------
    2626! $Id$
     27! Changed behaviour of masked output over surface to follow terrain and ignore
     28! buildings (J.Resler, T.Gronemeier)
     29!
     30! 4157 2019-08-14 09:19:12Z suehring
    2731! Initialization restructured, in order to work also when data output during
    2832! spin-up is enabled.
     
    8690!
    8791    USE kinds
    88 ! 
     92!
    8993!     USE land_surface_model_mod,                                                &
    9094!         ONLY:  zs
     
    694698       
    695699    USE indices
    696    
    697     USE surface_mod,                                                           &
    698         ONLY:  get_topography_top_index_ji
    699  
     700
    700701    IMPLICIT NONE
    701702
    702     CHARACTER (LEN=*) ::  variable  !<
    703     CHARACTER (LEN=5) ::  grid      !< flag to distinquish between staggered grids
    704 
    705     INTEGER(iwp) ::  av           !< index indicating averaged or instantaneous output
    706     INTEGER(iwp) ::  flag_nr      !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
    707     INTEGER(iwp) ::  i            !< index variable along x-direction
    708     INTEGER(iwp) ::  j            !< index variable along y-direction
    709     INTEGER(iwp) ::  k            !< index variable along z-direction
    710     INTEGER(iwp) ::  mid          !< masked output running index
    711     INTEGER(iwp) ::  topo_top_ind !< k index of highest horizontal surface
    712 
    713     LOGICAL ::  found             !< true if variable is in list
    714     LOGICAL ::  resorted          !< true if array is resorted
     703    CHARACTER (LEN=*) ::  variable   !<
     704    CHARACTER (LEN=5) ::  grid       !< flag to distinquish between staggered grids
     705
     706    INTEGER(iwp) ::  av              !< index indicating averaged or instantaneous output
     707    INTEGER(iwp) ::  flag_nr         !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w)
     708    INTEGER(iwp) ::  i               !< index variable along x-direction
     709    INTEGER(iwp) ::  j               !< index variable along y-direction
     710    INTEGER(iwp) ::  k               !< index variable along z-direction
     711    INTEGER(iwp) ::  im              !< loop index for masked variables
     712    INTEGER(iwp) ::  jm              !< loop index for masked variables
     713    INTEGER(iwp) ::  kk              !< masked output index variable along z-direction
     714    INTEGER(iwp) ::  mid             !< masked output running index
     715    INTEGER(iwp) ::  ktt             !< k index of highest horizontal surface
     716
     717    LOGICAL      ::  found           !< true if variable is in list
     718    LOGICAL      ::  resorted        !< true if array is resorted
    715719
    716720    REAL(wp),                                                                  &
     
    718722          local_pf   !<
    719723    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which needs to be resorted for output
     724
     725    REAL(wp), PARAMETER   ::  fill_value = -9999.0_wp       !< value for the _FillValue attribute
    720726
    721727    flag_nr  = 0
     
    788794             DO  j = 1, mask_size_l(mid,2)
    789795!
    790 !--             Get k index of highest horizontal surface
    791                 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j),     &
    792                                                             mask_i(mid,i),     &
    793                                                             grid )
    794 !
    795 !--             Save output array
     796!--             Get k index of the highest terraing surface
     797                im = mask_i(mid,i)
     798                jm = mask_j(mid,j)
     799                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), &
     800                              DIM = 1 ) - 1
    796801                DO  k = 1, mask_size_l(mid,3)
    797                    local_pf(i,j,k) = to_be_resorted(                           &
    798                                           MIN( topo_top_ind+mask_k(mid,k),     &
    799                                                nzt+1 ),                        &
    800                                           mask_j(mid,j),                       &
    801                                           mask_i(mid,i)                     )
     802                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     803!
     804!--                Set value if not in building
     805                   IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     806                      local_pf(i,j,k) = fill_value
     807                   ELSE
     808                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
     809                   ENDIF
    802810                ENDDO
    803811             ENDDO
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4157 r4167  
    2828! -----------------
    2929! $Id$
     30! Changed behaviour of masked output over surface to follow terrain and ignore
     31! buildings (J.Resler, T.Gronemeier)
     32!
     33! 4157 2019-08-14 09:19:12Z suehring
    3034! Give informative message on raytracing distance only by core zero
    3135!
     
    741745
    742746    CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtmg'
     747
     748    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp       !< value for the _FillValue attribute
    743749
    744750!
     
    1013710143    LOGICAL      ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
    1013810144
    10139     REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
    10140 
    1014110145    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
    1014210146
     
    1053610540    LOGICAL      ::  found       !<
    1053710541
    10538     REAL(wp)     ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
    10539 
    1054010542    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
    1054110543
     
    1110511107    CHARACTER (LEN=*) ::  variable   !<
    1110611108
    11107     CHARACTER(LEN=5) ::  grid        !< flag to distinquish between staggered grids
    11108 
    1110911109    INTEGER(iwp) ::  av              !<
    1111011110    INTEGER(iwp) ::  i               !<
    1111111111    INTEGER(iwp) ::  j               !<
    11112     INTEGER(iwp) ::  k               !<
     11112    INTEGER(iwp) ::  k               !<
     11113    INTEGER(iwp) ::  im              !< loop index for masked variables
     11114    INTEGER(iwp) ::  jm              !< loop index for masked variables
     11115    INTEGER(iwp) ::  kk              !<
    1111311116    INTEGER(iwp) ::  mid             !< masked output running index
    11114     INTEGER(iwp) ::  topo_top_ind    !< k index of highest horizontal surface
     11117    INTEGER(iwp) ::  ktt             !< k index of highest terrain surface
    1111511118
    1111611119    LOGICAL ::  found                !< true if output array was found
     
    1112411127    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which needs to be resorted for output
    1112511128
    11126 
    11127     found    = .TRUE.
    11128     grid     = 's'
    1112911129    resorted = .FALSE.
     11130    found = .TRUE.
    1113011131
    1113111132    SELECT CASE ( TRIM( variable ) )
     
    1121411215             DO  j = 1, mask_size_l(mid,2)
    1121511216!
    11216 !--             Get k index of highest horizontal surface
    11217                 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), &
    11218                                                             mask_i(mid,i), &
    11219                                                             grid )
    11220 !
    11221 !--             Save output array
     11217!--             Get k index of the highest terraing surface
     11218                im = mask_i(mid,i)
     11219                jm = mask_j(mid,j)
     11220                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), &
     11221                              DIM = 1 ) - 1
    1122211222                DO  k = 1, mask_size_l(mid,3)
    11223                    local_pf(i,j,k) = to_be_resorted(                       &
    11224                                           MIN( topo_top_ind+mask_k(mid,k), &
    11225                                                nzt+1 ),                    &
    11226                                           mask_j(mid,j),                   &
    11227                                           mask_i(mid,i)                     )
     11223                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11224!
     11225!--                Set value if not in building
     11226                   IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11227                      local_pf(i,j,k) = fill_value
     11228                   ELSE
     11229                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
     11230                   ENDIF
    1122811231                ENDDO
    1122911232             ENDDO
  • palm/trunk/SOURCE/salsa_mod.f90

    r4131 r4167  
    2626! -----------------
    2727! $Id$
     28! Changed behaviour of masked output over surface to follow terrain and ignore
     29! buildings (J.Resler, T.Gronemeier)
     30!
     31! 4131 2019-08-02 11:06:18Z monakurppa
    2832! - Add "salsa_" before each salsa output variable
    2933! - Add a possibility to output the number (salsa_N_UFP) and mass concentration
     
    256260                                             !< 2 = autumn (no harvest yet), 3 = late autumn
    257261                                             !< (already frost), 4 = winter, 5 = transitional spring
     262
     263    REAL(wp), PARAMETER ::  fill_value = -9999.0_wp    !< value for the _FillValue attribute
    258264!
    259265!-- Universal constants
     
    1039310399                                          !< depositing in the alveolar (or tracheobronchial)
    1039410400                                          !< region of the lung. Depends on the particle size
    10395     REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
    1039610401    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
    1039710402    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
     
    1080810813                                          !< depositing in the alveolar (or tracheobronchial)
    1080910814                                          !< region of the lung. Depends on the particle size
    10810     REAL(wp) ::  fill_value = -9999.0_wp  !< value for the _FillValue attribute
    1081110815    REAL(wp) ::  mean_d                   !< Particle diameter in micrometres
    1081210816    REAL(wp) ::  temp_bin                 !< temporary array for calculating output variables
     
    1117411178        ONLY:  mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d
    1117511179
    11176     USE surface_mod,                                                                               &
    11177         ONLY:  get_topography_top_index_ji
    11178 
    1117911180    IMPLICIT NONE
    1118011181
     
    1119111192    INTEGER(iwp) ::  j              !< loop index in y-direction
    1119211193    INTEGER(iwp) ::  k              !< loop index in z-direction
     11194    INTEGER(iwp) ::  im             !< loop index for masked variables
     11195    INTEGER(iwp) ::  jm             !< loop index for masked variables
     11196    INTEGER(iwp) ::  kk             !< loop index for masked output in z-direction
    1119311197    INTEGER(iwp) ::  mid            !< masked output running index
    11194     INTEGER(iwp) ::  topo_top_ind   !< k index of highest horizontal surface
     11198    INTEGER(iwp) ::  ktt            !< k index of highest terrain surface
    1119511199
    1119611200    LOGICAL ::  found      !<
     
    1123111235                DO  i = 1, mask_size_l(mid,1)
    1123211236                   DO  j = 1, mask_size_l(mid,2)
    11233                       topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i),    &
    11234                                                                   grid )
     11237!
     11238!--                   Get k index of the highest terraing surface
     11239                      im = mask_i(mid,i)
     11240                      jm = mask_j(mid,j)
     11241                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1123511242                      DO  k = 1, mask_size_l(mid,3)
    11236                          local_pf(i,j,k) = aerosol_number(ib)%conc(MIN( topo_top_ind+mask_k(mid,k),&
    11237                                                                         nzt+1 ),                   &
    11238                                                                    mask_j(mid,j), mask_i(mid,i) )
     11243                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11244!
     11245!--                      Set value if not in building
     11246                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11247                            local_pf(i,j,k) = fill_value
     11248                         ELSE
     11249                            local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im)
     11250                         ENDIF
    1123911251                      ENDDO
    1124011252                   ENDDO
     
    1127711289                DO  i = 1, mask_size_l(mid,1)
    1127811290                   DO  j = 1, mask_size_l(mid,2)
    11279                       topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i),    &
    11280                                                                   grid )
     11291!
     11292!--                   Get k index of the highest terraing surface
     11293                      im = mask_i(mid,i)
     11294                      jm = mask_j(mid,j)
     11295                      ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1128111296                      DO  k = 1, mask_size_l(mid,3)
    11282                          local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),         &
    11283                                                  mask_j(mid,j), mask_i(mid,i) )
     11297                         kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11298!
     11299!--                      Set value if not in building
     11300                         IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11301                            local_pf(i,j,k) = fill_value
     11302                         ELSE
     11303                            local_pf(i,j,k) = tend(kk,jm,im)
     11304                         ENDIF
    1128411305                      ENDDO
    1128511306                   ENDDO
     
    1134711368                   DO  i = 1, mask_size_l(mid,1)
    1134811369                      DO  j = 1, mask_size_l(mid,2)
    11349                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11350                                                                      grid )
     11370!
     11371!--                      Get k index of the highest terraing surface
     11372                         im = mask_i(mid,i)
     11373                         jm = mask_j(mid,j)
     11374                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1135111375                         DO  k = 1, mask_size_l(mid,3)
    11352                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11353                                                     mask_j(mid,j), mask_i(mid,i) )
     11376                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11377!
     11378!--                         Set value if not in building
     11379                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11380                               local_pf(i,j,k) = fill_value
     11381                            ELSE
     11382                               local_pf(i,j,k) = tend(kk,jm,im)
     11383                            ENDIF
    1135411384                         ENDDO
    1135511385                      ENDDO
     
    1138711417                   DO  i = 1, mask_size_l(mid,1)
    1138811418                      DO  j = 1, mask_size_l(mid,2)
    11389                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11390                                                                      grid )
     11419!
     11420!--                      Get k index of the highest terraing surface
     11421                         im = mask_i(mid,i)
     11422                         jm = mask_j(mid,j)
     11423                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1139111424                         DO  k = 1, mask_size_l(mid,3)
    11392                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11393                                                     mask_j(mid,j), mask_i(mid,i) )
     11425                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11426!
     11427!--                         Set value if not in building
     11428                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11429                               local_pf(i,j,k) = fill_value
     11430                            ELSE
     11431                               local_pf(i,j,k) = tend(kk,jm,im)
     11432                            ENDIF
    1139411433                         ENDDO
    1139511434                      ENDDO
     
    1142511464                   DO  i = 1, mask_size_l(mid,1)
    1142611465                      DO  j = 1, mask_size_l(mid,2)
    11427                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11428                                                                      grid )
     11466!
     11467!--                      Get k index of the highest terraing surface
     11468                         im = mask_i(mid,i)
     11469                         jm = mask_j(mid,j)
     11470                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1142911471                         DO  k = 1, mask_size_l(mid,3)
    11430                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11431                                                     mask_j(mid,j), mask_i(mid,i) )
     11472                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11473!
     11474!--                         Set value if not in building
     11475                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11476                               local_pf(i,j,k) = fill_value
     11477                            ELSE
     11478                               local_pf(i,j,k) = tend(kk,jm,im)
     11479                            ENDIF
    1143211480                         ENDDO
    1143311481                      ENDDO
     
    1146711515                   DO  i = 1, mask_size_l(mid,1)
    1146811516                      DO  j = 1, mask_size_l(mid,2)
    11469                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11470                                                                      grid )
     11517!
     11518!--                      Get k index of the highest terraing surface
     11519                         im = mask_i(mid,i)
     11520                         jm = mask_j(mid,j)
     11521                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1147111522                         DO  k = 1, mask_size_l(mid,3)
    11472                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11473                                                     mask_j(mid,j), mask_i(mid,i) )
     11523                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11524!
     11525!--                         Set value if not in building
     11526                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11527                               local_pf(i,j,k) = fill_value
     11528                            ELSE
     11529                               local_pf(i,j,k) = tend(kk,jm,im)
     11530                            ENDIF
    1147411531                         ENDDO
    1147511532                      ENDDO
     
    1150911566                   DO  i = 1, mask_size_l(mid,1)
    1151011567                      DO  j = 1, mask_size_l(mid,2)
    11511                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11512                                                                      grid )
     11568!
     11569!--                      Get k index of the highest terraing surface
     11570                         im = mask_i(mid,i)
     11571                         jm = mask_j(mid,j)
     11572                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1151311573                         DO  k = 1, mask_size_l(mid,3)
    11514                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11515                                                     mask_j(mid,j), mask_i(mid,i) )
     11574                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11575!
     11576!--                         Set value if not in building
     11577                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11578                               local_pf(i,j,k) = fill_value
     11579                            ELSE
     11580                               local_pf(i,j,k) = tend(kk,jm,im)
     11581                            ENDIF
    1151611582                         ENDDO
    1151711583                      ENDDO
     
    1155111617                   DO  i = 1, mask_size_l(mid,1)
    1155211618                      DO  j = 1, mask_size_l(mid,2)
    11553                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11554                                                                      grid )
     11619!
     11620!--                      Get k index of the highest terraing surface
     11621                         im = mask_i(mid,i)
     11622                         jm = mask_j(mid,j)
     11623                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1155511624                         DO  k = 1, mask_size_l(mid,3)
    11556                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11557                                                     mask_j(mid,j), mask_i(mid,i) )
     11625                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11626!
     11627!--                         Set value if not in building
     11628                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11629                               local_pf(i,j,k) = fill_value
     11630                            ELSE
     11631                               local_pf(i,j,k) = tend(kk,jm,im)
     11632                            ENDIF
    1155811633                         ENDDO
    1155911634                      ENDDO
     
    1159411669                   DO  i = 1, mask_size_l(mid,1)
    1159511670                      DO  j = 1, mask_size_l(mid,2)
    11596                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11597                                                                      grid )
     11671!
     11672!--                      Get k index of the highest terraing surface
     11673                         im = mask_i(mid,i)
     11674                         jm = mask_j(mid,j)
     11675                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1159811676                         DO  k = 1, mask_size_l(mid,3)
    11599                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11600                                                     mask_j(mid,j), mask_i(mid,i) )
     11677                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11678!
     11679!--                         Set value if not in building
     11680                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11681                               local_pf(i,j,k) = fill_value
     11682                            ELSE
     11683                               local_pf(i,j,k) = tend(kk,jm,im)
     11684                            ENDIF
    1160111685                         ENDDO
    1160211686                      ENDDO
     
    1164111725                   DO  i = 1, mask_size_l(mid,1)
    1164211726                      DO  j = 1, mask_size_l(mid,2)
    11643                          topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), &
    11644                                                                      grid )
     11727!
     11728!--                      Get k index of the highest terraing surface
     11729                         im = mask_i(mid,i)
     11730                         jm = mask_j(mid,j)
     11731                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1164511732                         DO  k = 1, mask_size_l(mid,3)
    11646                             local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),      &
    11647                                                     mask_j(mid,j), mask_i(mid,i) )
     11733                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11734!
     11735!--                         Set value if not in building
     11736                            IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11737                               local_pf(i,j,k) = fill_value
     11738                            ELSE
     11739                               local_pf(i,j,k) =  tend(kk,jm,im)
     11740                            ENDIF
    1164811741                         ENDDO
    1164911742                      ENDDO
     
    1166111754    ENDIF
    1166211755
    11663     IF ( .NOT. resorted )  THEN
     11756    IF ( found  .AND.  .NOT. resorted )  THEN
    1166411757       IF ( .NOT. mask_surface(mid) )  THEN
    1166511758!
     
    1167711770          DO  i = 1, mask_size_l(mid,1)
    1167811771             DO  j = 1, mask_size_l(mid,2)
    11679 !
    11680 !--             Get k index of highest horizontal surface
    11681                 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), grid )
    11682 !
    11683 !--             Save output array
     11772!--             Get k index of the highest terraing surface
     11773                im = mask_i(mid,i)
     11774                jm = mask_j(mid,j)
     11775                ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1
    1168411776                DO  k = 1, mask_size_l(mid,3)
    11685                    local_pf(i,j,k) = to_be_resorted( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ),     &
    11686                                                      mask_j(mid,j), mask_i(mid,i) )
     11777                   kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     11778!--                Set value if not in building
     11779                   IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) )  THEN
     11780                      local_pf(i,j,k) = fill_value
     11781                   ELSE
     11782                      local_pf(i,j,k) = to_be_resorted(kk,jm,im)
     11783                   ENDIF
    1168711784                ENDDO
    1168811785             ENDDO
Note: See TracChangeset for help on using the changeset viewer.