Home


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

Ignore:
Timestamp:
Feb 28, 2016 12:45:19 PM (8 years ago)
Author:
raasch
Message:

update of the nested domain system + some bugfixes

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface.f90

    r1763 r1764  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! +cpl_parent_id,
     23! cpp-statements for nesting replaced by __parallel statements,
     24! errors output with message-subroutine,
     25! index bugfixes in pmci_interp_tril_all,
     26! some adjustments to PALM style
    2327!
    2428! Former revisions:
    … …  
    3539!------------------------------------------------------------------------------!
    3640
    37 
    38     USE mpi
    39 
    40 !
    41 !-- PALM modules
     41    USE arrays_3d,                                                             &
     42        ONLY:  dzu, dzw, e, e_p, pt, pt_p, q, q_p, te_m, tu_m, tv_m, tw_m, u,  &
     43               u_p, v, v_p, w, w_p, zu, zw, z0
     44
     45    USE control_parameters,                                                    &
     46        ONLY:  dt_3d, dz, humidity, message_string, nest_bound_l,              &
     47               nest_bound_r, nest_bound_s, nest_bound_n, passive_scalar,       &
     48               simulated_time, topography, volume_flow
     49
     50    USE cpulog,                                                                &
     51        ONLY:  cpu_log, log_point_s
     52
     53    USE grid_variables,                                                        &
     54        ONLY:  dx, dy
     55
     56    USE indices,                                                               &
     57        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
     58               nysv, nz, nzb, nzb_s_inner, nzb_u_inner, nzb_u_outer,           &
     59               nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer, nzt
     60
    4261    USE kinds
    43     USE pegrid,                                                                           &
    44         ONLY:  myid, numprocs, comm2d, comm1dx, comm1dy, myidx, myidy, collective_wait
    45     USE arrays_3d,                                                                        &
    46         ONLY:  u, v, w, e, pt, q, u_p, v_p, w_p, e_p, pt_p, q_p, z0, dzu, dzw, zu, zw,    &
    47                tu_m, tv_m, tw_m, te_m
    48     USE indices,                                                                          &
    49         ONLY:  nx, ny, nz, nxl, nxr, nys, nyn, nzb, nzt, nxlu, nysv, nxlg, nxrg,          &
    50                nysg, nyng, nbgp, nzb_u_inner, nzb_v_inner, nzb_w_inner,                   &
    51                nzb_s_inner, nzb_u_outer, nzb_v_outer, nzb_w_outer
    52     USE control_parameters,                                                               &
    53         ONLY:  dz, dt_3d, simulated_time, message_string, volume_flow,                    &
    54                nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,                    &
    55                topography, humidity, passive_scalar
    56     USE grid_variables,                                                                   &
    57         ONLY:  dx, dy
    58     USE cpulog,                                                                           &
    59         ONLY:  cpu_log, log_point_s
    60 
    61 !
    62 !-- PMC modules
    63     USE pmc_general,                                                                      &
    64         ONLY:  pmc_status_ok, pmc_max_modell, da_namelen
    65     USE pmc_handle_communicator,                                                          &
    66         ONLY:  pmc_init_model, pmc_is_rootmodel, pmc_get_local_model_info,                &
    67                pmc_server_for_client
    68     USE pmc_mpi_Wrapper,                                                                  &
    69         ONLY:  pmc_recv_from_client, pmc_send_to_server, pmc_recv_from_server,            &
    70                pmc_send_to_client, pmc_bcast
    71     USE pmc_server,                                                                       &
    72         ONLY:  pmc_serverinit, pmc_s_getnextarray,                                        &
    73                pmc_s_set_dataarray, pmc_s_setind_and_allocmem,                            &
    74                pmc_s_set_2d_index_list, pmc_s_fillbuffer,pmc_s_getdata_from_buffer
    75     USE pmc_client,                                                                       &
    76         ONLY:  pmc_clientinit, pmc_set_dataarray_name, pmc_c_get_2d_index_list,           &
    77                pmc_c_getnextarray, pmc_c_set_dataarray, pmc_c_setind_and_allocmem,        &
    78                pmc_c_putbuffer, pmc_c_getbuffer
     62
     63#if defined( __parallel )
     64#if defined( __lc )
     65    USE MPI
     66#else
     67    INCLUDE "mpif.h"
     68#endif
     69
     70    USE pegrid,                                                                &
     71        ONLY:  collective_wait, comm1dx, comm1dy, comm2d, myid, myidx, myidy,  &
     72               numprocs
     73
     74    USE pmc_client,                                                            &
     75        ONLY:  pmc_clientinit, pmc_c_getnextarray, pmc_c_get_2d_index_list,    &
     76               pmc_c_getbuffer, pmc_c_putbuffer, pmc_c_setind_and_allocmem,    &
     77               pmc_c_set_dataarray, pmc_set_dataarray_name
     78
     79    USE pmc_general,                                                           &
     80        ONLY:  da_namelen, pmc_max_modell, pmc_status_ok
     81
     82    USE pmc_handle_communicator,                                               &
     83        ONLY:  pmc_get_local_model_info, pmc_init_model, pmc_is_rootmodel,     &
     84               pmc_no_namelist_found, pmc_server_for_client
     85
     86    USE pmc_mpi_wrapper,                                                       &
     87        ONLY:  pmc_bcast, pmc_recv_from_client, pmc_recv_from_server,          &
     88               pmc_send_to_client, pmc_send_to_server
     89
     90    USE pmc_server,                                                            &
     91        ONLY:  pmc_serverinit, pmc_s_fillbuffer, pmc_s_getdata_from_buffer,    &
     92               pmc_s_getnextarray, pmc_s_setind_and_allocmem,                  &
     93               pmc_s_set_dataarray, pmc_s_set_2d_index_list
     94
     95#endif
    7996
    8097    IMPLICIT NONE
    8198
     99!-- TO_DO: a lot of lines (including comments) in this file exceed the 80 char
     100!--        limit. Try to reduce as much as possible
     101
     102!-- TO_DO: shouldn't we use public as default here? Only a minority of the
     103!-- variables is private.
    82104    PRIVATE    !:  Note that the default publicity is here set to private.
    83105
    84106!
    85107!-- Constants
    86     INTEGER(iwp), PARAMETER, PUBLIC        ::  client_to_server = 2   !:
    87     INTEGER(iwp), PARAMETER, PUBLIC        ::  server_to_client = 1   !:
     108    INTEGER(iwp), PARAMETER, PUBLIC ::  client_to_server = 2   !:
     109    INTEGER(iwp), PARAMETER, PUBLIC ::  server_to_client = 1   !:
    88110
    89111!
    90112!-- Coupler setup
    91     INTEGER(iwp), PUBLIC, SAVE             ::  cpl_id                 !:
    92     CHARACTER(LEN=32), PUBLIC, SAVE        ::  cpl_name               !:
    93     INTEGER(iwp), PUBLIC, SAVE             ::  cpl_npex               !:
    94     INTEGER(iwp), PUBLIC, SAVE             ::  cpl_npey               !:
     113    INTEGER(iwp), PUBLIC, SAVE      ::  cpl_id  = 1            !:
     114    CHARACTER(LEN=32), PUBLIC, SAVE ::  cpl_name               !:
     115    INTEGER(iwp), PUBLIC, SAVE      ::  cpl_npex               !:
     116    INTEGER(iwp), PUBLIC, SAVE      ::  cpl_npey               !:
     117    INTEGER(iwp), PUBLIC, SAVE      ::  cpl_parent_id          !:
    95118
    96119!
    97120!-- Control parameters, will be made input parameters later
    98     CHARACTER(LEN=7), PUBLIC, SAVE         ::  nesting_mode = 'two-way'          !:
    99     REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_l = -1.0_wp   !:
    100     REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_r = -1.0_wp   !:
    101     REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_s = -1.0_wp   !:
    102     REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_n = -1.0_wp   !:
    103     REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_t = -1.0_wp   !:
     121    CHARACTER(LEN=7), PUBLIC, SAVE ::  nesting_mode = 'two-way'  !: steering parameter for one- or two-way nesting
     122
     123    LOGICAL, PUBLIC, SAVE ::  nested_run = .FALSE.  !: general switch if nested run or not
     124
     125    REAL(wp), PUBLIC, SAVE ::  anterp_relax_length_l = -1.0_wp   !:
     126    REAL(wp), PUBLIC, SAVE ::  anterp_relax_length_r = -1.0_wp   !:
     127    REAL(wp), PUBLIC, SAVE ::  anterp_relax_length_s = -1.0_wp   !:
     128    REAL(wp), PUBLIC, SAVE ::  anterp_relax_length_n = -1.0_wp   !:
     129    REAL(wp), PUBLIC, SAVE ::  anterp_relax_length_t = -1.0_wp   !:
    104130
    105131!
    … …  
    120146    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  qc   !:
    121147
    122     INTEGER(iwp), DIMENSION(5)                          ::  coarse_bound   !: Moved here form map_fine_to_coarse.
     148    INTEGER(iwp), DIMENSION(5)                          ::  coarse_bound   !:
    123149    REAL(wp), PUBLIC, SAVE                              ::  xexl           !:
    124150    REAL(wp), PUBLIC, SAVE                              ::  xexr           !:
    … …  
    229255       INTEGER(iwp)                        ::  nx
    230256       INTEGER(iwp)                        ::  ny
    231        INTEGER (iwp)                       ::  nz
     257       INTEGER(iwp)                        ::  nz
    232258       REAL(wp)                            ::  dx
    233259       REAL(wp)                            ::  dy
    … …  
    247273    TYPE(coarsegrid_def), SAVE             ::  cg   !:
    248274
    249 !
    250 !-- Interface section.
     275
     276    INTERFACE pmci_client_datatrans
     277       MODULE PROCEDURE pmci_client_datatrans
     278    END INTERFACE
     279
     280    INTERFACE pmci_client_initialize
     281       MODULE PROCEDURE pmci_client_initialize
     282    END INTERFACE
     283
     284    INTERFACE pmci_client_synchronize
     285       MODULE PROCEDURE pmci_client_synchronize
     286    END INTERFACE
     287
     288    INTERFACE pmci_ensure_nest_mass_conservation
     289       MODULE PROCEDURE pmci_ensure_nest_mass_conservation
     290    END INTERFACE
     291
    251292    INTERFACE pmci_init
    252293       MODULE PROCEDURE pmci_init
    253294    END INTERFACE
    254    
     295
    255296    INTERFACE pmci_modelconfiguration
    256297       MODULE PROCEDURE pmci_modelconfiguration
    257298    END INTERFACE
    258    
     299
     300    INTERFACE pmci_server_initialize
     301       MODULE PROCEDURE pmci_server_initialize
     302    END INTERFACE
     303
    259304    INTERFACE pmci_server_synchronize
    260305       MODULE PROCEDURE pmci_server_synchronize
    261306    END INTERFACE
    262    
    263     INTERFACE pmci_client_synchronize
    264        MODULE PROCEDURE pmci_client_synchronize
    265     END INTERFACE
    266    
    267     INTERFACE pmci_server_datatrans
    268        MODULE PROCEDURE pmci_server_datatrans
    269     END INTERFACE
    270    
    271     INTERFACE pmci_client_datatrans
    272        MODULE PROCEDURE pmci_client_datatrans
    273     END INTERFACE
    274    
     307
    275308    INTERFACE pmci_update_new
    276309       MODULE PROCEDURE pmci_update_new
    277310    END INTERFACE
    278311
    279     INTERFACE pmci_ensure_nest_mass_conservation
    280        MODULE PROCEDURE pmci_ensure_nest_mass_conservation
    281     END INTERFACE
    282    
    283     INTERFACE pmci_server_initialize
    284        MODULE PROCEDURE pmci_server_initialize
    285     END INTERFACE
    286    
    287     INTERFACE pmci_client_initialize
    288        MODULE PROCEDURE pmci_client_initialize
    289     END INTERFACE
    290    
     312    PUBLIC pmci_client_datatrans
     313    PUBLIC pmci_client_initialize
     314    PUBLIC pmci_client_synchronize
     315    PUBLIC pmci_ensure_nest_mass_conservation
    291316    PUBLIC pmci_init
    292317    PUBLIC pmci_modelconfiguration
     318    PUBLIC pmci_server_datatrans
     319    PUBLIC pmci_server_initialize
    293320    PUBLIC pmci_server_synchronize
    294     PUBLIC pmci_client_synchronize
    295     PUBLIC pmci_server_datatrans
    296     PUBLIC pmci_client_datatrans
    297321    PUBLIC pmci_update_new
    298     PUBLIC pmci_ensure_nest_mass_conservation
    299     PUBLIC pmci_server_initialize
    300     PUBLIC pmci_client_initialize
    301322
    302323
    … …  
    305326
    306327 SUBROUTINE pmci_init( world_comm )
     328
    307329    IMPLICIT NONE
    308330
    309     INTEGER, INTENT(OUT)  ::  world_comm   !:
    310 
    311     INTEGER(iwp)          ::  ierr         !:
    312     INTEGER(iwp)          ::  istat        !:
    313     INTEGER(iwp)          ::  PMC_status   !:
    314 
    315 
    316 #if defined PMC_ACTIVE
    317     CALL pmc_init_model( world_comm, pmc_status )
    318     IF ( pmc_status /= pmc_status_ok )  THEN
    319        CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
     331    INTEGER, INTENT(OUT) ::  world_comm   !:
     332
     333#if defined( __parallel )
     334
     335    INTEGER(iwp)         ::  ierr         !:
     336    INTEGER(iwp)         ::  istat        !:
     337    INTEGER(iwp)         ::  pmc_status   !:
     338
     339
     340    CALL pmc_init_model( world_comm, nesting_mode, pmc_status )
     341
     342    IF ( pmc_status == pmc_no_namelist_found )  THEN
     343!
     344!--    This is not a nested run
     345!
     346!--    TO_DO: this wouldn't be required any more?
     347       world_comm = MPI_COMM_WORLD
     348       cpl_id     = 1
     349       cpl_name   = ""
     350       cpl_npex   = 2
     351       cpl_npey   = 2
     352       lower_left_coord_x = 0.0_wp
     353       lower_left_coord_y = 0.0_wp
     354       RETURN
     355    ELSE
     356!
     357!--    Set the general steering switch which tells PALM that its a nested run
     358       nested_run = .TRUE.
    320359    ENDIF
    321     CALL pmc_get_local_model_info( my_cpl_id = cpl_id, cpl_name = cpl_name,  npe_x=cpl_npex, npe_y = cpl_npey,  &
    322                                    lower_left_x = lower_left_coord_x, lower_left_y = lower_left_coord_y )
     360
     361    CALL pmc_get_local_model_info( my_cpl_id = cpl_id,                         &
     362                                   my_cpl_parent_id = cpl_parent_id,           &
     363                                   cpl_name = cpl_name,                        &
     364                                   npe_x = cpl_npex, npe_y = cpl_npey,         &
     365                                   lower_left_x = lower_left_coord_x,          &
     366                                   lower_left_y = lower_left_coord_y )
     367!
     368!-- Message that communicators for nesting are initialized.
     369!-- Attention: myid has been set at the end of pmc_init_model in order to
     370!-- guarantee that only PE0 of the root domain does the output.
     371    CALL location_message( 'finished', .TRUE. )
     372!
     373!-- Reset myid to its default value
     374    myid = 0
    323375#else
    324     world_comm = MPI_COMM_WORLD
     376!
     377!-- Nesting cannot be used in serial mode. cpl_id is set to root domain (1)
     378!-- because no location messages would be generated otherwise.
     379!-- world_comm is given a dummy value to avoid compiler warnings (INTENT(OUT)
     380!-- should get an explicit value)
    325381    cpl_id     = 1
    326     cpl_name   = ""
    327     cpl_npex   = 2
    328     cpl_npey   = 2
    329     lower_left_coord_x = 0.0_wp
    330     lower_left_coord_y = 0.0_wp
     382    nested_run = .FALSE.
     383    world_comm = 1
    331384#endif
    332385
    … …  
    336389
    337390 SUBROUTINE pmci_modelconfiguration
     391
    338392    IMPLICIT NONE
    339393
     394    CALL location_message( 'setup the nested model configuration', .FALSE. )
    340395    CALL pmci_setup_coordinates   !:  Compute absolute coordinates valid for all models
    341     CALL pmci_setup_client        !:  Initialize PMC Client (Must be called before pmc_palm_SetUp_Server)
     396    CALL pmci_setup_client        !:  Initialize PMC Client (Must be called before pmc_setup_server)
    342397    CALL pmci_setup_server        !:  Initialize PMC Server
     398    CALL location_message( 'finished', .TRUE. )
    343399
    344400 END SUBROUTINE pmci_modelconfiguration
    … …  
    347403
    348404 SUBROUTINE pmci_setup_server
     405
     406#if defined( __parallel )
    349407    IMPLICIT NONE
    350408
    … …  
    371429   
    372430
    373 #if defined PMC_ACTIVE
    374     CALL pmc_serverinit                                !  Initialize PMC Server
    375 
    376 !
    377 !-- Get coordinates from all Clients.
     431!
     432!   Initialize the PMC server
     433    CALL pmc_serverinit
     434
     435!
     436!-- Get coordinates from all clients
    378437    DO  m = 1, SIZE( pmc_server_for_client ) - 1
    379438       client_id = pmc_server_for_client(m)
    … …  
    391450
    392451!
    393 !--       Find the highest client level in the coarse grid for the reduced z transfer
     452!--       Find the highest client level in the coarse grid for the reduced z
     453!--       transfer
    394454          DO  k = 1, nz                 
    395455             IF ( zw(k) > fval(1) )  THEN
    … …  
    404464          ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
    405465         
    406           CALL pmc_recv_from_client( client_id, cl_coord_x, SIZE( cl_coord_x ), 0, 11, ierr )
    407           CALL pmc_recv_from_client( client_id, cl_coord_y, SIZE( cl_coord_y ), 0, 12, ierr )
     466          CALL pmc_recv_from_client( client_id, cl_coord_x, SIZE( cl_coord_x ),&
     467                                     0, 11, ierr )
     468          CALL pmc_recv_from_client( client_id, cl_coord_y, SIZE( cl_coord_y ),&
     469                                     0, 12, ierr )
    408470          WRITE ( 0, * )  'receive from pmc Client ', client_id, nx_cl, ny_cl
    409471         
    410472          define_coarse_grid_real(1) = lower_left_coord_x
    411473          define_coarse_grid_real(2) = lower_left_coord_y
    412           define_coarse_grid_real(3) = 0                                      !  KK currently not used.
     474!--       TO_DO: remove this?
     475          define_coarse_grid_real(3) = 0             !  KK currently not used.
    413476          define_coarse_grid_real(4) = 0
    414477          define_coarse_grid_real(5) = dx
    415478          define_coarse_grid_real(6) = dy
    416           define_coarse_grid_real(7) = lower_left_coord_x + ( nx + 1 ) * dx   !  AH: corrected 6.2.2015
    417           define_coarse_grid_real(8) = lower_left_coord_y + ( ny + 1 ) * dy   !  AH: corrected 6.2.2015
    418           define_coarse_grid_real(9) = dz                                     !  AH: added 24.2.2015
     479          define_coarse_grid_real(7) = lower_left_coord_x + ( nx + 1 ) * dx
     480          define_coarse_grid_real(8) = lower_left_coord_y + ( ny + 1 ) * dy
     481          define_coarse_grid_real(9) = dz
    419482
    420483          define_coarse_grid_int(1)  = nx
    … …  
    437500!
    438501!--       Send coarse grid information to client
    439           CALL pmc_send_to_client( client_id, Define_coarse_grid_real, 9, 0, 21, ierr )
    440           CALL pmc_send_to_client( client_id, Define_coarse_grid_int,  3, 0, 22, ierr )
    441 
    442 !
    443 !--       Send local grid to client.
     502          CALL pmc_send_to_client( client_id, Define_coarse_grid_real, 9, 0,   &
     503                                   21, ierr )
     504          CALL pmc_send_to_client( client_id, Define_coarse_grid_int,  3, 0,   &
     505                                   22, ierr )
     506
     507!
     508!--       Send local grid to client
    444509          CALL pmc_send_to_client( client_id, coord_x, nx+1+2*nbgp, 0, 24, ierr )
    445510          CALL pmc_send_to_client( client_id, coord_y, ny+1+2*nbgp, 0, 25, ierr )
    446511
    447512!
    448 !--       Also send the dzu-, dzw-, zu- and zw-arrays here.   
     513!--       Also send the dzu-, dzw-, zu- and zw-arrays here
    449514          CALL pmc_send_to_client( client_id, dzu, nz_cl + 1, 0, 26, ierr )
    450515          CALL pmc_send_to_client( client_id, dzw, nz_cl + 1, 0, 27, ierr )
    … …  
    454519       ENDIF
    455520
    456        CALL MPI_Bcast( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
     521       CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
    457522       IF ( nomatch /= 0 ) THEN
    458           WRITE ( message_string, * )  'Error: nested client domain does not fit ',    &
    459                                        'into its server domain'
     523          WRITE ( message_string, * )  'Error: nested client domain does ',    &
     524                                       'not fit into its server domain'
    460525          CALL message( 'pmc_palm_setup_server', 'PA0XYZ', 1, 2, 0, 6, 0 )
    461526       ENDIF
    462527     
    463        CALL MPI_Bcast( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
     528       CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
    464529       
    465530       CALL pmci_create_index_list
    … …  
    468533!--    Include couple arrays into server content
    469534       DO  WHILE ( pmc_s_getnextarray( client_id, myname ) )
    470           CALL pmci_set_array_pointer( myName, client_id = client_id, nz_cl = nz_cl )
     535          CALL pmci_set_array_pointer( myname, client_id = client_id,          &
     536                                       nz_cl = nz_cl )
    471537       ENDDO
    472538       CALL pmc_s_setind_and_allocmem( client_id )
    473539    ENDDO
    474540
    475 #endif
    476 
    477 
    478541 CONTAINS
    479542
    480543
    481544   SUBROUTINE pmci_create_index_list
     545
    482546       IMPLICIT NONE
     547
    483548       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !:
    484549       INTEGER(iwp)                               ::  i                  !:
    … …  
    504569          CALL pmc_recv_from_client( client_id, size_of_array, 2, 0, 40, ierr )
    505570          ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) )
    506           CALL pmc_recv_from_client( client_id, coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
     571          CALL pmc_recv_from_client( client_id, coarse_bound_all,              &
     572                                     SIZE( coarse_bound_all ), 0, 41, ierr )
    507573
    508574!
    … …  
    519585          ALLOCATE( index_list(6,ic) )
    520586
    521           CALL MPI_Comm_size( comm1dx, npx, ierr )
    522           CALL MPI_Comm_size( comm1dy, npy, ierr )
     587          CALL MPI_COMM_SIZE( comm1dx, npx, ierr )
     588          CALL MPI_COMM_SIZE( comm1dy, npy, ierr )
    523589
    524590          nrx = nxr - nxl + 1   !  +1 in index because FORTRAN indexing starts with 1, palm with 0
    … …  
    532598                   scoord(1) = px
    533599                   scoord(2) = py
    534                    CALL MPI_Cart_rank( comm2d, scoord, server_pe, ierr )
     600                   CALL MPI_CART_RANK( comm2d, scoord, server_pe, ierr )
    535601                 
    536602                   ic = ic + 1
    … …  
    546612          CALL pmc_s_set_2d_index_list( client_id, index_list(:,1:ic) )
    547613       ELSE
    548           ALLOCATE( index_list(6,1) )                                   !  Dummy allocate
     614          ALLOCATE( index_list(6,1) )    !  Dummy allocate
    549615          CALL pmc_s_set_2d_index_list( client_id, index_list )
    550616       ENDIF
    … …  
    554620     END SUBROUTINE pmci_create_index_list
    555621
    556 
     622#endif
    557623 END SUBROUTINE pmci_setup_server
    558624
    … …  
    560626
    561627 SUBROUTINE pmci_setup_client
     628
     629#if defined( __parallel )
    562630    IMPLICIT NONE
     631
     632    CHARACTER(LEN=DA_Namelen)  ::  myname     !:
     633
    563634    INTEGER(iwp)               ::  i          !:
    564635    INTEGER(iwp)               ::  ierr       !:
    … …  
    579650    REAL(wp), DIMENSION(4)     ::  ztt        !:
    580651                                             
    581     CHARACTER(LEN=DA_Namelen)  ::  myname     !:
    582 
    583 
    584 #if defined PMC_ACTIVE
    585     IF ( .not. pmc_is_rootmodel() )  THEN     !  Root Model does not have Server and is not a client
     652
     653!-- TO_DO: describe what is happening in this if-clause
     654!-- Root Model does not have Server and is not a client
     655    IF ( .NOT. pmc_is_rootmodel() )  THEN
    586656       CALL pmc_clientinit
    587657       
    … …  
    596666
    597667!
    598 !--    Update this list appropritely and also in create_client_arrays and in pmci_set_array_pointer.
    599 !--    If a variable is removed, it only has tobe removed from here.
    600        CALL pmc_set_dataarray_name( lastentry = .true. )
    601 
    602 !
    603 !--    Send grid to Server
     668!--    Update this list appropritely and also in create_client_arrays and in
     669!--    pmci_set_array_pointer.
     670!--    If a variable is removed, it only has to be removed from here.
     671       CALL pmc_set_dataarray_name( lastentry = .TRUE. )
     672
     673!
     674!--    Send grid to server
    604675       val(1)  = nx
    605676       val(2)  = ny
    … …  
    621692
    622693!
    623 !--       Receive also the dz-,zu- and zw-arrays here.         
     694!--       Receive also the dz-,zu- and zw-arrays here.
     695!--       TO_DO: what is the meaning of above comment + remove write statements
     696!--              and give this informations in header
    624697          WRITE(0,*) 'Coarse grid from Server '
    625698          WRITE(0,*) 'startx_tot    = ',define_coarse_grid_real(1)
    … …  
    635708       ENDIF
    636709
    637        CALL MPI_Bcast( define_coarse_grid_real, 9, MPI_REAL, 0, comm2d, ierr )
    638        CALL MPI_Bcast( define_coarse_grid_int, 3, MPI_INTEGER, 0, comm2d, ierr )
     710       CALL MPI_BCAST( define_coarse_grid_real, 9, MPI_REAL, 0, comm2d, ierr )
     711       CALL MPI_BCAST( define_coarse_grid_int, 3, MPI_INTEGER, 0, comm2d, ierr )
    639712
    640713       cg%dx = define_coarse_grid_real(5)
    … …  
    658731!--    Get coarse grid coordinates and vales of the z-direction from server
    659732       IF ( myid == 0) THEN
    660           CALL pmc_recv_from_server( cg%coord_x, cg%nx + 1 + 2 * nbgp, 0, 24, ierr )
    661           CALL pmc_recv_from_server( cg%coord_y, cg%ny + 1 + 2 * nbgp, 0, 25, ierr )         
     733          CALL pmc_recv_from_server( cg%coord_x, cg%nx + 1 + 2 * nbgp, 0, 24,  &
     734                                     ierr )
     735          CALL pmc_recv_from_server( cg%coord_y, cg%ny + 1 + 2 * nbgp, 0, 25,  &
     736                                     ierr )
    662737          CALL pmc_recv_from_server( cg%dzu, cg%nz + 1, 0, 26, ierr )
    663738          CALL pmc_recv_from_server( cg%dzw, cg%nz + 1, 0, 27, ierr )
    … …  
    668743!
    669744!--    and broadcast this information
    670        CALL MPI_Bcast( cg%coord_x, cg%nx + 1 + 2 * nbgp, MPI_REAL, 0, comm2d, ierr )
    671        CALL MPI_Bcast( cg%coord_y, cg%ny + 1 + 2 * nbgp, MPI_REAL, 0, comm2d, ierr )
    672        CALL MPI_Bcast( cg%dzu, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
    673        CALL MPI_Bcast( cg%dzw, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
    674        CALL MPI_Bcast( cg%zu, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
    675        CALL MPI_Bcast( cg%zw, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
     745       CALL MPI_BCAST( cg%coord_x, cg%nx + 1 + 2 * nbgp, MPI_REAL, 0, comm2d,  &
     746                       ierr )
     747       CALL MPI_BCAST( cg%coord_y, cg%ny + 1 + 2 * nbgp, MPI_REAL, 0, comm2d,  &
     748                       ierr )
     749       CALL MPI_BCAST( cg%dzu, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
     750       CALL MPI_BCAST( cg%dzw, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
     751       CALL MPI_BCAST( cg%zu, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
     752       CALL MPI_BCAST( cg%zw, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
    676753       
    677754       CALL pmci_map_fine_to_coarse_grid
    678 
    679755       CALL pmc_c_get_2d_index_list
    680756
    … …  
    682758!--    Include couple arrays into client content.
    683759       DO  WHILE ( pmc_c_getnextarray( myname ) )
    684           CALL pmci_create_client_arrays ( myName, icl, icr, jcs, jcn,  cg%nz )   !  Klaus, why the c-arrays are still up to cg%nz??
     760!--       TO_DO: Klaus, why the c-arrays are still up to cg%nz??
     761          CALL pmci_create_client_arrays ( myname, icl, icr, jcs, jcn, cg%nz )
    685762       ENDDO
    686763       CALL pmc_c_setind_and_allocmem
    687764
    688765!
    689 !--    Precompute interpolation coefficients and client-array indices.
     766!--    Precompute interpolation coefficients and client-array indices
    690767       CALL pmci_init_interp_tril
    691768
    … …  
    695772
    696773!
    697 !--    Define the SGS-TKE scaling factor based on the grid-spacing ratio.
     774!--    Define the SGS-TKE scaling factor based on the grid-spacing ratio
    698775       CALL pmci_init_tkefactor
    699776
    700777!
    701778!--    Two-way coupling     
    702        IF ( nesting_mode == 'two-way' ) THEN
     779       IF ( nesting_mode == 'two-way' )  THEN
    703780          CALL pmci_init_anterp_tophat
    704781       ENDIF
    … …  
    712789
    713790!
    714 !--    Why not just simply? test this!
     791!--    TO_DO: Why not just simply? test this!
    715792       !area_t_l = ( nx + 1 ) * (ny + 1 ) * dx * dy           
    716793
    717     ENDIF   !  IF ( .not. PMC_is_RootModel )
    718 #endif
    719 
     794    ENDIF
    720795
    721796 CONTAINS
    … …  
    723798
    724799    SUBROUTINE pmci_map_fine_to_coarse_grid
     800
    725801        IMPLICIT NONE
     802
    726803        INTEGER(iwp), DIMENSION(5,numprocs)  ::  coarse_bound_all   !:
    727804        INTEGER(iwp), DIMENSION(2)           ::  size_of_array      !:
    … …  
    730807        REAL(wp)                             ::  coarse_dy   !:
    731808        REAL(wp)                             ::  loffset     !:
     809        REAL(wp)                             ::  noffset     !:
    732810        REAL(wp)                             ::  roffset     !:
    733         REAL(wp)                             ::  noffset     !:
    734811        REAL(wp)                             ::  soffset     !:
    735812
    … …  
    792869!
    793870!--     Note that MPI_Gather receives data from all processes in the rank order.
    794         CALL MPI_Gather( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, &
     871        CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, &
    795872                         MPI_INTEGER, 0, comm2d, ierr )
    796873
    … …  
    9681045         DO  i = nxl - 1, nxl
    9691046            DO  j = nys, nyn
    970                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1047               nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i),   &
     1048                                        nzb_v_inner(j,i), nzb_w_inner(j,i) )
    9711049            ENDDO
    9721050         ENDDO
    … …  
    9781056         i = nxr + 1
    9791057         DO  j = nys, nyn
    980             nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1058            nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i),      &
     1059                                     nzb_v_inner(j,i), nzb_w_inner(j,i) )
    9811060         ENDDO
    9821061         nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1       
    … …  
    9871066         DO  j = nys - 1, nys
    9881067            DO  i = nxl, nxr
    989                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1068               nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i),   &
     1069                                        nzb_v_inner(j,i), nzb_w_inner(j,i) )
    9901070            ENDDO
    9911071         ENDDO
    … …  
    9971077         j = nyn + 1
    9981078         DO  i = nxl, nxr
    999             nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
     1079            nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i),      &
     1080                                     nzb_v_inner(j,i), nzb_w_inner(j,i) )
    10001081         ENDDO
    10011082         nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
    … …  
    10031084
    10041085!
    1005 !--  Then determine the maximum number of near-wall nodes per wall point based on the grid-spacing ratios.
    1006       nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r, nzt_topo_nestbc_s, nzt_topo_nestbc_n )
    1007       ni = CEILING( cg%dx / dx ) / 2   !  Note that the outer division must be integer division.
    1008       nj = CEILING( cg%dy / dy ) / 2   !  Note that the outer division must be integer division.
     1086!--   Then determine the maximum number of near-wall nodes per wall point based
     1087!--   on the grid-spacing ratios.
     1088      nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r,                &
     1089                          nzt_topo_nestbc_s, nzt_topo_nestbc_n )
     1090
     1091!
     1092!--   Note that the outer division must be integer division.
     1093      ni = CEILING( cg%dx / dx ) / 2
     1094      nj = CEILING( cg%dy / dy ) / 2
    10091095      nk = 1
    10101096      DO  k = 1, nzt_topo_max
    … …  
    10181104
    10191105!
    1020 !--   First horizontal walls.
    1021 !--   Left boundary.
     1106!--   First horizontal walls
     1107!--   Left boundary
    10221108      IF ( nest_bound_l )   THEN
    10231109         ALLOCATE( logc_u_l(nzb:nzt_topo_nestbc_l, nys:nyn, 1:2) )
    … …  
    10331119
    10341120         DO  j = nys, nyn     
    1035 
    1036 !
    1037 !--         Left boundary for u.
     1121!
     1122!--         Left boundary for u
    10381123            i   = 0
    10391124            kb  = nzb_u_inner(j,i)
    10401125            k   = kb + 1
    10411126            wall_index = kb
    1042             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1127            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1128                                     wall_index, z0(j,i), kb, direction, ncorr )
    10431129            logc_u_l(k,j,1) = lc
    10441130            logc_ratio_u_l(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
    … …  
    10461132
    10471133!
    1048 !--         Left boundary for v.
     1134!--         Left boundary for v
    10491135            i   = -1
    10501136            kb  =  nzb_v_inner(j,i)
    10511137            k   =  kb + 1
    10521138            wall_index = kb
    1053             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1139            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1140                                     wall_index, z0(j,i), kb, direction, ncorr )
    10541141            logc_v_l(k,j,1) = lc
    10551142            logc_ratio_v_l(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
    10561143            lcr(0:ncorr-1) = 1.0_wp
    1057          ENDDO
    1058       ENDIF
    1059 
    1060 !
    1061 !--   Right boundary.
     1144
     1145         ENDDO
     1146      ENDIF
     1147
     1148!
     1149!--   Right boundary
    10621150      IF ( nest_bound_r )  THEN
    10631151         ALLOCATE( logc_u_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2) )
    … …  
    10711159         direction      = 1
    10721160         inc            = 1 
    1073          DO  j = nys, nyn         
    1074 
     1161         DO  j = nys, nyn
    10751162!
    10761163!--         Right boundary for u.
    … …  
    10791166            k   = kb + 1
    10801167            wall_index = kb
    1081             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1168            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1169                                     wall_index, z0(j,i), kb, direction, ncorr )
    10821170            logc_u_r(k,j,1) = lc
    10831171            logc_ratio_u_r(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
    … …  
    10901178            k   = kb + 1
    10911179            wall_index = kb
    1092             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1180            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1181                                     wall_index, z0(j,i), kb, direction, ncorr )
    10931182            logc_v_r(k,j,1) = lc
    10941183            logc_ratio_v_r(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
    10951184            lcr(0:ncorr-1) = 1.0_wp
    1096          ENDDO
    1097       ENDIF
    1098 
    1099 !
    1100 !--   South boundary.
     1185
     1186         ENDDO
     1187      ENDIF
     1188
     1189!
     1190!--   South boundary
    11011191      IF ( nest_bound_s )  THEN
    11021192         ALLOCATE( logc_u_s(nzb:nzt_topo_nestbc_s,nxl:nxr,1:2) )
    … …  
    11111201         inc            = 1
    11121202         DO  i = nxl, nxr
    1113 
    11141203!
    11151204!--         South boundary for u.
    … …  
    11181207            k   =  kb + 1
    11191208            wall_index = kb
    1120             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1209            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1210                                     wall_index, z0(j,i), kb, direction, ncorr )
    11211211            logc_u_s(k,i,1) = lc
    11221212            logc_ratio_u_s(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
    … …  
    11241214
    11251215!
    1126 !--         South boundary for v.
     1216!--         South boundary for v
    11271217            j   = 0
    11281218            kb  = nzb_v_inner(j,i)
    11291219            k   = kb + 1
    11301220            wall_index = kb
    1131             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1221            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1222                                     wall_index, z0(j,i), kb, direction, ncorr )
    11321223            logc_v_s(k,i,1) = lc
    11331224            logc_ratio_v_s(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
    … …  
    11371228
    11381229!
    1139 !--   North boundary.
     1230!--   North boundary
    11401231      IF ( nest_bound_n )  THEN
    11411232         ALLOCATE( logc_u_n(nzb:nzt_topo_nestbc_n,nxl:nxr,1:2) )
    … …  
    11491240         direction      = 1
    11501241         inc            = 1
    1151          DO  i = nxl, nxr       
    1152 
     1242         DO  i = nxl, nxr
    11531243!
    11541244!--         North boundary for u.
    … …  
    11571247            k   = kb + 1
    11581248            wall_index = kb
    1159             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1249            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1250                                     wall_index, z0(j,i), kb, direction, ncorr )
    11601251            logc_u_n(k,i,1) = lc
    11611252            logc_ratio_u_n(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
    … …  
    11681259            k   = kb + 1
    11691260            wall_index = kb
    1170             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
     1261            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, &
     1262                                     wall_index, z0(j,i), kb, direction, ncorr )
    11711263            logc_v_n(k,i,1) = lc
    11721264            logc_ratio_v_n(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
    11731265            lcr(0:ncorr-1) = 1.0_wp
     1266
    11741267         ENDDO
    11751268      ENDIF
    … …  
    20112104    END SUBROUTINE pmci_init_tkefactor
    20122105
    2013 
     2106#endif
    20142107 END SUBROUTINE pmci_setup_client
    20152108
    … …  
    20172110
    20182111 SUBROUTINE pmci_setup_coordinates
     2112
     2113#if defined( __parallel )
    20192114    IMPLICIT NONE
     2115
    20202116    INTEGER(iwp) ::  i   !:
    20212117    INTEGER(iwp) ::  j   !:
    … …  
    20332129       coord_y(j) = lower_left_coord_y + j * dy
    20342130    ENDDO
    2035      
     2131
     2132#endif
    20362133 END SUBROUTINE pmci_setup_coordinates
    20372134
    … …  
    20402137 SUBROUTINE pmci_server_synchronize
    20412138
     2139#if defined( __parallel )
    20422140!
    20432141!-- Unify the time steps for each model and synchronize.
    … …  
    20662164!
    20672165!-- Broadcast the unified time step to all server processes.
    2068     CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
     2166    CALL MPI_BCAST( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
    20692167
    20702168!
    … …  
    20762174       ENDIF
    20772175    ENDDO
    2078    
     2176
     2177#endif
    20792178 END SUBROUTINE pmci_server_synchronize
    20802179
    … …  
    20832182 SUBROUTINE pmci_client_synchronize
    20842183
     2184#if defined( __parallel )
    20852185!
    20862186!-- Unify the time steps for each model and synchronize.
    … …  
    21052205!
    21062206!--    Broadcast the unified time step to all server processes.
    2107        CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
     2207       CALL MPI_BCAST( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
    21082208    ENDIF
    21092209
     2210#endif
    21102211 END SUBROUTINE pmci_client_synchronize
    21112212               
    … …  
    21132214
    21142215 SUBROUTINE pmci_server_datatrans( direction )
     2216
    21152217    IMPLICIT NONE
     2218
    21162219    INTEGER(iwp),INTENT(IN) ::  direction   !:
     2220
     2221#if defined( __parallel )
    21172222    INTEGER(iwp)            ::  client_id   !:
    21182223    INTEGER(iwp)            ::  i           !:
    … …  
    21382243!
    21392244!-- Broadcast the unified time step to all server processes.
    2140     CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
     2245    CALL MPI_BCAST( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
    21412246
    21422247    DO  m = 1, SIZE( PMC_Server_for_Client ) - 1
    … …  
    21852290    ENDDO
    21862291
     2292#endif
    21872293 END SUBROUTINE pmci_server_datatrans
    21882294
    … …  
    21902296
    21912297 SUBROUTINE pmci_client_datatrans( direction )
     2298
    21922299    IMPLICIT NONE
     2300
    21932301    INTEGER(iwp), INTENT(IN) ::  direction   !:
     2302
     2303#if defined( __parallel )
    21942304    INTEGER(iwp)             ::  ierr        !:
    21952305    INTEGER(iwp)             ::  icl         !:
    … …  
    22142324!
    22152325!--    Broadcast the unified time step to all server processes.
    2216        CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
     2326       CALL MPI_BCAST( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
    22172327       CALL cpu_log( log_point_s(70), 'PMC model sync', 'stop' )
    22182328
    … …  
    31793289!--            Spatial under-relaxation.
    31803290               fra  = frax(l) * fray(m) * fraz(n)
     3291!--            TO_DO: why not KIND=wp ?
    31813292               fc(n,m,l) = ( 1.0_wp - fra ) * fc(n,m,l) + fra * cellsum / REAL( nfc, KIND=KIND(cellsum) ) 
    31823293            ENDDO
    … …  
    31863297   END SUBROUTINE pmci_anterp_tophat
    31873298
    3188 
     3299#endif
    31893300 END SUBROUTINE pmci_client_datatrans
    31903301
    … …  
    31933304 SUBROUTINE pmci_update_new
    31943305
     3306#if defined( __parallel )
    31953307!
    31963308!-- Copy the interpolated/anterpolated boundary values to the _p
    … …  
    32193331
    32203332!
    3221 !-- Find out later if nesting would work without __nopointer.
     3333!-- TO_DO: Find out later if nesting would work without __nopointer.
     3334#endif
    32223335
    32233336 END SUBROUTINE pmci_update_new
    … …  
    32263339
    32273340 SUBROUTINE pmci_set_array_pointer( name, client_id, nz_cl )
     3341
    32283342    IMPLICIT NONE
    32293343
    … …  
    32323346    CHARACTER(LEN=*), INTENT(IN)         ::  name        !:
    32333347   
     3348#if defined( __parallel )
    32343349    REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d        !:
    32353350    REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d        !:
    … …  
    32383353   
    32393354
    3240 #if defined PMC_ACTIVE
    32413355    NULLIFY( p_3d )
    32423356    NULLIFY( p_2d )
    … …  
    32573371       CALL pmc_s_set_dataarray( client_id, p_2d )
    32583372    ELSE
    3259        IF ( myid == 0 ) WRITE( 0, * )  'PMC set_array_Pointer -> no pointer p_2d or p_3d associated '
    3260        CALL MPI_Abort( MPI_COMM_WORLD, istat, ierr )
     3373!
     3374!--    Give only one message for the root domain
     3375       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
     3376
     3377          message_string = 'pointer for array "' // TRIM( name ) //            &
     3378                           '" can''t be associated'
     3379          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
     3380       ELSE
     3381!
     3382!--       Avoid others to continue
     3383          CALL MPI_BARRIER( comm2d, ierr )
     3384       ENDIF
    32613385    ENDIF
    32623386
    32633387#endif
    3264 
    32653388 END SUBROUTINE pmci_set_array_pointer
    32663389
    … …  
    32683391
    32693392 SUBROUTINE pmci_create_client_arrays( name, is, ie, js, je, nzc  )
     3393
    32703394    IMPLICIT NONE
     3395
    32713396    INTEGER(iwp), INTENT(IN)              ::  ie      !:
    32723397    INTEGER(iwp), INTENT(IN)              ::  is      !:
    … …  
    32763401    CHARACTER(LEN=*), INTENT(IN)          ::  name    !:
    32773402     
     3403#if defined( __parallel )
    32783404    REAL(wp), POINTER,DIMENSION(:,:)      ::  p_2d    !:
    32793405    REAL(wp), POINTER,DIMENSION(:,:,:)    ::  p_3d    !:
    … …  
    32823408
    32833409
    3284 #if defined PMC_ACTIVE
    32853410    NULLIFY( p_3d )
    32863411    NULLIFY( p_2d )
    … …  
    33173442       CALL pmc_c_set_dataarray( p_2d )
    33183443    ELSE
    3319        IF ( myid == 0 ) WRITE( 0 , * )  'PMC create_client_arrays -> no pointer p_2d or p_3d associated '
    3320        CALL MPI_Abort( MPI_COMM_WORLD, istat, ierr )
     3444!
     3445!--    Give only one message for the first client domain
     3446       IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
     3447
     3448          message_string = 'pointer for array "' // TRIM( name ) //            &
     3449                           '" can''t be associated'
     3450          CALL message( 'pmci_create_client_arrays', 'PA0170', 3, 2, 0, 6, 0 )
     3451       ELSE
     3452!
     3453!--       Avoid others to continue
     3454          CALL MPI_BARRIER( comm2d, ierr )
     3455       ENDIF
    33213456    ENDIF
     3457
    33223458#endif
    3323 
    33243459 END SUBROUTINE pmci_create_client_arrays
    33253460
    … …  
    33273462
    33283463 SUBROUTINE pmci_server_initialize
     3464
     3465#if defined( __parallel )
    33293466    IMPLICIT NONE
     3467
    33303468    INTEGER(iwp)   ::  client_id   !:
    33313469    INTEGER(iwp)   ::  m           !:
    … …  
    33383476    ENDDO
    33393477
     3478#endif
    33403479 END SUBROUTINE pmci_server_initialize
    33413480
    … …  
    33443483 SUBROUTINE pmci_client_initialize
    33453484
     3485#if defined( __parallel )
    33463486    IMPLICIT NONE
     3487
    33473488    INTEGER(iwp)   ::  i          !:
    33483489    INTEGER(iwp)   ::  icl        !:
    … …  
    34283569      INTEGER(iwp) ::  i      !:
    34293570      INTEGER(iwp) ::  ib     !:
     3571      INTEGER(iwp) ::  ie     !:
    34303572      INTEGER(iwp) ::  j      !:
    34313573      INTEGER(iwp) ::  jb     !:
     3574      INTEGER(iwp) ::  je     !:
    34323575      INTEGER(iwp) ::  k      !:
    34333576      INTEGER(iwp) ::  k1     !:
    … …  
    34483591     
    34493592      ib = nxl
    3450       jb = nys     
     3593      ie = nxr
     3594      jb = nys   
     3595      je = nyn
    34513596      IF ( nest_bound_l )  THEN
     3597         ib = nxl - 1
    34523598         IF ( var == 'u' )  THEN   !  For u, nxl is a ghost node, but not for the other variables.
    3453             ib = nxl + 1
     3599            ib = nxl
    34543600         ENDIF
    34553601      ENDIF
    34563602      IF ( nest_bound_s )  THEN
     3603         jb = nys - 1
    34573604         IF ( var == 'v' )  THEN   !  For v, nys is a ghost node, but not for the other variables.
    3458             jb = nys + 1
     3605            jb = nys
    34593606         ENDIF
    34603607      ENDIF
     3608      IF ( nest_bound_r )  THEN
     3609         ie = nxr + 1
     3610      ENDIF
     3611      IF ( nest_bound_n )  THEN
     3612         je = nyn + 1
     3613      ENDIF
    34613614
    34623615!
    34633616!--   Trilinear interpolation.
    3464       DO  i = ib, nxr
    3465          DO  j = jb, nyn
    3466             DO  k = kb(j,i), nzt
     3617      DO  i = ib, ie
     3618         DO  j = jb, je
     3619            DO  k = kb(j,i), nzt + 1
    34673620               l = ic(i)
    34683621               m = jc(j)
    … …  
    35173670   END SUBROUTINE pmci_interp_tril_all
    35183671
     3672#endif
    35193673 END SUBROUTINE pmci_client_initialize
    35203674
    … …  
    35233677 SUBROUTINE pmci_ensure_nest_mass_conservation
    35243678
     3679#if defined( __parallel )
    35253680!
    35263681!-- Adjust the volume-flow rate through the top boundary
    … …  
    36353790    ENDDO
    36363791
     3792#endif
    36373793 END SUBROUTINE pmci_ensure_nest_mass_conservation
    36383794
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |