Home


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

Changeset 2712 for palm/trunk


Ignore:
Timestamp:
Dec 20, 2017 5:32:50 PM (7 years ago)
Author:
kanani
Message:

Formatting and clean-up of vertical_nesting_mod

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/vertical_nesting_mod.f90

    r2696 r2712  
    2626! -----------------
    2727! $Id$
     28! Formatting and clean-up (SadiqHuq)
     29!
     30! 2696 2017-12-14 17:12:51Z kanani
    2831! renamed diffusivities to tcm_diffusivities (TG)
    2932!
    … …  
    4851!>
    4952!> Definition of parameters and variables for vertical nesting
     53!> The horizontal extent of the parent (Coarse Grid) and the child (Fine Grid)
     54!> have to be identical. The vertical extent of the FG should be smaller than CG.
     55!> Only integer nesting ratio supported. Odd nesting ratio preferred
     56!> The code follows MPI-1 standards. The available processors are split into
     57!> two groups using MPI_COMM_SPLIT. Exchange of data from CG to FG is called
     58!> interpolation. FG initialization by interpolation is done once at the start.
     59!> FG boundary conditions are set by interpolated at every timestep.
     60!> Exchange of data from CG to FG is called anterpolation, the two-way interaction
     61!> occurs at every timestep.
     62!> vnest_start_time set in PARIN allows delayed start of the coupling
     63!> after spin-up of the CG
    5064!>
    5165!> @todo Ensure that code can be compiled for serial and parallel mode. Please
    … …  
    6478    IMPLICIT NONE
    6579
    66     INTEGER(iwp),DIMENSION(3,2) ::  bdims = 0
    67     INTEGER(iwp),DIMENSION(3,2) ::  bdims_rem = 0  !> Add description. It should not be longer than up to this point   |
    68                                                    !> If really necessary, a second line can be added like this.
    69     INTEGER(iwp)                             :: cg_nprocs, fg_nprocs
    70     INTEGER(iwp),DIMENSION(:,:,:),ALLOCATABLE:: c2f_dims_cg, f2c_dims_cg
    71     INTEGER(iwp),DIMENSION(:),ALLOCATABLE    :: c2f_dims_fg, f2c_dims_fg
    72     INTEGER(iwp)                             :: TYPE_VNEST_BC, TYPE_VNEST_ANTER
    73 
    74     INTEGER(iwp),DIMENSION(:,:),ALLOCATABLE  :: f_rnk_lst, c_rnk_lst
    75     INTEGER(iwp),DIMENSION(3)                :: cfratio
    76 
    77     INTEGER(iwp)                             :: nxc, nxf, nyc, nyf, nzc, nzf
    78     INTEGER(iwp)                             :: ngp_c, ngp_f
    79 
    80     INTEGER(iwp)                             :: target_idex, n_cell_c, n_cell_f
    81     INTEGER(iwp),DIMENSION(2)                :: pdims_partner
    82     INTEGER(iwp),DIMENSION(2)                :: offset,map_coord
    83 
    84     REAL(wp)                                :: dxc, dyc, dxf, dyf, dzc, dzf,dtc,dtf
    85 
    86     REAL(wp),DIMENSION(:,:,:), ALLOCATABLE  :: work3d
    87     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dshf
    88     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dusws
    89     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dvsws
    90     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dts
    91     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dus
    92     REAL(wp),DIMENSION(:,:),   ALLOCATABLE  :: work2dz0
    93 
    94 
    95     REAL(wp), DIMENSION(:),    ALLOCATABLE  :: zuc, zuf, zwc, zwf
    96     REAL(wp), DIMENSION(:,:,:), POINTER      :: interpol3d,anterpol3d
    97 !   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  interpol3d
    98 
    99     LOGICAL ::  vnest_init = .FALSE., vnested = .FALSE., &
    100                 vnest_twi = .FALSE., vnest_couple_rk3 = .FALSE.
    101 
    102     ! PARIN
    103     REAL(wp) ::  vnest_start_time = 9999999.9
     80    LOGICAL                                   ::  vnested = .FALSE.            !> set to true when
     81                                                                               !> mrun is called with -N option
     82    LOGICAL                                   ::  vnest_init = .FALSE.         !> set to true when FG is initialized
     83    REAL(wp)                                  ::  vnest_start_time = 9999999.9 !> simulated time when FG should be
     84                                                                               !> initialized. Should be
     85                                                                               !> identical in PARIN & PARIN_N
     86
     87
     88
     89    INTEGER(iwp),DIMENSION(3,2)               :: bdims = 0        !> sub-domain grid topology of current PE
     90    INTEGER(iwp),DIMENSION(3,2)               :: bdims_rem = 0    !> sub-domain grid topology of partner PE
     91    INTEGER(iwp)                              :: cg_nprocs        !> no. of PE in CG. Set by mrun -N
     92    INTEGER(iwp)                              :: fg_nprocs        !> no. of PE in FG. Set by mrun -N
     93    INTEGER(iwp)                              :: TYPE_VNEST_BC    !> derived contiguous data type for interpolation
     94    INTEGER(iwp)                              :: TYPE_VNEST_ANTER !> derived contiguous data type for anterpolation
     95    INTEGER(iwp),DIMENSION(:,:,:),ALLOCATABLE :: c2f_dims_cg      !> One CG PE sends data to multiple FG PEs
     96                                                                  !> list of grid-topology of partners
     97    INTEGER(iwp),DIMENSION(:,:,:),ALLOCATABLE :: f2c_dims_cg      !> One CG PE receives data from multiple FG PEs
     98                                                                  !> list of grid-topology of partners
     99    INTEGER(iwp),DIMENSION(:),ALLOCATABLE     :: c2f_dims_fg      !> One FG PE sends data to multiple CG PE
     100                                                                  !> list of grid-topology of partner
     101    INTEGER(iwp),DIMENSION(:),ALLOCATABLE     :: f2c_dims_fg      !> One FG PE sends data to only one CG PE
     102                                                                  !> list of grid-topology of partner
     103
     104    INTEGER(iwp),DIMENSION(:,:),ALLOCATABLE   :: f_rnk_lst        !> list storing rank of FG PE denoted by pdims
     105    INTEGER(iwp),DIMENSION(:,:),ALLOCATABLE   :: c_rnk_lst        !> list storing rank of CG PE denoted by pdims
     106    INTEGER(iwp),DIMENSION(3)                 :: cfratio          !> Nesting ratio in x,y and z-directions
     107
     108    INTEGER(iwp)                              :: nxc              !> no. of CG grid points in x-direction
     109    INTEGER(iwp)                              :: nxf              !> no. of FG grid points in x-direction
     110    INTEGER(iwp)                              :: nyc              !> no. of CG grid points in y-direction
     111    INTEGER(iwp)                              :: nyf              !> no. of FG grid points in y-direction
     112    INTEGER(iwp)                              :: nzc              !> no. of CG grid points in z-direction
     113    INTEGER(iwp)                              :: nzf              !> no. of FG grid points in z-direction
     114    INTEGER(iwp)                              :: ngp_c            !> no. of CG grid points in one vertical level
     115    INTEGER(iwp)                              :: ngp_f            !> no. of FG grid points in one vertical level
     116
     117    INTEGER(iwp)                              :: n_cell_c         !> total no. of CG grid points in a PE
     118    INTEGER(iwp)                              :: n_cell_f         !> total no. of FG grid points in a PE
     119    INTEGER(iwp),DIMENSION(2)                 :: pdims_partner    !> processor topology of partner PE
     120    INTEGER(iwp)                              :: target_idex      !> temporary variable
     121    INTEGER(iwp),DIMENSION(2)                 :: offset           !> temporary variable
     122    INTEGER(iwp),DIMENSION(2)                 :: map_coord        !> temporary variable
     123
     124    REAL(wp)                                  :: dxc              !> CG grid pacing in x-direction
     125    REAL(wp)                                  :: dyc              !> FG grid pacing in x-direction
     126    REAL(wp)                                  :: dxf              !> CG grid pacing in y-direction
     127    REAL(wp)                                  :: dyf              !> FG grid pacing in y-direction
     128    REAL(wp)                                  :: dzc              !> CG grid pacing in z-direction
     129    REAL(wp)                                  :: dzf              !> FG grid pacing in z-direction
     130    REAL(wp)                                  :: dtc              !> dt calculated for CG
     131    REAL(wp)                                  :: dtf              !> dt calculated for FG
     132
     133    REAL(wp), DIMENSION(:),    ALLOCATABLE    :: zuc              !> CG vertical u-levels
     134    REAL(wp), DIMENSION(:),    ALLOCATABLE    :: zuf              !> FG vertical u-levels
     135    REAL(wp), DIMENSION(:),    ALLOCATABLE    :: zwc              !> CG vertical w-levels
     136    REAL(wp), DIMENSION(:),    ALLOCATABLE    :: zwf              !> FG vertical w-levels
     137    REAL(wp), DIMENSION(:,:,:), POINTER       :: interpol3d       !> pointers to simplify function calls
     138    REAL(wp), DIMENSION(:,:,:), POINTER       :: anterpol3d       !> pointers to simplify function calls
     139
     140
     141    REAL(wp),DIMENSION(:,:,:), ALLOCATABLE    :: work3d           !> temporary array for exchange of 3D data
     142    REAL(wp),DIMENSION(:,:),   ALLOCATABLE    :: work2dusws       !> temporary array for exchange of 2D data
     143    REAL(wp),DIMENSION(:,:),   ALLOCATABLE    :: work2dvsws       !> temporary array for exchange of 2D data
     144    REAL(wp),DIMENSION(:,:),   ALLOCATABLE    :: work2dts         !> temporary array for exchange of 2D data
     145    REAL(wp),DIMENSION(:,:),   ALLOCATABLE    :: work2dus         !> temporary array for exchange of 2D data
    104146
    105147    SAVE
    … …  
    112154
    113155!-- Public constants and variables
    114     PUBLIC vnested, vnest_init, vnest_twi, vnest_couple_rk3,                  &
    115            vnest_start_time
     156    PUBLIC vnested, vnest_init, vnest_start_time
    116157
    117158    PRIVATE bdims, bdims_rem,                                                 &
    118             work3d, work2dshf, work2dusws, work2dvsws,                        &
    119             work2dts, work2dus, work2dz0,                                     &
     159            work3d, work2dusws, work2dvsws, work2dts, work2dus,               &
    120160            dxc, dyc, dxf, dyf, dzc, dzf, dtc, dtf,                           &
    121161            zuc, zuf, zwc, zwf, interpol3d, anterpol3d,                       &
    … …  
    176216   
    177217    SUBROUTINE vnest_init_fine
     218#if defined( __parallel )
    178219   
    179220        !--------------------------------------------------------------------------------!
    … …  
    191232        USE interfaces
    192233        USE pegrid
    193         USE surface_mod,                                                        &
     234        USE surface_mod,                                                       &
    194235            ONLY :  surf_def_h, surf_def_v
    195         USE turbulence_closure_mod,                                             &
     236        USE turbulence_closure_mod,                                            &
    196237            ONLY :  tcm_diffusivities
     238       
    197239   
    198240        IMPLICIT NONE
    199241   
    200         REAL(wp)    ::  time_since_reference_point_rem
    201    
    202         INTEGER(iwp)   :: i, j, k,im,jn,ko
    203         INTEGER(iwp)                             ::  if, jf, kf
    204    
    205 #if defined( __parallel )
    206    
    207         if (myid ==0 )print *, ' TIME TO INIT FINE from COARSE', simulated_time
     242        REAL(wp)                              :: time_since_reference_point_rem
     243        INTEGER(iwp)                          :: i
     244        INTEGER(iwp)                          :: j
     245        INTEGER(iwp)                          :: k
     246        INTEGER(iwp)                          :: im
     247        INTEGER(iwp)                          :: jn
     248        INTEGER(iwp)                          :: ko
     249        INTEGER(iwp)                          :: iif
     250        INTEGER(iwp)                          :: jjf
     251        INTEGER(iwp)                          :: kkf
     252   
     253   
     254        if (myid ==0 ) print *, ' TIME TO INIT FINE from COARSE', simulated_time
    208255   
    209256        !
    … …  
    344391                        (bdims(2,2)-bdims(2,1)+3)
    345392   
    346 !-- WARNING
    347 !-- shf,z0 not interpolated
    348 !-- line commented in interpolate_to_fine_flux
    349 !-- FG needs to read it's own data file   
    350 !MERGE-WIP                  CALL MPI_SEND(surf_def_h(0)%shf ( bdims(2,1)-1:bdims(2,2)+1, &
    351 !MERGE-WIP                      bdims(1,1)-1:bdims(1,2)+1),&
    352 !MERGE-WIP                      n_cell_c, MPI_REAL, target_idex,  &
    353 !MERGE-WIP                      109, comm_inter, ierr   )
    354 !MERGE-WIP
    355 !MERGE-WIP                  CALL MPI_SEND(surf_def_h(0)%usws( bdims(2,1)-1:bdims(2,2)+1, &
    356 !MERGE-WIP                      bdims(1,1)-1:bdims(1,2)+1),&
    357 !MERGE-WIP                      n_cell_c, MPI_REAL, target_idex,  &
    358 !MERGE-WIP                      110, comm_inter, ierr   )
    359 !MERGE-WIP
    360 !MERGE-WIP                  CALL MPI_SEND(surf_def_h(0)%vsws( bdims(2,1)-1:bdims(2,2)+1, &
    361 !MERGE-WIP                      bdims(1,1)-1:bdims(1,2)+1),&
    362 !MERGE-WIP                      n_cell_c, MPI_REAL, target_idex,  &
    363 !MERGE-WIP                      111, comm_inter, ierr   )
    364 !MERGE-WIP
    365 !MERGE                   CALL MPI_SEND(ts  ( bdims(2,1)-1:bdims(2,2)+1, &
    366 !MERGE                       bdims(1,1)-1:bdims(1,2)+1),&
    367 !MERGE                       n_cell_c, MPI_REAL, target_idex,  &
    368 !MERGE                       112, comm_inter, ierr   )
    369 !MERGE 
    370 !MERGE                   CALL MPI_SEND(us  ( bdims(2,1)-1:bdims(2,2)+1, &
    371 !MERGE                       bdims(1,1)-1:bdims(1,2)+1),&
    372 !MERGE                       n_cell_c, MPI_REAL, target_idex,  &
    373 !MERGE                       113, comm_inter, ierr   )
    374 !MERGE 
    375 !MERGE                   CALL MPI_SEND(z0  ( bdims(2,1)-1:bdims(2,2)+1, &
    376 !MERGE                       bdims(1,1)-1:bdims(1,2)+1),&
    377 !MERGE                       n_cell_c, MPI_REAL, target_idex,  &
    378 !MERGE                       114, comm_inter, ierr   )
     393!
     394!--     shf and z0 for CG / FG need to initialized in input file or user_code
     395!--     TODO
     396!--     initialization of usws, vsws, ts and us not vital to vnest FG
     397!--     variables are not compatible with the new surface layer module
     398!
     399!                 CALL MPI_SEND(surf_def_h(0)%usws( bdims(2,1)-1:bdims(2,2)+1, &
     400!                     bdims(1,1)-1:bdims(1,2)+1),&
     401!                     n_cell_c, MPI_REAL, target_idex,  &
     402!                     110, comm_inter, ierr   )
     403!
     404!                 CALL MPI_SEND(surf_def_h(0)%vsws( bdims(2,1)-1:bdims(2,2)+1, &
     405!                     bdims(1,1)-1:bdims(1,2)+1),&
     406!                     n_cell_c, MPI_REAL, target_idex,  &
     407!                     111, comm_inter, ierr   )
     408!
     409!                 CALL MPI_SEND(ts  ( bdims(2,1)-1:bdims(2,2)+1, &
     410!                     bdims(1,1)-1:bdims(1,2)+1),&
     411!                     n_cell_c, MPI_REAL, target_idex,  &
     412!                     112, comm_inter, ierr   )
     413!   
     414!                 CALL MPI_SEND(us  ( bdims(2,1)-1:bdims(2,2)+1, &
     415!                     bdims(1,1)-1:bdims(1,2)+1),&
     416!                     n_cell_c, MPI_REAL, target_idex,  &
     417!                     113, comm_inter, ierr   )
     418!   
    379419            ENDIF
    380420   
    … …  
    465505                (bdims_rem(2,2)-bdims_rem(2,1)+3)
    466506   
    467             ALLOCATE( work2dshf  ( bdims_rem(2,1)-1:bdims_rem(2,2)+1, &
    468                 bdims_rem(1,1)-1:bdims_rem(1,2)+1) )
    469507            ALLOCATE( work2dusws ( bdims_rem(2,1)-1:bdims_rem(2,2)+1, &
    470508                bdims_rem(1,1)-1:bdims_rem(1,2)+1) )
    … …  
    475513            ALLOCATE( work2dus   ( bdims_rem(2,1)-1:bdims_rem(2,2)+1, &
    476514                bdims_rem(1,1)-1:bdims_rem(1,2)+1) )
    477             ALLOCATE( work2dz0   ( bdims_rem(2,1)-1:bdims_rem(2,2)+1, &
    478                 bdims_rem(1,1)-1:bdims_rem(1,2)+1) )
    479    
    480 !MERGE-WIP          CALL MPI_RECV( work2dshf ,n_cell_c, MPI_REAL, target_idex, 109, &
    481 !MERGE-WIP              comm_inter,status, ierr )
    482 !MERGE-WIP
    483 !MERGE-WIP          CALL MPI_RECV( work2dusws,n_cell_c, MPI_REAL, target_idex, 110, &
    484 !MERGE-WIP              comm_inter,status, ierr )
    485 !MERGE-WIP
    486 !MERGE-WIP          CALL MPI_RECV( work2dvsws,n_cell_c, MPI_REAL, target_idex, 111, &
    487 !MERGE-WIP              comm_inter,status, ierr )
    488 !MERGE-WIP
    489 !MERGE           CALL MPI_RECV( work2dts  ,n_cell_c, MPI_REAL, target_idex, 112, &
    490 !MERGE               comm_inter,status, ierr )
    491 !MERGE 
    492 !MERGE           CALL MPI_RECV( work2dus  ,n_cell_c, MPI_REAL, target_idex, 113, &
    493 !MERGE               comm_inter,status, ierr )
    494 !MERGE 
    495 !MERGE           CALL MPI_RECV( work2dz0  ,n_cell_c, MPI_REAL, target_idex, 114, &
    496 !MERGE               comm_inter,status, ierr )
    497 !MERGE 
    498 !MERGE-WIP           CALL interpolate_to_fine_flux ( 108 )
    499    
    500             DEALLOCATE(   work2dshf    )
     515   
     516!
     517!--     shf and z0 for CG / FG need to initialized in input file or user_code
     518!--     TODO
     519!--     initialization of usws, vsws, ts and us not vital to vnest FG
     520!--     variables are not compatible with the new surface layer module
     521!
     522!          CALL MPI_RECV( work2dusws,n_cell_c, MPI_REAL, target_idex, 110, &
     523!              comm_inter,status, ierr )
     524!
     525!          CALL MPI_RECV( work2dvsws,n_cell_c, MPI_REAL, target_idex, 111, &
     526!              comm_inter,status, ierr )
     527!
     528!          CALL MPI_RECV( work2dts  ,n_cell_c, MPI_REAL, target_idex, 112, &
     529!              comm_inter,status, ierr )
     530!   
     531!          CALL MPI_RECV( work2dus  ,n_cell_c, MPI_REAL, target_idex, 113, &
     532!              comm_inter,status, ierr )
     533!   
     534!           CALL interpolate_to_fine_flux ( 108 )
     535   
    501536            DEALLOCATE(   work2dusws   )
    502537            DEALLOCATE(   work2dvsws   )
    503538            DEALLOCATE(   work2dts     )
    504539            DEALLOCATE(   work2dus     )
    505             DEALLOCATE(   work2dz0     )
    506540          ENDIF
    507541   
    508542          IF ( .NOT. constant_diffusion ) THEN
    509              DO kf =  bdims(3,1)+1,bdims(3,2)+1
    510                  DO jf =  bdims(2,1),bdims(2,2)
    511                      DO if =  bdims(1,1),bdims(1,2)
    512    
    513                          IF ( e(kf,jf,if) < 0.0 ) THEN
    514                               e(kf,jf,if) = 1E-15_wp
     543             DO kkf =  bdims(3,1)+1,bdims(3,2)+1
     544                 DO jjf =  bdims(2,1),bdims(2,2)
     545                     DO iif =  bdims(1,1),bdims(1,2)
     546   
     547                         IF ( e(kkf,jjf,iif) < 0.0 ) THEN
     548                              e(kkf,jjf,iif) = 1E-15_wp
    515549                         END IF
    516550   
    … …  
    586620
    587621        if (myid==0) print *, '** Fine Initalized ** simulated_time:', simulated_time
    588 #endif
     622
    589623    CONTAINS
    590624   
    591625       SUBROUTINE interpolate_to_fine_w( tag )
    592      
    593 #if defined( __parallel )
    594626     
    595627           USE arrays_3d
    … …  
    602634           IMPLICIT NONE
    603635     
    604            INTEGER(iwp), intent(in) ::  tag
    605            INTEGER(iwp)                             ::  i, j, k
    606            INTEGER(iwp)                             ::  if, jf, kf
    607            INTEGER(iwp)                             ::  bottomx, topx
    608            INTEGER(iwp)                             ::  bottomy, topy
    609            INTEGER(iwp)                             ::  bottomz, topz
    610            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    611            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  wprs, wprf
    612      
    613            INTEGER(iwp) :: nzbottom, nztop
     636           INTEGER(iwp), intent(in)           :: tag
     637           INTEGER(iwp)                       :: i
     638           INTEGER(iwp)                       :: j
     639           INTEGER(iwp)                       :: k
     640           INTEGER(iwp)                       :: iif
     641           INTEGER(iwp)                       :: jjf
     642           INTEGER(iwp)                       :: kkf
     643           INTEGER(iwp)                       :: nzbottom
     644           INTEGER(iwp)                       :: nztop
     645           INTEGER(iwp)                       :: bottomx
     646           INTEGER(iwp)                       :: bottomy
     647           INTEGER(iwp)                       :: bottomz
     648           INTEGER(iwp)                       :: topx
     649           INTEGER(iwp)                       :: topy
     650           INTEGER(iwp)                       :: topz
     651           REAL(wp)                           :: eps
     652           REAL(wp)                           :: alpha
     653           REAL(wp)                           :: eminus
     654           REAL(wp)                           :: edot
     655           REAL(wp)                           :: eplus
     656           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprs
     657           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprf
    614658     
    615659     
    … …  
    632676                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    633677     
    634                        DO if = bottomx, topx
    635      
    636                            eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     678                       DO iif = bottomx, topx
     679     
     680                           eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    637681                           alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    638682                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    640684                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    641685                     
    642                            wprf(k,j,if) = eminus * work3d(k,j,i-1) &
     686                           wprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    643687                               + edot  * work3d(k,j,i)   &
    644688                               + eplus  * work3d(k,j,i+1)
    … …  
    657701                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    658702     
    659                    DO if = nxl, nxr
    660                        DO jf = bottomy, topy
     703                   DO iif = nxl, nxr
     704                       DO jjf = bottomy, topy
    661705                     
    662                            eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     706                           eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    663707                           alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    664708                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    666710                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    667711     
    668                            wprs(k,jf,if) = eminus * wprf(k,j-1,if) &
    669                                + edot  * wprf(k,j,if)   &
    670                                + eplus  * wprf(k,j+1,if)
     712                           wprs(k,jjf,iif) = eminus * wprf(k,j-1,iif) &
     713                               + edot  * wprf(k,j,iif)   &
     714                               + eplus  * wprf(k,j+1,iif)
    671715     
    672716                       END DO
    … …  
    684728               topz    = (dzc/dzf) * (k+1) - 1
    685729     
    686                DO jf = nys, nyn
    687                    DO if = nxl, nxr
    688                        DO kf = bottomz, topz
    689      
    690                            w(kf,jf,if) = wprs(k,jf,if) + ( zwf(kf) - zwc(k) ) &
    691                                * ( wprs(k+1,jf,if) - wprs(k,jf,if) ) / dzc
     730               DO jjf = nys, nyn
     731                   DO iif = nxl, nxr
     732                       DO kkf = bottomz, topz
     733     
     734                           w(kkf,jjf,iif) = wprs(k,jjf,iif) + ( zwf(kkf) - zwc(k) ) &
     735                               * ( wprs(k+1,jjf,iif) - wprs(k,jjf,iif) ) / dzc
    692736     
    693737                       END DO
    … …  
    697741           END DO
    698742     
    699            DO jf = nys, nyn
    700                DO if = nxl, nxr
    701      
    702                    w(nzt,jf,if) = wprs(nztop,jf,if)
     743           DO jjf = nys, nyn
     744               DO iif = nxl, nxr
     745     
     746                   w(nzt,jjf,iif) = wprs(nztop,jjf,iif)
    703747       
    704748               END DO
    … …  
    709753           DEALLOCATE( wprf, wprs )
    710754     
    711 #endif
    712755       END SUBROUTINE interpolate_to_fine_w
    713756     
    714757       SUBROUTINE interpolate_to_fine_u( tag )
    715758     
    716 #if defined( __parallel )
    717759     
    718760           USE arrays_3d
    … …  
    725767           IMPLICIT NONE
    726768     
    727            INTEGER(iwp), intent(in) ::  tag
    728            INTEGER(iwp)                             ::  i, j, k
    729            INTEGER(iwp)                             ::  if, jf, kf
    730            INTEGER(iwp)                             ::  bottomx, topx
    731            INTEGER(iwp)                             ::  bottomy, topy
    732            INTEGER(iwp)                             ::  bottomz, topz
    733            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    734            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  uprs, uprf
    735      
    736            INTEGER(iwp) :: nzbottom, nztop
     769           INTEGER(iwp), intent(in)           :: tag
     770           INTEGER(iwp)                       :: i
     771           INTEGER(iwp)                       :: j
     772           INTEGER(iwp)                       :: k
     773           INTEGER(iwp)                       :: iif
     774           INTEGER(iwp)                       :: jjf
     775           INTEGER(iwp)                       :: kkf
     776           INTEGER(iwp)                       :: nzbottom
     777           INTEGER(iwp)                       :: nztop
     778           INTEGER(iwp)                       :: bottomx
     779           INTEGER(iwp)                       :: bottomy
     780           INTEGER(iwp)                       :: bottomz
     781           INTEGER(iwp)                       :: topx
     782           INTEGER(iwp)                       :: topy
     783           INTEGER(iwp)                       :: topz
     784           REAL(wp)                           :: eps
     785           REAL(wp)                           :: alpha
     786           REAL(wp)                           :: eminus
     787           REAL(wp)                           :: edot
     788           REAL(wp)                           :: eplus
     789           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprf
     790           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprs
     791     
    737792     
    738793     
    … …  
    756811     
    757812                   DO i = bdims_rem(1,1)-1, bdims_rem(1,2)+1
    758                        DO jf = bottomy, topy
    759      
    760                            eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     813                       DO jjf = bottomy, topy
     814     
     815                           eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    761816                           alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    762817                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    764819                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    765820     
    766                            uprf(k,jf,i) = eminus * work3d(k,j-1,i) &
     821                           uprf(k,jjf,i) = eminus * work3d(k,j-1,i) &
    767822                               + edot  * work3d(k,j,i)   &
    768823                               + eplus  * work3d(k,j+1,i)
    … …  
    782837               topz    = (dzc/dzf) * k
    783838     
    784                DO jf = nys, nyn
     839               DO jjf = nys, nyn
    785840                   DO i = bdims_rem(1,1)-1, bdims_rem(1,2)+1
    786                        DO kf = bottomz, topz
     841                       DO kkf = bottomz, topz
    787842                     
    788                            eps    = ( zuf(kf) - zuc(k) ) / dzc
     843                           eps    = ( zuf(kkf) - zuc(k) ) / dzc
    789844                           alpha  = ( ( dzf / dzc )**2.0 - 1.0 ) / 24.0
    790845                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    792847                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    793848     
    794                            uprs(kf,jf,i) = eminus * uprf(k-1,jf,i) &
    795                                + edot  * uprf(k,jf,i)   &
    796                                + eplus  * uprf(k+1,jf,i)
     849                           uprs(kkf,jjf,i) = eminus * uprf(k-1,jjf,i) &
     850                               + edot  * uprf(k,jjf,i)   &
     851                               + eplus  * uprf(k+1,jjf,i)
    797852     
    798853                       END DO
    … …  
    802857           END DO
    803858     
    804            DO jf = nys, nyn
     859           DO jjf = nys, nyn
    805860               DO i = bdims_rem(1,1)-1, bdims_rem(1,2)+1
    806861     
    … …  
    811866                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    812867     
    813                    uprs(nzt+1,jf,i)  = eminus * uprf(nztop,jf,i)   &
    814                        + edot  * uprf(nztop+1,jf,i) &
    815                        + eplus  * uprf(nztop+2,jf,i)
     868                   uprs(nzt+1,jjf,i)  = eminus * uprf(nztop,jjf,i)   &
     869                       + edot  * uprf(nztop+1,jjf,i) &
     870                       + eplus  * uprf(nztop+2,jjf,i)
    816871     
    817872               END DO
    … …  
    821876           !-- Interpolation in x-direction (linear)
    822877     
    823            DO kf = nzb+1, nzt+1
    824                DO jf = nys, nyn
     878           DO kkf = nzb+1, nzt+1
     879               DO jjf = nys, nyn
    825880                   DO i = bdims_rem(1,1), bdims_rem(1,2)
    826881     
    … …  
    828883                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    829884     
    830                        DO if = bottomx, topx
    831                            u(kf,jf,if)  = uprs(kf,jf,i) + ( if * dxf - i * dxc ) &
    832                                * ( uprs(kf,jf,i+1) - uprs(kf,jf,i) ) / dxc
     885                       DO iif = bottomx, topx
     886                           u(kkf,jjf,iif)  = uprs(kkf,jjf,i) + ( iif * dxf - i * dxc ) &
     887                               * ( uprs(kkf,jjf,i+1) - uprs(kkf,jjf,i) ) / dxc
    833888                       END DO
    834889     
    … …  
    843898           DEALLOCATE( uprf, uprs )
    844899     
    845 #endif
    846900       END SUBROUTINE interpolate_to_fine_u
    847901     
    … …  
    849903       SUBROUTINE interpolate_to_fine_v( tag )
    850904     
    851 #if defined( __parallel )
    852905     
    853906           USE arrays_3d
    … …  
    859912     
    860913           IMPLICIT NONE
     914
     915           INTEGER(iwp), intent(in)           :: tag
     916           INTEGER(iwp)                       :: i
     917           INTEGER(iwp)                       :: j
     918           INTEGER(iwp)                       :: k
     919           INTEGER(iwp)                       :: iif
     920           INTEGER(iwp)                       :: jjf
     921           INTEGER(iwp)                       :: kkf
     922           INTEGER(iwp)                       :: nzbottom
     923           INTEGER(iwp)                       :: nztop
     924           INTEGER(iwp)                       :: bottomx
     925           INTEGER(iwp)                       :: bottomy
     926           INTEGER(iwp)                       :: bottomz
     927           INTEGER(iwp)                       :: topx
     928           INTEGER(iwp)                       :: topy
     929           INTEGER(iwp)                       :: topz
     930           REAL(wp)                           :: eps
     931           REAL(wp)                           :: alpha
     932           REAL(wp)                           :: eminus
     933           REAL(wp)                           :: edot
     934           REAL(wp)                           :: eplus
     935           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprs 
     936           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf
    861937         
    862            INTEGER(iwp), intent(in) ::  tag
    863            INTEGER(iwp)                             ::  i, j, k
    864            INTEGER(iwp)                             ::  if, jf, kf
    865            INTEGER(iwp)                             ::  bottomx, topx
    866            INTEGER(iwp)                             ::  bottomy, topy
    867            INTEGER(iwp)                             ::  bottomz, topz
    868            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    869            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  vprs, vprf
    870      
    871            INTEGER(iwp) :: nzbottom, nztop
    872      
    873938     
    874939           nzbottom = bdims_rem (3,1)
    … …  
    890955                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    891956     
    892                        DO if = bottomx, topx
    893      
    894                            eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     957                       DO iif = bottomx, topx
     958     
     959                           eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    895960                           alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    896961                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    898963                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    899964     
    900                            vprf(k,j,if) = eminus * work3d(k,j,i-1) &
     965                           vprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    901966                               + edot  * work3d(k,j,i)   &
    902967                               + eplus  * work3d(k,j,i+1)
    … …  
    917982     
    918983               DO j = bdims_rem(2,1)-1, bdims_rem(2,2)+1
    919                    DO if = nxl, nxr
    920                        DO kf = bottomz, topz
    921      
    922                            eps    = ( zuf(kf) - zuc(k) ) / dzc
     984                   DO iif = nxl, nxr
     985                       DO kkf = bottomz, topz
     986     
     987                           eps    = ( zuf(kkf) - zuc(k) ) / dzc
    923988                           alpha  = ( ( dzf / dzc )**2.0 - 1.0 ) / 24.0
    924989                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    926991                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    927992     
    928                            vprs(kf,j,if) = eminus * vprf(k-1,j,if) &
    929                                + edot  * vprf(k,j,if)   &
    930                                + eplus  * vprf(k+1,j,if)
     993                           vprs(kkf,j,iif) = eminus * vprf(k-1,j,iif) &
     994                               + edot  * vprf(k,j,iif)   &
     995                               + eplus  * vprf(k+1,j,iif)
    931996     
    932997                       END DO
    … …  
    9371002             
    9381003           DO j = bdims_rem(2,1)-1, bdims_rem(2,2)+1
    939                DO if = nxl, nxr
     1004               DO iif = nxl, nxr
    9401005     
    9411006                   eps    = ( zuf(nzt+1) - zuc(nztop+1) ) / dzc
    … …  
    9451010                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    9461011     
    947                    vprs(nzt+1,j,if)  = eminus * vprf(nztop,j,if)   &
    948                        + edot  * vprf(nztop+1,j,if) &
    949                        + eplus  * vprf(nztop+2,j,if)
     1012                   vprs(nzt+1,j,iif)  = eminus * vprf(nztop,j,iif)   &
     1013                       + edot  * vprf(nztop+1,j,iif) &
     1014                       + eplus  * vprf(nztop+2,j,iif)
    9501015     
    9511016               END DO
    … …  
    9551020           !-- Interpolation in y-direction (linear)
    9561021     
    957            DO kf = nzb+1, nzt+1
     1022           DO kkf = nzb+1, nzt+1
    9581023               DO j = bdims_rem(2,1), bdims_rem(2,2)
    9591024     
    … …  
    9611026                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    9621027     
    963                    DO if = nxl, nxr
    964                        DO jf = bottomy, topy
    965                            v (kf,jf,if) = vprs(kf,j,if) + ( jf * dyf - j * dyc ) &
    966                                * ( vprs(kf,j+1,if) - vprs(kf,j,if) ) / dyc
     1028                   DO iif = nxl, nxr
     1029                       DO jjf = bottomy, topy
     1030                           v (kkf,jjf,iif) = vprs(kkf,j,iif) + ( jjf * dyf - j * dyc ) &
     1031                               * ( vprs(kkf,j+1,iif) - vprs(kkf,j,iif) ) / dyc
    9671032                       END DO
    9681033                   END DO
    … …  
    9771042           DEALLOCATE( vprf, vprs )
    9781043     
    979 #endif
    9801044       END SUBROUTINE interpolate_to_fine_v
    9811045     
    … …  
    9831047       SUBROUTINE interpolate_to_fine_s( tag )
    9841048     
    985 #if defined( __parallel )
    9861049     
    9871050           USE arrays_3d
    … …  
    9931056     
    9941057           IMPLICIT NONE
    995      
    996          
    997            INTEGER(iwp), intent(in) ::  tag
    998            INTEGER(iwp)                             ::  i, j, k
    999            INTEGER(iwp)                             ::  if, jf, kf
    1000            INTEGER(iwp)                             ::  bottomx, topx
    1001            INTEGER(iwp)                             ::  bottomy, topy
    1002            INTEGER(iwp)                             ::  bottomz, topz
    1003            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1004            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprs, ptprf
    1005      
    1006            INTEGER(iwp) :: nzbottom, nztop
     1058
     1059           INTEGER(iwp), intent(in)           :: tag
     1060           INTEGER(iwp)                       :: i
     1061           INTEGER(iwp)                       :: j
     1062           INTEGER(iwp)                       :: k
     1063           INTEGER(iwp)                       :: iif
     1064           INTEGER(iwp)                       :: jjf
     1065           INTEGER(iwp)                       :: kkf
     1066           INTEGER(iwp)                       :: nzbottom
     1067           INTEGER(iwp)                       :: nztop
     1068           INTEGER(iwp)                       :: bottomx
     1069           INTEGER(iwp)                       :: bottomy
     1070           INTEGER(iwp)                       :: bottomz
     1071           INTEGER(iwp)                       :: topx
     1072           INTEGER(iwp)                       :: topy
     1073           INTEGER(iwp)                       :: topz
     1074           REAL(wp)                           :: eps
     1075           REAL(wp)                           :: alpha
     1076           REAL(wp)                           :: eminus
     1077           REAL(wp)                           :: edot
     1078           REAL(wp)                           :: eplus
     1079           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     1080           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
    10071081     
    10081082     
    … …  
    10261100                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    10271101     
    1028                        DO if = bottomx, topx
    1029      
    1030                            eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     1102                       DO iif = bottomx, topx
     1103     
     1104                           eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    10311105                           alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    10321106                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    10341108                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    10351109     
    1036                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     1110                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    10371111                               + edot  * work3d(k,j,i)   &
    10381112                               + eplus  * work3d(k,j,i+1)
    … …  
    10521126                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    10531127     
    1054                    DO if = nxl, nxr
    1055                        DO jf = bottomy, topy
    1056      
    1057                            eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     1128                   DO iif = nxl, nxr
     1129                       DO jjf = bottomy, topy
     1130     
     1131                           eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    10581132                           alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    10591133                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    10611135                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    10621136     
    1063                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    1064                                + edot  * ptprf(k,j,if)   &
    1065                                + eplus  * ptprf(k,j+1,if)
     1137                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     1138                               + edot  * ptprf(k,j,iif)   &
     1139                               + eplus  * ptprf(k,j+1,iif)
    10661140     
    10671141                       END DO
    … …  
    10791153               topz    = (dzc/dzf) * k
    10801154     
    1081                DO jf = nys, nyn
    1082                    DO if = nxl, nxr
    1083                        DO kf = bottomz, topz
     1155               DO jjf = nys, nyn
     1156                   DO iif = nxl, nxr
     1157                       DO kkf = bottomz, topz
    10841158                       
    1085                            eps    = ( zuf(kf) - zuc(k) ) / dzc
     1159                           eps    = ( zuf(kkf) - zuc(k) ) / dzc
    10861160                           alpha  = ( ( dzf / dzc )**2.0 - 1.0 ) / 24.0
    10871161                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    10891163                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    10901164       
    1091                            interpol3d(kf,jf,if) = eminus * ptprs(k-1,jf,if) &
    1092                                + edot  * ptprs(k,jf,if)   &
    1093                                + eplus  * ptprs(k+1,jf,if)
     1165                           interpol3d(kkf,jjf,iif) = eminus * ptprs(k-1,jjf,iif) &
     1166                               + edot  * ptprs(k,jjf,iif)   &
     1167                               + eplus  * ptprs(k+1,jjf,iif)
    10941168     
    10951169                       END DO
    … …  
    10991173           END DO
    11001174               
    1101            DO jf = nys, nyn
    1102                DO if = nxl, nxr
     1175           DO jjf = nys, nyn
     1176               DO iif = nxl, nxr
    11031177     
    11041178                   eps    = ( zuf(nzt+1) - zuc(nztop+1) ) / dzc
    … …  
    11081182                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    11091183     
    1110                    interpol3d(nzt+1,jf,if) = eminus * ptprs(nztop,jf,if)   &
    1111                        + edot  * ptprs(nztop+1,jf,if) &
    1112                        + eplus  * ptprs(nztop+2,jf,if)
     1184                   interpol3d(nzt+1,jjf,iif) = eminus * ptprs(nztop,jjf,iif)   &
     1185                       + edot  * ptprs(nztop+1,jjf,iif) &
     1186                       + eplus  * ptprs(nztop+2,jjf,iif)
    11131187     
    11141188               END DO
    … …  
    11181192           DEALLOCATE( ptprf, ptprs )
    11191193     
    1120 #endif
    11211194       END SUBROUTINE interpolate_to_fine_s
    11221195     
    … …  
    11241197       SUBROUTINE interpolate_to_fine_kh( tag )
    11251198     
    1126 #if defined( __parallel )
    11271199     
    11281200           USE arrays_3d
    … …  
    11341206     
    11351207           IMPLICIT NONE
    1136      
    1137          
    1138            INTEGER(iwp), intent(in) ::  tag
    1139            INTEGER(iwp)                             ::  i, j, k
    1140            INTEGER(iwp)                             ::  if, jf, kf
    1141            INTEGER(iwp)                             ::  bottomx, topx
    1142            INTEGER(iwp)                             ::  bottomy, topy
    1143            INTEGER(iwp)                             ::  bottomz, topz
    1144            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1145            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  uprs, uprf
    1146            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  vprs, vprf
    1147            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  wprs, wprf
    1148            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprs, ptprf
    1149            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  eprs, eprf
    1150            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  kmprs, kmprf
    1151            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  khprs, khprf
    1152            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  shfpr, uswspr, vswspr
    1153            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tspr, uspr, z0pr
    1154      
    1155            INTEGER(iwp) :: nzbottom, nztop
     1208
     1209           INTEGER(iwp), intent(in)           :: tag
     1210           INTEGER(iwp)                       :: i
     1211           INTEGER(iwp)                       :: j
     1212           INTEGER(iwp)                       :: k
     1213           INTEGER(iwp)                       :: iif
     1214           INTEGER(iwp)                       :: jjf
     1215           INTEGER(iwp)                       :: kkf
     1216           INTEGER(iwp)                       :: nzbottom
     1217           INTEGER(iwp)                       :: nztop
     1218           INTEGER(iwp)                       :: bottomx
     1219           INTEGER(iwp)                       :: bottomy
     1220           INTEGER(iwp)                       :: bottomz
     1221           INTEGER(iwp)                       :: topx
     1222           INTEGER(iwp)                       :: topy
     1223           INTEGER(iwp)                       :: topz
     1224           REAL(wp)                           :: eps
     1225           REAL(wp)                           :: alpha
     1226           REAL(wp)                           :: eminus
     1227           REAL(wp)                           :: edot
     1228           REAL(wp)                           :: eplus
     1229           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprs
     1230           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprs
     1231           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprs
     1232           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     1233           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprs
     1234           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprs
     1235           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprs
     1236           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: tspr
     1237           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprf
     1238           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf
     1239           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprf
     1240           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
     1241           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprf
     1242           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprf
     1243           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprf
     1244           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uswspr
     1245           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: vswspr
     1246           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uspr
    11561247     
    11571248     
    … …  
    11781269                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    11791270     
    1180                        DO if = bottomx, topx
    1181      
    1182                            eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     1271                       DO iif = bottomx, topx
     1272     
     1273                           eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    11831274                           alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    11841275                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    11861277                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    11871278     
    1188                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     1279                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    11891280                               + edot  * work3d(k,j,i)   &
    11901281                               + eplus  * work3d(k,j,i+1)
    … …  
    12041295                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    12051296     
    1206                    DO if = nxl, nxr
    1207                        DO jf = bottomy, topy
    1208      
    1209                            eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     1297                   DO iif = nxl, nxr
     1298                       DO jjf = bottomy, topy
     1299     
     1300                           eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    12101301                           alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    12111302                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    12131304                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    12141305     
    1215                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    1216                                + edot  * ptprf(k,j,if)   &
    1217                                + eplus  * ptprf(k,j+1,if)
     1306                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     1307                               + edot  * ptprf(k,j,iif)   &
     1308                               + eplus  * ptprf(k,j+1,iif)
    12181309     
    12191310                       END DO
    … …  
    12311322               topz    = (dzc/dzf) * k
    12321323     
    1233                DO jf = nys, nyn
    1234                    DO if = nxl, nxr
    1235                        DO kf = bottomz, topz
     1324               DO jjf = nys, nyn
     1325                   DO iif = nxl, nxr
     1326                       DO kkf = bottomz, topz
    12361327                       
    1237                            eps    = ( zuf(kf) - zuc(k) ) / dzc
     1328                           eps    = ( zuf(kkf) - zuc(k) ) / dzc
    12381329                           alpha  = ( ( dzf / dzc )**2.0 - 1.0 ) / 24.0
    12391330                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    12411332                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    12421333       
    1243                            kh(kf,jf,if) = eminus * ptprs(k-1,jf,if) &
    1244                                + edot  * ptprs(k,jf,if)   &
    1245                                + eplus  * ptprs(k+1,jf,if)
     1334                           kh(kkf,jjf,iif) = eminus * ptprs(k-1,jjf,iif) &
     1335                               + edot  * ptprs(k,jjf,iif)   &
     1336                               + eplus  * ptprs(k+1,jjf,iif)
    12461337     
    12471338                       END DO
    … …  
    12511342           END DO
    12521343               
    1253            DO jf = nys, nyn
    1254                DO if = nxl, nxr
     1344           DO jjf = nys, nyn
     1345               DO iif = nxl, nxr
    12551346     
    12561347                   eps    = ( zuf(nzt+1) - zuc(nztop+1) ) / dzc
    … …  
    12601351                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    12611352     
    1262                    kh(nzt+1,jf,if) = eminus * ptprs(nztop,jf,if)   &
    1263                        + edot  * ptprs(nztop+1,jf,if) &
    1264                        + eplus  * ptprs(nztop+2,jf,if)
     1353                   kh(nzt+1,jjf,iif) = eminus * ptprs(nztop,jjf,iif)   &
     1354                       + edot  * ptprs(nztop+1,jjf,iif) &
     1355                       + eplus  * ptprs(nztop+2,jjf,iif)
    12651356     
    12661357               END DO
    … …  
    12701361           DEALLOCATE( ptprf, ptprs )
    12711362     
    1272 #endif
    12731363       END SUBROUTINE interpolate_to_fine_kh
    12741364     
    12751365       SUBROUTINE interpolate_to_fine_km( tag )
    12761366     
    1277 #if defined( __parallel )
    12781367     
    12791368           USE arrays_3d
    … …  
    12851374     
    12861375           IMPLICIT NONE
    1287      
    1288          
    1289            INTEGER(iwp), intent(in) ::  tag
    1290            INTEGER(iwp)                             ::  i, j, k
    1291            INTEGER(iwp)                             ::  if, jf, kf
    1292            INTEGER(iwp)                             ::  bottomx, topx
    1293            INTEGER(iwp)                             ::  bottomy, topy
    1294            INTEGER(iwp)                             ::  bottomz, topz
    1295            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1296            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  uprs, uprf
    1297            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  vprs, vprf
    1298            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  wprs, wprf
    1299            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprs, ptprf
    1300            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  eprs, eprf
    1301            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  kmprs, kmprf
    1302            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  khprs, khprf
    1303            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  shfpr, uswspr, vswspr
    1304            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tspr, uspr, z0pr
    1305      
    1306            INTEGER(iwp) :: nzbottom, nztop
     1376
     1377           INTEGER(iwp), intent(in)           :: tag
     1378           INTEGER(iwp)                       :: i
     1379           INTEGER(iwp)                       :: j
     1380           INTEGER(iwp)                       :: k
     1381           INTEGER(iwp)                       :: iif
     1382           INTEGER(iwp)                       :: jjf
     1383           INTEGER(iwp)                       :: kkf
     1384           INTEGER(iwp)                       :: nzbottom
     1385           INTEGER(iwp)                       :: nztop
     1386           INTEGER(iwp)                       :: bottomx
     1387           INTEGER(iwp)                       :: bottomy
     1388           INTEGER(iwp)                       :: bottomz
     1389           INTEGER(iwp)                       :: topx
     1390           INTEGER(iwp)                       :: topy
     1391           INTEGER(iwp)                       :: topz
     1392           REAL(wp)                           :: eps
     1393           REAL(wp)                           :: alpha
     1394           REAL(wp)                           :: eminus
     1395           REAL(wp)                           :: edot
     1396           REAL(wp)                           :: eplus
     1397           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprs
     1398           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprs
     1399           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprs
     1400           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     1401           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprs
     1402           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprs
     1403           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprs
     1404           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf
     1405           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprf
     1406           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
     1407           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprf
     1408           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprf
     1409           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprf
     1410           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uswspr
     1411           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: vswspr
     1412           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: tspr
     1413           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uspr
    13071414     
    13081415     
    … …  
    13291436                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    13301437     
    1331                        DO if = bottomx, topx
    1332      
    1333                            eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     1438                       DO iif = bottomx, topx
     1439     
     1440                           eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    13341441                           alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    13351442                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    13371444                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    13381445     
    1339                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     1446                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    13401447                               + edot  * work3d(k,j,i)   &
    13411448                               + eplus  * work3d(k,j,i+1)
    … …  
    13551462                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    13561463     
    1357                    DO if = nxl, nxr
    1358                        DO jf = bottomy, topy
    1359      
    1360                            eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     1464                   DO iif = nxl, nxr
     1465                       DO jjf = bottomy, topy
     1466     
     1467                           eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    13611468                           alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    13621469                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    13641471                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    13651472     
    1366                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    1367                                + edot  * ptprf(k,j,if)   &
    1368                                + eplus  * ptprf(k,j+1,if)
     1473                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     1474                               + edot  * ptprf(k,j,iif)   &
     1475                               + eplus  * ptprf(k,j+1,iif)
    13691476     
    13701477                       END DO
    … …  
    13821489               topz    = (dzc/dzf) * k
    13831490     
    1384                DO jf = nys, nyn
    1385                    DO if = nxl, nxr
    1386                        DO kf = bottomz, topz
     1491               DO jjf = nys, nyn
     1492                   DO iif = nxl, nxr
     1493                       DO kkf = bottomz, topz
    13871494                       
    1388                            eps    = ( zuf(kf) - zuc(k) ) / dzc
     1495                           eps    = ( zuf(kkf) - zuc(k) ) / dzc
    13891496                           alpha  = ( ( dzf / dzc )**2.0 - 1.0 ) / 24.0
    13901497                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    13921499                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    13931500       
    1394                            km(kf,jf,if) = eminus * ptprs(k-1,jf,if) &
    1395                                + edot  * ptprs(k,jf,if)   &
    1396                                + eplus  * ptprs(k+1,jf,if)
     1501                           km(kkf,jjf,iif) = eminus * ptprs(k-1,jjf,iif) &
     1502                               + edot  * ptprs(k,jjf,iif)   &
     1503                               + eplus  * ptprs(k+1,jjf,iif)
    13971504     
    13981505                       END DO
    … …  
    14021509           END DO
    14031510               
    1404            DO jf = nys, nyn
    1405                DO if = nxl, nxr
     1511           DO jjf = nys, nyn
     1512               DO iif = nxl, nxr
    14061513     
    14071514                   eps    = ( zuf(nzt+1) - zuc(nztop+1) ) / dzc
    … …  
    14111518                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    14121519     
    1413                    km(nzt+1,jf,if)  = eminus * ptprs(nztop,jf,if)   &
    1414                        + edot  * ptprs(nztop+1,jf,if) &
    1415                        + eplus  * ptprs(nztop+2,jf,if)
     1520                   km(nzt+1,jjf,iif)  = eminus * ptprs(nztop,jjf,iif)   &
     1521                       + edot  * ptprs(nztop+1,jjf,iif) &
     1522                       + eplus  * ptprs(nztop+2,jjf,iif)
    14161523     
    14171524               END DO
    … …  
    14211528           DEALLOCATE( ptprf, ptprs )
    14221529     
    1423 #endif
    14241530       END SUBROUTINE interpolate_to_fine_km
    14251531     
    … …  
    14291535       SUBROUTINE interpolate_to_fine_flux( tag )
    14301536     
    1431 #if defined( __parallel )
    14321537     
    14331538           USE arrays_3d
    … …  
    14391544     
    14401545           IMPLICIT NONE
    1441      
    1442          
    1443            INTEGER(iwp), intent(in) ::  tag
    1444            INTEGER(iwp)                             ::  i, j, k
    1445            INTEGER(iwp)                             ::  if, jf, kf
    1446            INTEGER(iwp)                             ::  bottomx, topx
    1447            INTEGER(iwp)                             ::  bottomy, topy
    1448            INTEGER(iwp)                             ::  bottomz, topz
    1449            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1450            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  shfpr, uswspr, vswspr
    1451            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  tspr, uspr, z0pr
    1452      
    1453      
    1454            INTEGER(iwp) :: nzbottom, nztop
    1455      
    1456            ALLOCATE( shfpr (bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
     1546
     1547           INTEGER(iwp), intent(in)           :: tag
     1548           INTEGER(iwp)                       :: i
     1549           INTEGER(iwp)                       :: j
     1550           INTEGER(iwp)                       :: k
     1551           INTEGER(iwp)                       :: iif
     1552           INTEGER(iwp)                       :: jjf
     1553           INTEGER(iwp)                       :: kkf
     1554           INTEGER(iwp)                       :: nzbottom
     1555           INTEGER(iwp)                       :: nztop
     1556           INTEGER(iwp)                       :: bottomx
     1557           INTEGER(iwp)                       :: bottomy
     1558           INTEGER(iwp)                       :: bottomz
     1559           INTEGER(iwp)                       :: topx
     1560           INTEGER(iwp)                       :: topy
     1561           INTEGER(iwp)                       :: topz
     1562           REAL(wp)                           :: eps
     1563           REAL(wp)                           :: alpha
     1564           REAL(wp)                           :: eminus
     1565           REAL(wp)                           :: edot
     1566           REAL(wp)                           :: eplus
     1567           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uswspr
     1568           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: vswspr
     1569           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: tspr
     1570           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uspr
     1571     
    14571572           ALLOCATE( uswspr(bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    14581573           ALLOCATE( vswspr(bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    14591574           ALLOCATE( tspr  (bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    14601575           ALLOCATE( uspr  (bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    1461            ALLOCATE( z0pr  (bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    14621576     
    14631577           !
    … …  
    14731587                   topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    14741588     
    1475                    DO if = bottomx, topx
    1476      
    1477                        eps    = ( if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
     1589                   DO iif = bottomx, topx
     1590     
     1591                       eps    = ( iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc ) / dxc
    14781592                       alpha  = ( ( dxf / dxc )**2.0 - 1.0 ) / 24.0
    14791593                       eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    14811595                       eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    14821596     
    1483                        shfpr(j,if)  = eminus * work2dshf(j,i-1) &
    1484                            + edot  * work2dshf(j,i)   &
    1485                            + eplus  * work2dshf(j,i+1)
    1486      
    1487                        uswspr(j,if) = eminus * work2dusws(j,i-1) &
     1597                       uswspr(j,iif) = eminus * work2dusws(j,i-1) &
    14881598                           + edot  * work2dusws(j,i)   &
    14891599                           + eplus  * work2dusws(j,i+1)
    14901600     
    1491                        vswspr(j,if) = eminus * work2dvsws(j,i-1) &
     1601                       vswspr(j,iif) = eminus * work2dvsws(j,i-1) &
    14921602                           + edot  * work2dvsws(j,i)   &
    14931603                           + eplus  * work2dvsws(j,i+1)
    14941604     
    1495                        tspr(j,if)   = eminus * work2dts(j,i-1) &
     1605                       tspr(j,iif)   = eminus * work2dts(j,i-1) &
    14961606                           + edot  * work2dts(j,i)   &
    14971607                           + eplus  * work2dts(j,i+1)
    14981608     
    1499                        uspr(j,if)   = eminus * work2dus(j,i-1) &
     1609                       uspr(j,iif)   = eminus * work2dus(j,i-1) &
    15001610                           + edot  * work2dus(j,i)   &
    15011611                           + eplus  * work2dus(j,i+1)
    1502      
    1503                        z0pr(j,if)   = eminus * work2dz0(j,i-1) &
    1504                            + edot  * work2dz0(j,i)   &
    1505                            + eplus  * work2dz0(j,i+1)
    15061612     
    15071613                   END DO
    … …  
    15181624               topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    15191625     
    1520                DO if = nxl, nxr
    1521                    DO jf = bottomy, topy
    1522      
    1523                        eps    = ( jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
     1626               DO iif = nxl, nxr
     1627                   DO jjf = bottomy, topy
     1628     
     1629                       eps    = ( jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc ) / dyc
    15241630                       alpha  = ( ( dyf / dyc )**2.0 - 1.0 ) / 24.0
    15251631                       eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    15261632                       edot  = ( 1.0 - eps**2.0 ) - 2.0 * alpha
    15271633                       eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    1528      
    1529 !-- WARNING
    1530 !-- shf,z0 not interpolated
    1531 !-- line commented in interpolate_to_fine_flux
    1532 !-- FG needs to read it's own data file     
    1533 !MERGE-WIP!                    surf_def_h(0)%shf(jf,if)  = eminus * shfpr(j-1,if) &
    1534 !MERGE-WIP!                        + edot  * shfpr(j,if)   &
    1535 !MERGE-WIP!                        + eplus  * shfpr(j+1,if)
    1536 !MERGE-WIP   
    1537 !MERGE-WIP                     surf_def_h(0)%usws(jf,if) = eminus * uswspr(j-1,if) &
    1538 !MERGE-WIP                         + edot  * uswspr(j,if)   &
    1539 !MERGE-WIP                         + eplus  * uswspr(j+1,if)
    1540 !MERGE-WIP   
    1541 !MERGE-WIP                     surf_def_h(0)%vsws(jf,if) = eminus * vswspr(j-1,if) &
    1542 !MERGE-WIP                         + edot  * vswspr(j,if)   &
    1543 !MERGE-WIP                         + eplus  * vswspr(j+1,if)
    1544 !MERGE-WIP   
    1545 !MERGE                      ts(jf,if)   = eminus * tspr(j-1,if) &
    1546 !MERGE                          + edot  * tspr(j,if)   &
    1547 !MERGE                          + eplus  * tspr(j+1,if)
    1548 !MERGE     
    1549 !MERGE                      us(jf,if)   = eminus * uspr(j-1,if) &
    1550 !MERGE                          + edot  * uspr(j,if)   &
    1551 !MERGE                          + eplus  * uspr(j+1,if)
    1552 !MERGE     
    1553 !MERGE!                     z0(jf,if)   = eminus * z0pr(j-1,if) &
    1554 !MERGE!                         + edot  * z0pr(j,if)   &
    1555 !MERGE!                         + eplus  * z0pr(j+1,if)
     1634 
     1635!!
     1636!!--   TODO
     1637!--    variables are not compatible with the new surface layer module
     1638!   
     1639!                    surf_def_h(0)%usws(jjf,iif) = eminus * uswspr(j-1,if) &
     1640!                        + edot  * uswspr(j,iif)   &
     1641!                        + eplus  * uswspr(j+1,iif)
     1642!   
     1643!                    surf_def_h(0)%vsws(jjf,iif) = eminus * vswspr(j-1,if) &
     1644!                        + edot  * vswspr(j,iif)   &
     1645!                        + eplus  * vswspr(j+1,iif)
     1646!   
     1647!                    ts(jjf,iif)   = eminus * tspr(j-1,if) &
     1648!                        + edot  * tspr(j,iif)   &
     1649!                        + eplus  * tspr(j+1,iif)
     1650!
     1651!                    us(jjf,iif)   = eminus * uspr(j-1,if) &
     1652!                        + edot  * uspr(j,iif)   &
     1653!                        + eplus  * uspr(j+1,iif)
    15561654     
    15571655                   END DO
    … …  
    15611659     
    15621660     
    1563            DEALLOCATE( shfpr, uswspr, vswspr )
    1564            DEALLOCATE( tspr, uspr, z0pr )
    1565      
    1566      
    1567 #endif
     1661           DEALLOCATE( uswspr, vswspr )
     1662           DEALLOCATE( tspr, uspr )
     1663     
     1664     
    15681665       END SUBROUTINE interpolate_to_fine_flux
    15691666   
    15701667   
     1668#endif       
    15711669    END SUBROUTINE vnest_init_fine
    15721670   
    15731671    SUBROUTINE vnest_boundary_conds
     1672#if defined( __parallel )
    15741673        !------------------------------------------------------------------------------!
    15751674        ! Description:
    … …  
    15911690        IMPLICIT NONE
    15921691   
    1593         INTEGER(iwp) ::  i, j, k
    1594         INTEGER(iwp) ::  if, jf
    1595    
    1596         REAL(wp)    ::  c_max, denom
    1597    
    1598 #if defined( __parallel )
     1692        INTEGER(iwp)                          :: i
     1693        INTEGER(iwp)                          :: j
     1694        INTEGER(iwp)                          :: iif
     1695        INTEGER(iwp)                          :: jjf
     1696        REAL(wp)                              :: c_max
     1697        REAL(wp)                              :: denom
     1698   
    15991699   
    16001700        !
    … …  
    17071807   
    17081808!-- TKE Neumann BC for FG top
    1709             DO jf = nys, nyn
    1710                 DO if = nxl, nxr
    1711                    e(nzt+1,jf,if) = e(nzt,jf,if)
     1809            DO jjf = nys, nyn
     1810                DO iif = nxl, nxr
     1811                   e(nzt+1,jjf,iif) = e(nzt,jjf,iif)
    17121812                END DO
    17131813            END DO
    … …  
    17311831   
    17321832   
    1733 #endif
    17341833    CONTAINS
    17351834   
    17361835       SUBROUTINE vnest_set_topbc_w
    17371836       
    1738 #if defined( __parallel )
    17391837       
    17401838           USE arrays_3d
    … …  
    17461844       
    17471845           IMPLICIT NONE
    1748        
    1749            INTEGER(iwp)                             ::  i, j, k
    1750            INTEGER(iwp)                             ::  if, jf
    1751            INTEGER(iwp)                             ::  bottomx, topx
    1752            INTEGER(iwp)                             ::  bottomy, topy
    1753            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1754            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  wprf
    1755          
     1846
     1847           INTEGER(iwp)                       :: i
     1848           INTEGER(iwp)                       :: j
     1849           INTEGER(iwp)                       :: k
     1850           INTEGER(iwp)                       :: iif
     1851           INTEGER(iwp)                       :: jjf
     1852           INTEGER(iwp)                       :: kkf
     1853           INTEGER(iwp)                       :: bottomx
     1854           INTEGER(iwp)                       :: bottomy
     1855           INTEGER(iwp)                       :: topx
     1856           INTEGER(iwp)                       :: topy
     1857           REAL(wp)                           :: eps
     1858           REAL(wp)                           :: alpha
     1859           REAL(wp)                           :: eminus
     1860           REAL(wp)                           :: edot
     1861           REAL(wp)                           :: eplus
     1862           REAL(wp), DIMENSION(:,:), ALLOCATABLE :: wprf
     1863       
    17561864           
    17571865           ALLOCATE( wprf(bdims_rem(2,1)-1:bdims_rem(2,2)+1,nxl:nxr) )
    … …  
    17731881                   topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    17741882       
    1775                    DO if = bottomx, topx
    1776        
    1777                        eps = (if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
     1883                   DO iif = bottomx, topx
     1884       
     1885                       eps = (iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
    17781886                       alpha = ( (dxf/dxc)**2.0 - 1.0) / 24.0
    17791887                       eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    17801888                       edot  = ( 1.0 - eps**2.0 ) - 2.0 * alpha
    17811889                       eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    1782                        wprf(j,if) = eminus * work3d(bdims_rem(3,1),j,i-1) &
     1890                       wprf(j,iif) = eminus * work3d(bdims_rem(3,1),j,i-1) &
    17831891                           + edot  * work3d(bdims_rem(3,1),j,i)   &
    17841892                           + eplus  * work3d(bdims_rem(3,1),j,i+1)
    … …  
    17981906               topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    17991907       
    1800                DO if = nxl, nxr
    1801        
    1802                    DO jf = bottomy, topy
    1803        
    1804                        eps = (jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
     1908               DO iif = nxl, nxr
     1909       
     1910                   DO jjf = bottomy, topy
     1911       
     1912                       eps = (jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
    18051913       
    18061914                       alpha = ( (dyf/dyc)**2.0 - 1.0) / 24.0
    … …  
    18121920                       eplus = eps * ( eps + 1.0 ) / 2.0 + alpha
    18131921       
    1814                        w(nzt,jf,if) = eminus * wprf(j-1,if) &
    1815                            + edot  * wprf(j,if)   &
    1816                            + eplus  * wprf(j+1,if)
     1922                       w(nzt,jjf,iif) = eminus * wprf(j-1,iif) &
     1923                           + edot  * wprf(j,iif)   &
     1924                           + eplus  * wprf(j+1,iif)
    18171925       
    18181926                   END DO
    … …  
    18231931
    18241932           DEALLOCATE( wprf )
    1825 #endif
    18261933       
    18271934       END SUBROUTINE vnest_set_topbc_w
    … …  
    18301937       SUBROUTINE vnest_set_topbc_u
    18311938       
    1832 #if defined( __parallel )
    18331939       
    18341940           USE arrays_3d
    … …  
    18401946       
    18411947           IMPLICIT NONE
    1842        
    1843            INTEGER(iwp)                             ::  i, j, k
    1844            INTEGER(iwp)                             ::  if, jf
    1845            INTEGER(iwp)                             ::  bottomx, topx
    1846            INTEGER(iwp)                             ::  bottomy, topy
    1847            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1848            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  uprf
    1849            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  uprs
    1850          
    1851            
     1948
     1949           INTEGER(iwp)                       :: i
     1950           INTEGER(iwp)                       :: j
     1951           INTEGER(iwp)                       :: k
     1952           INTEGER(iwp)                       :: iif
     1953           INTEGER(iwp)                       :: jjf
     1954           INTEGER(iwp)                       :: kkf
     1955           INTEGER(iwp)                       :: bottomx
     1956           INTEGER(iwp)                       :: bottomy
     1957           INTEGER(iwp)                       :: topx
     1958           INTEGER(iwp)                       :: topy
     1959           REAL(wp)                           :: eps
     1960           REAL(wp)                           :: alpha
     1961           REAL(wp)                           :: eminus
     1962           REAL(wp)                           :: edot
     1963           REAL(wp)                           :: eplus
     1964           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprf
     1965           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: uprs
    18521966       
    18531967           ALLOCATE( uprf(bdims_rem(3,1):bdims_rem(3,2),nys:nyn,bdims_rem(1,1)-1:bdims_rem(1,2)+1) )
    … …  
    18651979       
    18661980                   DO i = bdims_rem(1,1)-1, bdims_rem(1,2)+1
    1867                        DO jf = bottomy, topy
    1868        
    1869                            eps = (jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
     1981                       DO jjf = bottomy, topy
     1982       
     1983                           eps = (jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
    18701984                           alpha = ( (dyf/dyc)**2.0 - 1.0) / 24.0
    18711985                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    … …  
    18731987                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    18741988       
    1875                            uprf(k,jf,i) = eminus * work3d(k,j-1,i) &
     1989                           uprf(k,jjf,i) = eminus * work3d(k,j-1,i) &
    18761990                               + edot  * work3d(k,j,i)   &
    18771991                               + eplus  * work3d(k,j+1,i)
    … …  
    18851999           !-- Interpolation in z-direction
    18862000       
    1887            DO jf = nys, nyn
     2001           DO jjf = nys, nyn
    18882002               DO i = bdims_rem(1,1)-1, bdims_rem(1,2)+1
    18892003                   eps = ( zuf(nzt+1) - zuc(bdims_rem(3,1)+1) ) / dzc
    … …  
    18922006                   edot  = ( 1.0 - eps**2.0 ) - 2.0 * alpha
    18932007                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    1894                    uprs(jf,i) = eminus * uprf(bdims_rem(3,1),jf,i)   &
    1895                        + edot  * uprf(bdims_rem(3,1)+1,jf,i) &
    1896                        + eplus  * uprf(bdims_rem(3,1)+2,jf,i)
     2008                   uprs(jjf,i) = eminus * uprf(bdims_rem(3,1),jjf,i)   &
     2009                       + edot  * uprf(bdims_rem(3,1)+1,jjf,i) &
     2010                       + eplus  * uprf(bdims_rem(3,1)+2,jjf,i)
    18972011               END DO
    18982012           END DO
    … …  
    19012015           !-- Interpolation in x-direction
    19022016       
    1903            DO jf = nys, nyn
     2017           DO jjf = nys, nyn
    19042018               DO i = bdims_rem(1,1), bdims_rem(1,2)
    19052019       
    … …  
    19072021                   topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    19082022       
    1909                    DO if = bottomx, topx
    1910                        u(nzt+1,jf,if) = uprs(jf,i) + ( if * dxf - i * dxc ) * ( uprs(jf,i+1) - uprs(jf,i) ) / dxc
     2023                   DO iif = bottomx, topx
     2024                       u(nzt+1,jjf,iif) = uprs(jjf,i) + ( iif * dxf - i * dxc ) * ( uprs(jjf,i+1) - uprs(jjf,i) ) / dxc
    19112025                   END DO
    19122026       
    … …  
    19172031       
    19182032           DEALLOCATE ( uprf, uprs )
    1919 #endif
    19202033       
    19212034       END SUBROUTINE vnest_set_topbc_u
    … …  
    19242037       SUBROUTINE vnest_set_topbc_v
    19252038       
    1926 #if defined( __parallel )
    19272039       
    19282040           USE arrays_3d
    … …  
    19342046       
    19352047           IMPLICIT NONE
    1936        
    1937            INTEGER(iwp)                             ::  i, j, k
    1938            INTEGER(iwp)                             ::  if, jf
    1939            INTEGER(iwp)                             ::  bottomx, topx
    1940            INTEGER(iwp)                             ::  bottomy, topy
    1941            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    1942            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  vprf
    1943            REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::  vprs
     2048
     2049           INTEGER(iwp)                       :: i
     2050           INTEGER(iwp)                       :: j
     2051           INTEGER(iwp)                       :: k
     2052           INTEGER(iwp)                       :: iif
     2053           INTEGER(iwp)                       :: jjf
     2054           INTEGER(iwp)                       :: kkf
     2055           INTEGER(iwp)                       :: bottomx
     2056           INTEGER(iwp)                       :: bottomy
     2057           INTEGER(iwp)                       :: topx
     2058           INTEGER(iwp)                       :: topy
     2059           REAL(wp)                           :: eps
     2060           REAL(wp)                           :: alpha
     2061           REAL(wp)                           :: eminus
     2062           REAL(wp)                           :: edot
     2063           REAL(wp)                           :: eplus
     2064           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf
     2065           REAL(wp), DIMENSION(:,:), ALLOCATABLE   :: vprs
    19442066         
    19452067           
    … …  
    19632085                       topx    = (nxf+1)/(nxc+1) * (i+1) - 1
    19642086       
    1965                        DO if = bottomx, topx
    1966        
    1967                            eps = (if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
     2087                       DO iif = bottomx, topx
     2088       
     2089                           eps = (iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
    19682090                           alpha = ( (dxf/dxc)**2.0 - 1.0) / 24.0
    19692091                           eminus = eps * ( eps - 1.0 ) / 2.0 + alpha
    19702092                           edot  = ( 1.0 - eps**2.0 ) - 2.0 * alpha
    19712093                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    1972                            vprf(k,j,if) = eminus * work3d(k,j,i-1) &
     2094                           vprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    19732095                               + edot  * work3d(k,j,i)   &
    19742096                               + eplus  * work3d(k,j,i+1)
    … …  
    19832105       
    19842106           DO j = bdims_rem(2,1)-1, bdims_rem(2,2)+1
    1985                DO if = nxl, nxr
     2107               DO iif = nxl, nxr
    19862108       
    19872109                   eps = ( zuf(nzt+1) - zuc(bdims_rem(3,1)+1) ) / dzc
    … …  
    19902112                   edot  = ( 1.0 - eps**2.0 ) - 2.0 * alpha
    19912113                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    1992                    vprs(j,if) = eminus * vprf(bdims_rem(3,1),j,if)   &
    1993                        + edot  * vprf(bdims_rem(3,1)+1,j,if) &
    1994                        + eplus  * vprf(bdims_rem(3,1)+2,j,if)
     2114                   vprs(j,iif) = eminus * vprf(bdims_rem(3,1),j,iif)   &
     2115                       + edot  * vprf(bdims_rem(3,1)+1,j,iif) &
     2116                       + eplus  * vprf(bdims_rem(3,1)+2,j,iif)
    19952117       
    19962118               END DO
    … …  
    20012123       
    20022124           DO j = bdims_rem(2,1), bdims_rem(2,2)
    2003                DO if = nxl, nxr
     2125               DO iif = nxl, nxr
    20042126       
    20052127                   bottomy = (nyf+1)/(nyc+1) * j
    20062128                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    20072129       
    2008                    DO jf = bottomy, topy
    2009        
    2010                        v(nzt+1,jf,if) = vprs(j,if) + ( jf * dyf - j * dyc ) * ( vprs(j+1,if) - vprs(j,if) ) / dyc
     2130                   DO jjf = bottomy, topy
     2131       
     2132                       v(nzt+1,jjf,iif) = vprs(j,iif) + ( jjf * dyf - j * dyc ) * ( vprs(j+1,iif) - vprs(j,iif) ) / dyc
    20112133       
    20122134                   END DO
    … …  
    20182140       
    20192141       
    2020 #endif
    20212142       
    20222143       END SUBROUTINE vnest_set_topbc_v
    … …  
    20252146       SUBROUTINE vnest_set_topbc_s
    20262147       
    2027 #if defined( __parallel )
    20282148       
    20292149           USE arrays_3d
    … …  
    20352155       
    20362156           IMPLICIT NONE
    2037        
    2038            INTEGER(iwp)                             ::  i, j, k
    2039            INTEGER(iwp)                             ::  if, jf
    2040            INTEGER(iwp)                             ::  bottomx, topx
    2041            INTEGER(iwp)                             ::  bottomy, topy
    2042            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    2043            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprf, ptprs
    2044          
     2157
     2158           INTEGER(iwp)                       :: i
     2159           INTEGER(iwp)                       :: j
     2160           INTEGER(iwp)                       :: k
     2161           INTEGER(iwp)                       :: iif
     2162           INTEGER(iwp)                       :: jjf
     2163           INTEGER(iwp)                       :: kkf
     2164           INTEGER(iwp)                       :: bottomx
     2165           INTEGER(iwp)                       :: bottomy
     2166           INTEGER(iwp)                       :: topx
     2167           INTEGER(iwp)                       :: topy
     2168           REAL(wp)                           :: eps
     2169           REAL(wp)                           :: alpha
     2170           REAL(wp)                           :: eminus
     2171           REAL(wp)                           :: edot
     2172           REAL(wp)                           :: eplus
     2173           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
     2174           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     2175       
    20452176           
    20462177       
    … …  
    20642195                       topx    = (nxf+1)/(nxc+1) *(i+1) - 1
    20652196       
    2066                        DO if = bottomx, topx
    2067        
    2068                            eps = (if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
     2197                       DO iif = bottomx, topx
     2198       
     2199                           eps = (iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
    20692200       
    20702201                           alpha = ( (dxf/dxc)**2.0 - 1.0) / 24.0
    … …  
    20762207                           eplus = eps * ( eps + 1.0 ) / 2.0 + alpha
    20772208       
    2078                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     2209                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    20792210                               + edot  * work3d(k,j,i)   &
    20802211                               + eplus  * work3d(k,j,i+1)
    … …  
    20972228                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    20982229       
    2099                    DO if = nxl, nxr
    2100        
    2101                        DO jf = bottomy, topy
    2102        
    2103                            eps = (jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
     2230                   DO iif = nxl, nxr
     2231       
     2232                       DO jjf = bottomy, topy
     2233       
     2234                           eps = (jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
    21042235       
    21052236                           alpha = ( (dyf/dyc)**2.0 - 1.0) / 24.0
    … …  
    21112242                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    21122243       
    2113                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    2114                                + edot  * ptprf(k,j,if)   &
    2115                                + eplus  * ptprf(k,j+1,if)
     2244                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     2245                               + edot  * ptprf(k,j,iif)   &
     2246                               + eplus  * ptprf(k,j+1,iif)
    21162247                       END DO
    21172248       
    … …  
    21252256           !-- Interpolation in z-direction
    21262257       
    2127            DO jf = nys, nyn
    2128                DO if = nxl, nxr
     2258           DO jjf = nys, nyn
     2259               DO iif = nxl, nxr
    21292260       
    21302261                   eps = ( zuf(nzt+1) - zuc(bdims_rem(3,1)+1) ) / dzc
    … …  
    21382269                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    21392270       
    2140                    interpol3d (nzt+1,jf,if) = eminus * ptprs(bdims_rem(3,1),jf,if)   &
    2141                        + edot  * ptprs(bdims_rem(3,1)+1,jf,if) &
    2142                        + eplus  * ptprs(bdims_rem(3,1)+2,jf,if)
     2271                   interpol3d (nzt+1,jjf,iif) = eminus * ptprs(bdims_rem(3,1),jjf,iif)   &
     2272                       + edot  * ptprs(bdims_rem(3,1)+1,jjf,iif) &
     2273                       + eplus  * ptprs(bdims_rem(3,1)+2,jjf,iif)
    21432274       
    21442275               END DO
    … …  
    21482279       
    21492280       
    2150 #endif
    21512281       
    21522282       END SUBROUTINE vnest_set_topbc_s
     2283#endif
    21532284    END SUBROUTINE vnest_boundary_conds
    21542285   
    21552286 
    21562287    SUBROUTINE vnest_boundary_conds_khkm
     2288#if defined( __parallel )
    21572289   
    21582290        !--------------------------------------------------------------------------------!
    … …  
    21752307        IMPLICIT NONE
    21762308   
    2177         INTEGER(iwp) ::  i, j, k
    2178         INTEGER(iwp) ::  if, jf
    2179    
    2180         REAL(wp)    ::  c_max, denom
    2181    
    2182 #if defined( __parallel )
     2309        INTEGER(iwp)                          :: i
     2310        INTEGER(iwp)                          :: j
     2311        INTEGER(iwp)                          :: iif
     2312        INTEGER(iwp)                          :: jjf
     2313        REAL(wp)                              :: c_max
     2314        REAL(wp)                              :: denom
     2315   
    21832316   
    21842317        IF ( coupling_mode == 'vnested_crse' )  THEN
    … …  
    22652398   
    22662399        ! Neumann BC for FG kh
    2267         DO jf = nys, nyn
    2268             DO if = nxl, nxr
    2269                kh(nzt+1,jf,if) = kh(nzt,jf,if)
     2400        DO jjf = nys, nyn
     2401            DO iif = nxl, nxr
     2402               kh(nzt+1,jjf,iif) = kh(nzt,jjf,iif)
    22702403            END DO
    22712404        END DO
    … …  
    22752408   
    22762409        ! Neumann BC for FG kh
    2277         DO jf = nys, nyn
    2278             DO if = nxl, nxr
    2279                km(nzt+1,jf,if) = km(nzt,jf,if)
     2410        DO jjf = nys, nyn
     2411            DO iif = nxl, nxr
     2412               km(nzt+1,jjf,iif) = km(nzt,jjf,iif)
    22802413            END DO
    22812414        END DO
    … …  
    22842417        !
    22852418        !-- The following evaluation can only be performed, if the fine grid is situated below the inversion
    2286         !!    DO jf = nys-1, nyn+1
    2287         !!       DO if = nxl-1, nxr+1
     2419        !!    DO jjf = nys-1, nyn+1
     2420        !!       DO iif = nxl-1, nxr+1
    22882421        !!
    2289         !!          km(nzt+1,jf,if) = 0.1 * l_grid(nzt+1) * SQRT( e(nzt+1,jf,if) )
    2290         !!          kh(nzt+1,jf,if) = 3.0 * km(nzt+1,jf,if)
     2422        !!          km(nzt+1,jjf,iif) = 0.1 * l_grid(nzt+1) * SQRT( e(nzt+1,jjf,iif) )
     2423        !!          kh(nzt+1,jjf,iif) = 3.0 * km(nzt+1,jjf,iif)
    22912424        !!
    22922425        !!       END DO
    … …  
    23002433        ENDIF
    23012434   
    2302 #endif
    23032435   
    23042436    CONTAINS
    … …  
    23062438       SUBROUTINE vnest_set_topbc_kh
    23072439       
    2308 #if defined( __parallel )
    23092440       
    23102441           USE arrays_3d
    … …  
    23162447       
    23172448           IMPLICIT NONE
    2318        
    2319            INTEGER(iwp)                             ::  i, j, k
    2320            INTEGER(iwp)                             ::  if, jf
    2321            INTEGER(iwp)                             ::  bottomx, topx
    2322            INTEGER(iwp)                             ::  bottomy, topy
    2323            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    2324            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprf, ptprs
    2325          
     2449
     2450           INTEGER(iwp)                       :: i
     2451           INTEGER(iwp)                       :: j
     2452           INTEGER(iwp)                       :: k
     2453           INTEGER(iwp)                       :: iif
     2454           INTEGER(iwp)                       :: jjf
     2455           INTEGER(iwp)                       :: kkf
     2456           INTEGER(iwp)                       :: bottomx
     2457           INTEGER(iwp)                       :: bottomy
     2458           INTEGER(iwp)                       :: topx
     2459           INTEGER(iwp)                       :: topy
     2460           REAL(wp)                           :: eps
     2461           REAL(wp)                           :: alpha
     2462           REAL(wp)                           :: eminus
     2463           REAL(wp)                           :: edot
     2464           REAL(wp)                           :: eplus
     2465           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
     2466           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     2467       
    23262468           
    23272469       
    … …  
    23452487                       topx    = (nxf+1)/(nxc+1) *(i+1) - 1
    23462488       
    2347                        DO if = bottomx, topx
    2348        
    2349                            eps = (if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
     2489                       DO iif = bottomx, topx
     2490       
     2491                           eps = (iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
    23502492       
    23512493                           alpha = ( (dxf/dxc)**2.0 - 1.0) / 24.0
    … …  
    23572499                           eplus = eps * ( eps + 1.0 ) / 2.0 + alpha
    23582500       
    2359                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     2501                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    23602502                               + edot  * work3d(k,j,i)   &
    23612503                               + eplus  * work3d(k,j,i+1)
    … …  
    23782520                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    23792521       
    2380                    DO if = nxl, nxr
    2381        
    2382                        DO jf = bottomy, topy
    2383        
    2384                            eps = (jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
     2522                   DO iif = nxl, nxr
     2523       
     2524                       DO jjf = bottomy, topy
     2525       
     2526                           eps = (jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
    23852527       
    23862528                           alpha = ( (dyf/dyc)**2.0 - 1.0) / 24.0
    … …  
    23922534                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    23932535       
    2394                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    2395                                + edot  * ptprf(k,j,if)   &
    2396                                + eplus  * ptprf(k,j+1,if)
     2536                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     2537                               + edot  * ptprf(k,j,iif)   &
     2538                               + eplus  * ptprf(k,j+1,iif)
    23972539                       END DO
    23982540       
    … …  
    24062548           !-- Interpolation in z-direction
    24072549       
    2408            DO jf = nys, nyn
    2409                DO if = nxl, nxr
     2550           DO jjf = nys, nyn
     2551               DO iif = nxl, nxr
    24102552       
    24112553                   eps = ( zuf(nzt+1) - zuc(bdims_rem(3,1)+1) ) / dzc
    … …  
    24192561                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    24202562       
    2421                    kh (nzt+1,jf,if) = eminus * ptprs(bdims_rem(3,1),jf,if)   &
    2422                        + edot  * ptprs(bdims_rem(3,1)+1,jf,if) &
    2423                        + eplus  * ptprs(bdims_rem(3,1)+2,jf,if)
     2563                   kh (nzt+1,jjf,iif) = eminus * ptprs(bdims_rem(3,1),jjf,iif)   &
     2564                       + edot  * ptprs(bdims_rem(3,1)+1,jjf,iif) &
     2565                       + eplus  * ptprs(bdims_rem(3,1)+2,jjf,iif)
    24242566       
    24252567               END DO
    … …  
    24292571       
    24302572       
    2431 #endif
    24322573       
    24332574       END SUBROUTINE vnest_set_topbc_kh
    … …  
    24352576       SUBROUTINE vnest_set_topbc_km
    24362577       
    2437 #if defined( __parallel )
    24382578       
    24392579           USE arrays_3d
    … …  
    24452585       
    24462586           IMPLICIT NONE
    2447        
    2448            INTEGER(iwp)                             ::  i, j, k
    2449            INTEGER(iwp)                             ::  if, jf
    2450            INTEGER(iwp)                             ::  bottomx, topx
    2451            INTEGER(iwp)                             ::  bottomy, topy
    2452            REAL(wp)                                ::  eps, alpha, eminus, edot, eplus
    2453            REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ptprf, ptprs
    2454          
     2587
     2588           INTEGER(iwp)                       :: i
     2589           INTEGER(iwp)                       :: j
     2590           INTEGER(iwp)                       :: k
     2591           INTEGER(iwp)                       :: iif
     2592           INTEGER(iwp)                       :: jjf
     2593           INTEGER(iwp)                       :: bottomx
     2594           INTEGER(iwp)                       :: bottomy
     2595           INTEGER(iwp)                       :: bottomz
     2596           INTEGER(iwp)                       :: topx
     2597           INTEGER(iwp)                       :: topy
     2598           INTEGER(iwp)                       :: topz
     2599           REAL(wp)                           :: eps
     2600           REAL(wp)                           :: alpha
     2601           REAL(wp)                           :: eminus
     2602           REAL(wp)                           :: edot
     2603           REAL(wp)                           :: eplus
     2604           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf
     2605           REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs
     2606       
    24552607           
    24562608       
    … …  
    24742626                       topx    = (nxf+1)/(nxc+1) *(i+1) - 1
    24752627       
    2476                        DO if = bottomx, topx
    2477        
    2478                            eps = (if * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
     2628                       DO iif = bottomx, topx
     2629       
     2630                           eps = (iif * dxf + 0.5 * dxf - i * dxc - 0.5 * dxc) / dxc
    24792631       
    24802632                           alpha = ( (dxf/dxc)**2.0 - 1.0) / 24.0
    … …  
    24862638                           eplus = eps * ( eps + 1.0 ) / 2.0 + alpha
    24872639       
    2488                            ptprf(k,j,if) = eminus * work3d(k,j,i-1) &
     2640                           ptprf(k,j,iif) = eminus * work3d(k,j,i-1) &
    24892641                               + edot  * work3d(k,j,i)   &
    24902642                               + eplus  * work3d(k,j,i+1)
    … …  
    25072659                   topy    = (nyf+1)/(nyc+1) * (j+1) - 1
    25082660       
    2509                    DO if = nxl, nxr
    2510        
    2511                        DO jf = bottomy, topy
    2512        
    2513                            eps = (jf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
     2661                   DO iif = nxl, nxr
     2662       
     2663                       DO jjf = bottomy, topy
     2664       
     2665                           eps = (jjf * dyf + 0.5 * dyf - j * dyc - 0.5 * dyc) / dyc
    25142666       
    25152667                           alpha = ( (dyf/dyc)**2.0 - 1.0) / 24.0
    … …  
    25212673                           eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    25222674       
    2523                            ptprs(k,jf,if) = eminus * ptprf(k,j-1,if) &
    2524                                + edot  * ptprf(k,j,if)   &
    2525                                + eplus  * ptprf(k,j+1,if)
     2675                           ptprs(k,jjf,iif) = eminus * ptprf(k,j-1,iif) &
     2676                               + edot  * ptprf(k,j,iif)   &
     2677                               + eplus  * ptprf(k,j+1,iif)
    25262678                       END DO
    25272679       
    … …  
    25352687           !-- Interpolation in z-direction
    25362688       
    2537            DO jf = nys, nyn
    2538                DO if = nxl, nxr
     2689           DO jjf = nys, nyn
     2690               DO iif = nxl, nxr
    25392691       
    25402692                   eps = ( zuf(nzt+1) - zuc(bdims_rem(3,1)+1) ) / dzc
    … …  
    25482700                   eplus  = eps * ( eps + 1.0 ) / 2.0 + alpha
    25492701       
    2550                    km (nzt+1,jf,if) = eminus * ptprs(bdims_rem(3,1),jf,if)   &
    2551                        + edot  * ptprs(bdims_rem(3,1)+1,jf,if) &
    2552                        + eplus  * ptprs(bdims_rem(3,1)+2,jf,if)
     2702                   km (nzt+1,jjf,iif) = eminus * ptprs(bdims_rem(3,1),jjf,iif)   &
     2703                       + edot  * ptprs(bdims_rem(3,1)+1,jjf,iif) &
     2704                       + eplus  * ptprs(bdims_rem(3,1)+2,jjf,iif)
    25532705       
    25542706               END DO
    … …  
    25582710       
    25592711       
    2560 #endif
    25612712       
    25622713       END SUBROUTINE vnest_set_topbc_km
    25632714   
    25642715 
     2716#endif
    25652717    END SUBROUTINE vnest_boundary_conds_khkm
    25662718   
    … …  
    25682720   
    25692721    SUBROUTINE vnest_anterpolate
     2722
     2723#if defined( __parallel )
    25702724   
    25712725        !--------------------------------------------------------------------------------!
    … …  
    25872741        IMPLICIT NONE
    25882742   
    2589         REAL(wp)    ::  time_since_reference_point_rem
    2590         INTEGER(iwp)   :: i, j, k, im, jn, ko
    2591 
    2592 !---    INTEGER(iwp) ::  j  !< grid index y direction
    2593 !--     INTEGER(iwp) ::  k  !< grid index z direction
    2594         INTEGER(iwp) ::  kb !< variable to set respective boundary value, depends on facing.
    2595         INTEGER(iwp) ::  l  !< running index boundary type, for up- and downward-facing walls
    2596         INTEGER(iwp) ::  m  !< running index surface elements
    2597    
    2598 #if defined( __parallel )
     2743        REAL(wp)                              ::  time_since_reference_point_rem
     2744        INTEGER(iwp)                          ::  i
     2745        INTEGER(iwp)                          ::  j
     2746        INTEGER(iwp)                          ::  k
     2747        INTEGER(iwp)                          ::  im
     2748        INTEGER(iwp)                          ::  jn
     2749        INTEGER(iwp)                          ::  ko
     2750        INTEGER(iwp)                          ::  kb !< variable to set respective boundary value, depends on facing.
     2751        INTEGER(iwp)                          ::  l  !< running index boundary type, for up- and downward-facing walls
     2752        INTEGER(iwp)                          ::  m  !< running index surface elements
     2753   
    25992754   
    26002755   
    … …  
    28352990   
    28362991   
    2837 #endif
    28382992
    28392993    CONTAINS
    28402994       SUBROUTINE anterpolate_to_crse_u( tag )
    28412995     
    2842 #if defined( __parallel )
    28432996     
    28442997           USE arrays_3d
    … …  
    28503003     
    28513004           IMPLICIT NONE
    2852      
    2853            INTEGER(iwp)               ::  i, j, k
    2854            INTEGER(iwp)               ::  if, jf, kf
    2855            INTEGER(iwp)               ::  bottomx, topx
    2856            INTEGER(iwp)               ::  bottomy, topy
    2857            INTEGER(iwp)               ::  bottomz, topz
    2858            REAL(wp)                  ::  aweight
    2859            INTEGER(iwp), intent(in)   ::  tag
     3005
     3006           INTEGER(iwp), intent(in)           :: tag
     3007           INTEGER(iwp)                       :: i
     3008           INTEGER(iwp)                       :: j
     3009           INTEGER(iwp)                       :: k
     3010           INTEGER(iwp)                       :: iif
     3011           INTEGER(iwp)                       :: jjf
     3012           INTEGER(iwp)                       :: kkf
     3013           INTEGER(iwp)                       :: bottomx
     3014           INTEGER(iwp)                       :: bottomy
     3015           INTEGER(iwp)                       :: bottomz
     3016           INTEGER(iwp)                       :: topx
     3017           INTEGER(iwp)                       :: topy
     3018           INTEGER(iwp)                       :: topz
     3019           REAL(wp)                           :: aweight
    28603020     
    28613021           !
    … …  
    28763036                   DO i = bdims_rem(1,1),bdims_rem(1,2)
    28773037     
    2878                        if = (nxf+1) / (nxc+1) * i
     3038                       iif = (nxf+1) / (nxc+1) * i
    28793039     
    28803040                       aweight   = 0.0
    28813041     
    2882                        DO kf = bottomz, topz
    2883                            DO jf = bottomy, topy
    2884      
    2885                                aweight   = aweight + anterpol3d(kf,jf,if) *        &
     3042                       DO kkf = bottomz, topz
     3043                           DO jjf = bottomy, topy
     3044     
     3045                               aweight   = aweight + anterpol3d(kkf,jjf,iif) *        &
    28863046                                   (dzf/dzc) * (dyf/dyc)
    28873047     
    … …  
    28983058     
    28993059     
    2900 #endif
    29013060     
    29023061       END SUBROUTINE anterpolate_to_crse_u
    … …  
    29053064       SUBROUTINE anterpolate_to_crse_v( tag )
    29063065     
    2907 #if defined( __parallel )
    29083066     
    29093067           USE arrays_3d
    … …  
    29153073     
    29163074           IMPLICIT NONE
    2917      
    2918            INTEGER(iwp)               ::  i, j, k
    2919            INTEGER(iwp)               ::  if, jf, kf
    2920            INTEGER(iwp)               ::  bottomx, topx
    2921            INTEGER(iwp)               ::  bottomy, topy
    2922            INTEGER(iwp)               ::  bottomz, topz
    2923            REAL(wp)                  ::  aweight
    2924            INTEGER(iwp), intent(in) ::  tag
     3075
     3076           INTEGER(iwp), intent(in)           :: tag
     3077           INTEGER(iwp)                       :: i
     3078           INTEGER(iwp)                       :: j
     3079           INTEGER(iwp)                       :: k
     3080           INTEGER(iwp)                       :: iif
     3081           INTEGER(iwp)                       :: jjf
     3082           INTEGER(iwp)                       :: kkf
     3083           INTEGER(iwp)                       :: bottomx
     3084           INTEGER(iwp)                       :: bottomy
     3085           INTEGER(iwp)                       :: bottomz
     3086           INTEGER(iwp)                       :: topx
     3087           INTEGER(iwp)                       :: topy
     3088           INTEGER(iwp)                       :: topz
     3089           REAL(wp)                           :: aweight
     3090
    29253091           !
    29263092           !-- Anterpolation of the velocity components v
    … …  
    29353101               DO j = bdims_rem(2,1), bdims_rem(2,2)
    29363102     
    2937                    jf = (nyf+1) / (nyc+1) * j
     3103                   jjf = (nyf+1) / (nyc+1) * j
    29383104     
    29393105                   DO i = bdims_rem(1,1), bdims_rem(1,2)
    … …  
    29443110                       aweight   = 0.0
    29453111     
    2946                        DO kf = bottomz, topz
    2947                            DO if = bottomx, topx
    2948      
    2949                                aweight   = aweight + anterpol3d(kf,jf,if) *        &
     3112                       DO kkf = bottomz, topz
     3113                           DO iif = bottomx, topx
     3114     
     3115                               aweight   = aweight + anterpol3d(kkf,jjf,iif) *        &
    29503116                                   (dzf/dzc) * (dxf/dxc)
    29513117     
    … …  
    29613127     
    29623128     
    2963 #endif
    29643129     
    29653130       END SUBROUTINE anterpolate_to_crse_v
    … …  
    29683133       SUBROUTINE anterpolate_to_crse_w( tag )
    29693134     
    2970 #if defined( __parallel )
    29713135     
    29723136           USE arrays_3d
    … …  
    29783142     
    29793143           IMPLICIT NONE
    2980      
    2981            INTEGER(iwp)               ::  i, j, k
    2982            INTEGER(iwp)               ::  if, jf, kf
    2983            INTEGER(iwp)               ::  bottomx, topx
    2984            INTEGER(iwp)               ::  bottomy, topy
    2985            INTEGER(iwp)               ::  bottomz, topz
    2986            REAL(wp)                  ::  aweight
    2987            INTEGER(iwp), intent(in) ::  tag
     3144
     3145           INTEGER(iwp), intent(in)           :: tag
     3146           INTEGER(iwp)                       :: i
     3147           INTEGER(iwp)                       :: j
     3148           INTEGER(iwp)                       :: k
     3149           INTEGER(iwp)                       :: iif
     3150           INTEGER(iwp)                       :: jjf
     3151           INTEGER(iwp)                       :: kkf
     3152           INTEGER(iwp)                       :: bottomx
     3153           INTEGER(iwp)                       :: bottomy
     3154           INTEGER(iwp)                       :: bottomz
     3155           INTEGER(iwp)                       :: topx
     3156           INTEGER(iwp)                       :: topy
     3157           INTEGER(iwp)                       :: topz
     3158           REAL(wp)                           :: aweight
     3159
    29883160           !
    29893161           !-- Anterpolation of the velocity components w
    … …  
    29933165           DO k = bdims_rem(3,1), bdims_rem(3,2)-1
    29943166     
    2995                kf = cfratio(3) * k
     3167               kkf = cfratio(3) * k
    29963168     
    29973169               DO j = bdims_rem(2,1), bdims_rem(2,2)
    … …  
    30073179                       aweight   = 0.0
    30083180     
    3009                        DO jf = bottomy, topy
    3010                            DO if = bottomx, topx
    3011      
    3012                                aweight   = aweight + anterpol3d (kf,jf,if) *        &
     3181                       DO jjf = bottomy, topy
     3182                           DO iif = bottomx, topx
     3183     
     3184                               aweight   = aweight + anterpol3d (kkf,jjf,iif) *        &
    30133185                                   (dxf/dxc) * (dyf/dyc)
    30143186     
    … …  
    30243196           END DO
    30253197     
    3026 #endif
    30273198     
    30283199       END SUBROUTINE anterpolate_to_crse_w
    … …  
    30313202       SUBROUTINE anterpolate_to_crse_s( tag )
    30323203     
    3033 #if defined( __parallel )
    30343204     
    30353205           USE arrays_3d
    … …  
    30413211     
    30423212           IMPLICIT NONE
    3043      
    3044            INTEGER(iwp)               ::  i, j, k
    3045            INTEGER(iwp)               ::  if, jf, kf
    3046            INTEGER(iwp)               ::  bottomx, topx
    3047            INTEGER(iwp)               ::  bottomy, topy
    3048            INTEGER(iwp)               ::  bottomz, topz
    3049            REAL(wp)                  ::  aweight
    3050            INTEGER(iwp), intent(in)   ::  tag
     3213
     3214           INTEGER(iwp), intent(in)           :: tag
     3215           INTEGER(iwp)                       :: i
     3216           INTEGER(iwp)                       :: j
     3217           INTEGER(iwp)                       :: k
     3218           INTEGER(iwp)                       :: iif
     3219           INTEGER(iwp)                       :: jjf
     3220           INTEGER(iwp)                       :: kkf
     3221           INTEGER(iwp)                       :: bottomx
     3222           INTEGER(iwp)                       :: bottomy
     3223           INTEGER(iwp)                       :: bottomz
     3224           INTEGER(iwp)                       :: topx
     3225           INTEGER(iwp)                       :: topy
     3226           INTEGER(iwp)                       :: topz
     3227           REAL(wp)                           :: aweight
    30513228     
    30523229           !
    … …  
    30713248                       aweight   = 0.0
    30723249         
    3073                        DO kf = bottomz, topz
    3074                            DO jf = bottomy, topy
    3075                                DO if = bottomx, topx
    3076      
    3077                                    aweight   = aweight  + anterpol3d(kf,jf,if) *                  &
     3250                       DO kkf = bottomz, topz
     3251                           DO jjf = bottomy, topy
     3252                               DO iif = bottomx, topx
     3253     
     3254                                   aweight   = aweight  + anterpol3d(kkf,jjf,iif) *                  &
    30783255                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    30793256     
    … …  
    30903267           END DO
    30913268     
    3092 #endif
    30933269     
    30943270       END SUBROUTINE anterpolate_to_crse_s
     3271#endif       
    30953272    END SUBROUTINE vnest_anterpolate
    30963273   
    … …  
    30983275   
    30993276    SUBROUTINE vnest_anterpolate_e
     3277#if defined( __parallel )
    31003278   
    31013279        !--------------------------------------------------------------------------------!
    … …  
    31153293        IMPLICIT NONE
    31163294   
    3117         REAL(wp)    ::  time_since_reference_point_rem
    3118         INTEGER(iwp)   :: i, j, k, im, jn, ko
    3119    
    3120 #if defined( __parallel )
     3295        REAL(wp)                              :: time_since_reference_point_rem
     3296        INTEGER(iwp)                          :: i
     3297        INTEGER(iwp)                          :: j
     3298        INTEGER(iwp)                          :: k
     3299        INTEGER(iwp)                          :: im
     3300        INTEGER(iwp)                          :: jn
     3301        INTEGER(iwp)                          :: ko
     3302   
    31213303   
    31223304        !
    … …  
    32433425        ENDIF
    32443426   
    3245 #endif
    32463427   
    32473428    CONTAINS
    … …  
    32533434       SUBROUTINE anterpolate_to_crse_e( tag )
    32543435     
    3255 #if defined( __parallel )
    32563436     
    32573437           USE arrays_3d
    … …  
    32633443     
    32643444           IMPLICIT NONE
    3265      
    3266            INTEGER(iwp)               ::  i, j, k
    3267            INTEGER(iwp)               ::  if, jf, kf
    3268            INTEGER(iwp)               ::  bottomx, topx
    3269            INTEGER(iwp)               ::  bottomy, topy
    3270            INTEGER(iwp)               ::  bottomz, topz
    3271            REAL(wp)                  ::  aweight_a, aweight_b, aweight_c, aweight_d, aweight_e
    3272            REAL(wp)                  ::  energ
    3273            INTEGER(iwp), intent(in)   ::  tag
    3274      
     3445
     3446           INTEGER(iwp), intent(in)           :: tag
     3447           INTEGER(iwp)                       :: i
     3448           INTEGER(iwp)                       :: j
     3449           INTEGER(iwp)                       :: k
     3450           INTEGER(iwp)                       :: iif
     3451           INTEGER(iwp)                       :: jjf
     3452           INTEGER(iwp)                       :: kkf
     3453           INTEGER(iwp)                       :: bottomx
     3454           INTEGER(iwp)                       :: bottomy
     3455           INTEGER(iwp)                       :: bottomz
     3456           INTEGER(iwp)                       :: topx
     3457           INTEGER(iwp)                       :: topy
     3458           INTEGER(iwp)                       :: topz
     3459           REAL(wp)                           :: aweight_a
     3460           REAL(wp)                           :: aweight_b
     3461           REAL(wp)                           :: aweight_c
     3462           REAL(wp)                           :: aweight_d
     3463           REAL(wp)                           :: aweight_e
     3464           REAL(wp)                           :: energ
    32753465         
    32763466           DO k = bdims_rem(3,1)+1, bdims_rem(3,2)
    … …  
    32953485                       aweight_e   = 0.0
    32963486     
    3297                        DO kf = bottomz, topz
    3298                            DO jf = bottomy, topy
    3299                                DO if = bottomx, topx
    3300      
    3301                                    aweight_a = aweight_a + anterpol3d(kf,jf,if)  *                     &
     3487                       DO kkf = bottomz, topz
     3488                           DO jjf = bottomy, topy
     3489                               DO iif = bottomx, topx
     3490     
     3491                                   aweight_a = aweight_a + anterpol3d(kkf,jjf,iif)  *                     &
    33023492                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    33033493                             
    33043494     
    3305                                    energ = ( 0.5 * ( u(kf,jf,if)   + u(kf,jf,if+1) ) )**2.0 +          &
    3306                                        ( 0.5 * ( v(kf,jf,if)   + v(kf,jf+1,if) ) )**2.0 +              &
    3307                                        ( 0.5 * ( w(kf-1,jf,if) + w(kf,jf,if) ) )**2.0
     3495                                   energ = ( 0.5 * ( u(kkf,jjf,iif)   + u(kkf,jjf,iif+1) ) )**2.0 +          &
     3496                                       ( 0.5 * ( v(kkf,jjf,iif)   + v(kkf,jjf+1,iif) ) )**2.0 +              &
     3497                                       ( 0.5 * ( w(kkf-1,jjf,iif) + w(kkf,jjf,iif) ) )**2.0
    33083498     
    33093499                                   aweight_b   =   aweight_b + energ         *                         &
    33103500                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    33113501       
    3312                                    aweight_c   =   aweight_c + 0.5 * ( u(kf,jf,if) + u(kf,jf,if+1) ) * &
     3502                                   aweight_c   =   aweight_c + 0.5 * ( u(kkf,jjf,iif) + u(kkf,jjf,iif+1) ) * &
    33133503                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    33143504     
    3315                                    aweight_d   =   aweight_d + 0.5 * ( v(kf,jf,if) + v(kf,jf+1,if) ) * &
     3505                                   aweight_d   =   aweight_d + 0.5 * ( v(kkf,jjf,iif) + v(kkf,jjf+1,iif) ) * &
    33163506                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    33173507       
    3318                                    aweight_e   =   aweight_e + 0.5 * ( w(kf-1,jf,if) + w(kf,jf,if) ) * &
     3508                                   aweight_e   =   aweight_e + 0.5 * ( w(kkf-1,jjf,iif) + w(kkf,jjf,iif) ) * &
    33193509                                       (dzf/dzc) * (dyf/dyc) * (dxf/dxc)
    33203510     
    … …  
    33363526     
    33373527       
    3338 #endif
    33393528     
    33403529       END SUBROUTINE anterpolate_to_crse_e
     3530#endif       
    33413531    END SUBROUTINE vnest_anterpolate_e
    33423532
    33433533    SUBROUTINE vnest_init_pegrid_rank
     3534#if defined( __parallel )
    33443535! Domain decomposition and exchange of grid variables between coarse and fine
    33453536! Given processor coordinates as index f_rnk_lst(pcoord(1), pcoord(2))
    … …  
    33693560       IMPLICIT NONE
    33703561
    3371        INTEGER(iwp)                    :: dest_rnk
    3372        INTEGER(iwp)               ::  i                        !<
     3562       INTEGER(iwp)                           :: dest_rnk
     3563       INTEGER(iwp)                           ::  i                        !<
    33733564
    33743565       IF (myid == 0) THEN
    … …  
    34293620
    34303621
     3622#endif
    34313623 
    34323624    END SUBROUTINE vnest_init_pegrid_rank
    … …  
    34343626
    34353627    SUBROUTINE vnest_init_pegrid_domain
     3628#if defined( __parallel )
    34363629
    34373630       USE control_parameters,                                                    &
    … …  
    34513644       IMPLICIT NONE
    34523645
    3453        INTEGER(iwp)              :: dest_rnk
    3454        INTEGER(iwp) ::  i, j                               !<
    3455        INTEGER(iwp) ::  tempx, tempy                               !<
    3456        INTEGER(iwp) :: TYPE_INT_YZ,  SIZEOFREAL
    3457        INTEGER(iwp) :: MTV_X,MTV_Y,MTV_Z,MTV_RX,MTV_RY,MTV_RZ
     3646       INTEGER(iwp)                           :: dest_rnk
     3647       INTEGER(iwp)                           :: i              !<
     3648       INTEGER(iwp)                           :: j              !<
     3649       INTEGER(iwp)                           :: tempx
     3650       INTEGER(iwp)                           :: tempy
     3651       INTEGER(iwp)                           :: TYPE_INT_YZ
     3652       INTEGER(iwp)                           :: SIZEOFREAL
     3653       INTEGER(iwp)                           :: MTV_X
     3654       INTEGER(iwp)                           :: MTV_Y
     3655       INTEGER(iwp)                           :: MTV_Z
     3656       INTEGER(iwp)                           :: MTV_RX
     3657       INTEGER(iwp)                           :: MTV_RY
     3658       INTEGER(iwp)                           :: MTV_RZ
    34583659   
    34593660       !
    … …  
    36923893
    36933894        ENDIF
    3694    
     3895#endif   
    36953896       END SUBROUTINE vnest_init_pegrid_domain
    36963897
    … …  
    36983899       SUBROUTINE vnest_init_grid
    36993900 
     3901#if defined( __parallel )
    37003902          USE arrays_3d,                                                             &
    37013903              ONLY:  zu, zw
    … …  
    37613963          ENDIF
    37623964
     3965#endif
    37633966       END SUBROUTINE vnest_init_grid
    37643967
    37653968
    37663969       SUBROUTINE vnest_check_parameters
    3767 
    3768           USE arrays_3d,                                                             &
    3769               ONLY:  zu, zw
    3770 
    3771           USE control_parameters,                                                    &
    3772               ONLY:  coupling_mode
    3773              
    3774           USE indices,                                                               &
    3775               ONLY:  nzt
    3776          
    3777           USE kinds
    3778          
    3779           USE pegrid
     3970#if defined( __parallel )
     3971
     3972          USE pegrid,                                                                &
     3973              ONLY:  myid
    37803974
    37813975          IMPLICIT NONE
    37823976
    3783 
    37843977          IF (myid==0) PRINT*, '*** vnest: check parameters not implemented yet ***'
    37853978     
    3786 
     3979#endif
    37873980       END SUBROUTINE vnest_check_parameters
    37883981
    … …  
    37903983       SUBROUTINE vnest_timestep_sync
    37913984
     3985#if defined( __parallel )
    37923986         USE control_parameters,                                                    &
    3793              ONLY:  coupling_mode, dt_3d, dt_coupling
     3987             ONLY:  coupling_mode, dt_3d, old_dt
    37943988     
    37953989         USE interfaces
    … …  
    38254019!-- Identical timestep for coarse and fine grids
    38264020          dt_3d = MIN( dtc, dtf )
    3827 !-- Nest coupling at every timestep
    3828           dt_coupling = dt_3d
    3829 
     4021          old_dt = dt_3d
     4022#endif
    38304023       END SUBROUTINE vnest_timestep_sync
    38314024       
    38324025       SUBROUTINE vnest_deallocate
     4026#if defined( __parallel )
    38334027          USE control_parameters,                                                    &
    38344028              ONLY:  coupling_mode
    … …  
    38464040             IF ( ALLOCATED (f2c_dims_fg) ) DEALLOCATE (f2c_dims_fg)
    38474041          ENDIF
    3848      
     4042#endif
    38494043       END SUBROUTINE vnest_deallocate
    38504044
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |