SUBROUTINE SWAPBOUNDS(FIELD,X_SIZE_IN,Y_SIZE_IN, 509GPB2F404.420
& X_OFF_IN,Y_OFF_IN,N_LEVELS_IN) GPB2F404.421
GPB2F404.422
IMPLICIT NONE GPB2F404.423
! GPB2F404.424
! Description: GPB2F404.425
! This routine fills the halo areas (of size X_OFF in the x dimension GPB2F404.426
! and Y_OFF in the y dimension) of the first N_LEVELS of the array GPB2F404.427
! FIELD with the appropriate data from adjacent processors. GPB2F404.428
! If *DEF,GLOBAL is set, a east-west wrap around of data will GPB2F404.429
! occur. GPB2F404.430
! GPB2F404.431
! Method: GPB2F404.432
! T3E: Data is directly transferred between FIELD arrays on GPB2F404.433
! neighbouring processors via shmem calls. GPB2F404.434
! GPB2F404.435
! Current Code Owner: Paul Burton GPB2F404.436
! GPB2F404.437
! History: GPB2F404.438
! Model Date Modification history from model version 4.3 GPB2F404.439
! version GPB2F404.440
! 4.3 8/3/97 New optimised version of swapbouind P.Burton GPB2F404.441
! GPB2F404.442
! Subroutine Arguments: GPB2F404.443
GPB2F404.444
INTEGER GPB2F404.445
& X_SIZE_IN ! IN : X dimension of field (inc. halos) GPB2F404.446
&, Y_SIZE_IN ! IN : Y dimension of field (inc. halos) GPB2F404.447
&, X_OFF_IN ! IN : X halo size GPB2F404.448
&, Y_OFF_IN ! IN : Y halo size GPB2F404.449
&, N_LEVELS_IN ! IN : Number of levels to be swapped GPB2F404.450
GPB2F404.451
REAL FIELD(X_SIZE_IN*Y_SIZE_IN,N_LEVELS_IN) GPB2F404.452
! ! IN/OUT : Field to take place in GPB2F404.453
! ! boundary data exchange. GPB2F404.454
GPB2F404.455
! Parameters and Common blocks GPB2F404.456
GPB2F404.457
*CALL PARVARS 
GPB2F404.458
GPB2F404.459
! Local variables GPB2F404.460
GPB2F404.461
INTEGER GPB2F404.462
& X_SIZE ! copies of arguments GPB2F404.463
&, Y_SIZE ! required for stream safe code GPB2F404.464
&, X_OFF ! these variables are spatially seperated GPB2F404.465
&, Y_OFF ! from all communicated variables GPB2F404.466
&, N_LEVELS GPB2F404.467
GPB2F404.468
INTEGER GPB2F404.469
& array_address ! address of my FIELD array GPB2F404.470
&, size_x ! my X_SIZE GPB2F404.471
&, size_y ! my Y_SIZE GPB2F404.472
&, align_vars(3) ! equivalenced copies of above 3 vars. GPB2F404.473
GPB2F404.474
INTEGER GPB2F404.475
& remote_address ! address of FIELD array on remote processor GPB2F404.476
&, remote_size_x ! remote array's X_SIZE GPB2F404.477
&, remote_size_y ! remote array's Y_SIZE GPB2F404.478
&, remote_vars(3) ! equivalenced copies of above 3 vars. GPB2F404.479
GPB2F404.480
EQUIVALENCE GPB2F404.481
& (align_vars(1),array_address), GPB2F404.482
& (align_vars(2),size_x), GPB2F404.483
& (align_vars(3),size_y), GPB2F404.484
& (remote_vars(1),remote_address), GPB2F404.485
& (remote_vars(2),remote_size_x), GPB2F404.486
& (remote_vars(3),remote_size_y) GPB2F404.487
GPB2F404.488
INTEGER ! variables describing comms. pattern GPB2F404.489
& el_len ! length of element to send GPB2F404.490
&, n_els ! number of elements to put/get GPB2F404.491
&, loc_start ! start in local array GPB2F404.492
&, rem_start ! start in remote array GPB2F404.493
&, loc_stride ! stride in local array GPB2F404.494
&, rem_stride ! stride in remote array GPB2F404.495
GPB2F404.496
REAL GPB2F404.497
& remote_array((X_SIZE_IN+1)*(Y_SIZE_IN+1)*N_LEVELS_IN) GPB2F404.498
POINTER (ptr,remote_array) GPB2F404.499
! remote_array is used to generate the address of the field array on GPB2F404.500
! the remote processor - so the size is made such that no out of GPB2F404.501
! bounds references will be made - nothing is physically writtten or GPB2F404.502
! read from this array. The size is defined assuming that the GPB2F404.503
! decomposition is such that the maximum difference between X_SIZE GPB2F404.504
! and Y_SIZE on neighbouring processors is no more than 1. GPB2F404.505
! The Pointer ptr allows the address of remote_array to be set by GPB2F404.506
! changing the value of ptr. We will set ptr to the address of FIELD GPB2F404.507
! on the remote processor - so effectively allowing us to produce GPB2F404.508
! the address of any element of the remote FIELD array by generating GPB2F404.509
! the corresponding element of the remote_array array. GPB2F404.510
GPB2F404.511
! Loop indexes GPB2F404.512
GPB2F404.513
INTEGER GPB2F404.514
& k ! loop over levels GPB2F404.515
&, i ! loop over columns in EW halo GPB2F404.516
&, j ! loop over rows in NS halo GPB2F404.517
GPB2F404.518
! COMMON block GPB2F404.519
! Only align_vars needs to be on COMMON. The other variables are GPB2F404.520
! there to ensure they are spatially seperated from any GPB2F404.521
! communicated variables - so making the code stream safe GPB2F404.522
GPB2F404.523
COMMON /swapbnd_ss_common/ GPB2F404.524
& align_vars GPB2F404.525
GPB2F404.526
!------------------------------------------------------------------ GPB2F404.527
! 0.0 Copy arguments into stream safe variables GPB2F404.528
GPB2F404.529
X_SIZE=X_SIZE_IN GPB2F404.530
Y_SIZE=Y_SIZE_IN GPB2F404.531
X_OFF=X_OFF_IN GPB2F404.532
Y_OFF=Y_OFF_IN GPB2F404.533
N_LEVELS=N_LEVELS_IN GPB2F404.534
GPB2F404.535
!------------------------------------------------------------------ GPB2F404.536
! 1.0 Set up the align_vars COMMON block with my local information GPB2F404.537
! so that other processors can access it. GPB2F404.538
GPB2F404.539
array_address=LOC(FIELD) ! set to the start address of my GPB2F404.540
! ! FIELD array GPB2F404.541
size_x=X_SIZE GPB2F404.542
size_y=Y_SIZE GPB2F404.543
GPB2F404.544
CALL barrier() GPB2F404.545
GPB2F404.546
! Once this barrier is passed we know that we can safely access GPB2F404.547
! remote align_vars GPB2F404.548
GPB2F404.549
!------------------------------------------------------------------ GPB2F404.550
! 2.0 First thing we'll do is East-West communications. We'll use GPB2F404.551
! shmem_get as this means we don't have to barrier before GPB2F404.552
! doing the North-South communications - as the get operation GPB2F404.553
! ensures we've updated our EW halos before we start GPB2F404.554
! shmem_putting data in the North-South direction (this is GPB2F404.555
! important for the corners - as we'll effectively be shifting GPB2F404.556
! data from our EW neighbours to our NS neighbours). GPB2F404.557
GPB2F404.558
IF (X_OFF .GT. 0) THEN ! EW halos exist GPB2F404.559
GPB2F404.560
n_els=Y_SIZE-2*Y_OFF ! number of rows of EW halo data GPB2F404.561
! ! (minus NS halos) GPB2F404.562
loc_stride=X_SIZE GPB2F404.563
GPB2F404.564
GPB2F404.565
!-------------------------------- GPB2F404.566
! 2.1 Get halo data from our Western neighbour GPB2F404.567
GPB2F404.568
IF (neighbour(PWest) .NE. NoDomain) THEN GPB2F404.569
GPB2F404.570
! Get address and size information from my Western neighbour GPB2F404.571
GPB2F404.572
CALL shmem_get(remote_vars,align_vars,3,neighbour(PWest)) GPB2F404.573
GPB2F404.574
ptr=remote_address ! address of FIELD on PE to West GPB2F404.575
GPB2F404.576
rem_stride=remote_size_x GPB2F404.577
GPB2F404.578
IF (X_OFF .EQ. 1) THEN ! special optimised case GPB2F404.579
GPB2F404.580
loc_start=Y_OFF*X_SIZE + 1 GPB2F404.581
GPB2F404.582
DO k=1,N_LEVELS GPB2F404.583
GPB2F404.584
rem_start=(k-1)*remote_size_x*remote_size_y + GPB2F404.585
& (Y_OFF+1)*remote_size_x - 2*X_OFF + 1 GPB2F404.586
GPB2F404.587
! The iget call is strided shmem_get - the data for a whole column GPB2F404.588
! of one level of Western halo is got from the neighbouring GPB2F404.589
! processor by the single call. GPB2F404.590
GPB2F404.591
CALL shmem_iget( GPB2F404.592
& FIELD(loc_start,k),remote_array(rem_start), GPB2F404.593
& loc_stride,rem_stride, GPB2F404.594
& n_els,neighbour(PWest)) GPB2F404.595
GPB2F404.596
ENDDO ! k : loop over levels GPB2F404.597
GPB2F404.598
ELSE ! If the EW halos are greater than 1 - width GPB2F404.599
GPB2F404.600
DO k=1,N_LEVELS ! loop over levels GPB2F404.601
GPB2F404.602
DO i=1,X_OFF ! loop over columns of halo GPB2F404.603
GPB2F404.604
loc_start=Y_OFF*X_SIZE + i GPB2F404.605
GPB2F404.606
rem_start=(k-1)*remote_size_x*remote_size_y + GPB2F404.607
& (Y_OFF+1)*remote_size_x - 2*X_OFF + i GPB2F404.608
GPB2F404.609
! The iget call is strided shmem_get - the data for a whole column GPB2F404.610
! of one level of Western halo is got from the neighbouring GPB2F404.611
! processor by the single call. GPB2F404.612
GPB2F404.613
CALL shmem_iget( GPB2F404.614
& FIELD(loc_start,k),remote_array(rem_start), GPB2F404.615
& loc_stride,rem_stride, GPB2F404.616
& n_els,neighbour(PWest)) GPB2F404.617
GPB2F404.618
ENDDO ! i : loop over columns in Western halo GPB2F404.619
GPB2F404.620
ENDDO ! k : loop over levels GPB2F404.621
GPB2F404.622
ENDIF ! on the size of the EW halos GPB2F404.623
GPB2F404.624
ENDIF ! if we have a Western neighbour GPB2F404.625
GPB2F404.626
!-------------------------------- GPB2F404.627
! 2.2 Get halo data from our Eastern neighbour GPB2F404.628
GPB2F404.629
IF (neighbour(PEast) .NE. NoDomain) THEN GPB2F404.630
GPB2F404.631
! Get address and size information from my Eastern neighbour GPB2F404.632
GPB2F404.633
CALL shmem_get(remote_vars,align_vars,3,neighbour(PEast)) GPB2F404.634
GPB2F404.635
ptr=remote_address ! address of FIELD on PE to East GPB2F404.636
GPB2F404.637
rem_stride=remote_size_x GPB2F404.638
GPB2F404.639
IF (X_OFF .EQ. 1) THEN GPB2F404.640
GPB2F404.641
loc_start=(Y_OFF+1)*X_SIZE - X_OFF + 1 GPB2F404.642
GPB2F404.643
DO k=1,N_LEVELS ! loop over levels GPB2F404.644
GPB2F404.645
rem_start=(k-1)*remote_size_x*remote_size_y + GPB2F404.646
& Y_OFF*remote_size_x + X_OFF + 1 GPB2F404.647
GPB2F404.648
! The iget call is strided shmem_get - the data for a whole column GPB2F404.649
! of one level of Eastern halo is got from the neighbouring GPB2F404.650
! processor by the single call. GPB2F404.651
GPB2F404.652
CALL shmem_iget( GPB2F404.653
& FIELD(loc_start,k),remote_array(rem_start), GPB2F404.654
& loc_stride,rem_stride, GPB2F404.655
& n_els,neighbour(PEast)) GPB2F404.656
GPB2F404.657
ENDDO ! k : loop over levels GPB2F404.658
GPB2F404.659
ELSE ! If the EW halos are greater than 1 - width GPB2F404.660
GPB2F404.661
DO k=1,N_LEVELS ! loop over levels GPB2F404.662
GPB2F404.663
DO i=1,X_OFF ! loop over columns of halo GPB2F404.664
GPB2F404.665
loc_start=(Y_OFF+1)*X_SIZE - X_OFF + i GPB2F404.666
GPB2F404.667
rem_start=(k-1)*remote_size_x*remote_size_y + GPB2F404.668
& Y_OFF*remote_size_x + X_OFF + i GPB2F404.669
GPB2F404.670
GPB2F404.671
! The iget call is strided shmem_get - the data for a whole column GPB2F404.672
! of one level of Eastern halo is got from the neighbouring GPB2F404.673
! processor by the single call. GPB2F404.674
GPB2F404.675
CALL shmem_iget( GPB2F404.676
& FIELD(loc_start,k),remote_array(rem_start), GPB2F404.677
& loc_stride,rem_stride, GPB2F404.678
& n_els,neighbour(PEast)) GPB2F404.679
GPB2F404.680
ENDDO ! i : loop over columns in Eastern halo GPB2F404.681
GPB2F404.682
ENDDO ! k : loop over levels GPB2F404.683
GPB2F404.684
ENDIF ! on the size of the EW halos GPB2F404.685
GPB2F404.686
ENDIF ! if we have a Eastern neighbour GPB2F404.687
GPB2F404.688
ENDIF ! if an EW communication is required (EW halos exist) GPB2F404.689
GPB2F404.690
!------------------------------------------------------------------ GPB2F404.691
! 3.0 Now we can do the North-South halo update. Now we can use GPB2F404.692
! shmem_put to put the data into the halos. GPB2F404.693
GPB2F404.694
IF (Y_OFF .GT. 0) THEN ! NS halos exist GPB2F404.695
GPB2F404.696
el_len=X_SIZE*Y_OFF GPB2F404.697
GPB2F404.698
!-------------------------------- GPB2F404.699
! 3.1 Put halo data to our Northern neighbour GPB2F404.700
GPB2F404.701
IF (neighbour(PNorth) .NE. NoDomain) THEN GPB2F404.702
GPB2F404.703
! Get address and size information from my Northern neighbour GPB2F404.704
GPB2F404.705
CALL shmem_get(remote_vars,align_vars,3,neighbour(PNorth)) GPB2F404.706
GPB2F404.707
ptr=remote_address ! address of FIELD on PE to North GPB2F404.708
GPB2F404.709
rem_stride=remote_size_x*remote_size_y GPB2F404.710
GPB2F404.711
loc_start=Y_OFF*X_SIZE + 1 GPB2F404.712
GPB2F404.713
rem_start=remote_size_x*(remote_size_y-Y_OFF) + 1 GPB2F404.714
GPB2F404.715
DO k=1,N_LEVELS ! loop over levels GPB2F404.716
GPB2F404.717
CALL shmem_put( GPB2F404.718
& remote_array(rem_start+(k-1)*rem_stride), GPB2F404.719
& FIELD(loc_start,k), GPB2F404.720
& el_len,neighbour(PNorth)) GPB2F404.721
GPB2F404.722
ENDDO ! k : loop over levels GPB2F404.723
GPB2F404.724
GPB2F404.725
ELSE ! if there is no Northern neighbour GPB2F404.726
GPB2F404.727
! Fill in the halo with dummy data GPB2F404.728
GPB2F404.729
DO k = 1,N_LEVELS GPB2F404.730
DO j = 1,Y_OFF GPB2F404.731
DO i = 1,X_SIZE GPB2F404.732
FIELD((j-1)*X_SIZE+i,k) = FIELD(Y_OFF*X_SIZE+i,k) GPB2F404.733
END DO GPB2F404.734
END DO GPB2F404.735
END DO GPB2F404.736
GPB2F404.737
ENDIF ! if we have a Northern neighbour GPB2F404.738
GPB2F404.739
!-------------------------------- GPB2F404.740
! 3.2 Put halo data to our Southern neighbour GPB2F404.741
GPB2F404.742
IF (neighbour(PSouth) .NE. NoDomain) THEN GPB2F404.743
GPB2F404.744
! Get address and size information from my Northern neighbour GPB2F404.745
GPB2F404.746
CALL shmem_get(remote_vars,align_vars,3,neighbour(PSouth)) GPB2F404.747
GPB2F404.748
ptr=remote_address ! address of FIELD on PE to South GPB2F404.749
GPB2F404.750
rem_stride=remote_size_x*remote_size_y GPB2F404.751
GPB2F404.752
loc_start=X_SIZE*(Y_SIZE-2*Y_OFF)+1 GPB2F404.753
GPB2F404.754
rem_start=1 GPB2F404.755
GPB2F404.756
DO k=1,N_LEVELS ! loop over levels GPB2F404.757
GPB2F404.758
CALL shmem_put( GPB2F404.759
& remote_array(rem_start+(k-1)*rem_stride), GPB2F404.760
& FIELD(loc_start,k), GPB2F404.761
& el_len,neighbour(PSouth)) GPB2F404.762
GPB2F404.763
ENDDO ! k : loop over levels GPB2F404.764
GPB2F404.765
ELSE ! if we have no Southern neighbour GPB2F404.766
GPB2F404.767
DO k = 1,N_LEVELS GPB2F404.768
DO j = 1,Y_OFF GPB2F404.769
DO i = 1,X_SIZE GPB2F404.770
FIELD((Y_SIZE-j)*X_SIZE+i,k) = GPB2F404.771
& FIELD((Y_SIZE-Y_OFF-1)*X_SIZE+i,k) GPB2F404.772
END DO GPB2F404.773
END DO GPB2F404.774
END DO GPB2F404.775
GPB2F404.776
ENDIF ! if we have a Southern neighbour GPB2F404.777
GPB2F404.778
ENDIF ! if a NS communication is required (NS halos exist) GPB2F404.779
GPB2F404.780
CALL barrier() GPB2F404.781
GPB2F404.782
! Now all the halos are updated it is safe to continue GPB2F404.783
GPB2F404.784
RETURN GPB2F404.785
GPB2F404.786
END GPB2F404.787
*ENDIF GPB2F404.788