Changeset 11380 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyini.F90
- Timestamp:
- 2019-07-31T15:56:02+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyini.F90
r11356 r11380 37 37 38 38 INTEGER, PARAMETER :: jp_nseg = 100 ! 39 INTEGER :: ihl ! number of halos to be communicated 39 40 ! Straight open boundary segment parameters: 40 41 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs … … 70 71 & ln_vol, nn_volctl, nn_rimwidth 71 72 ! 72 INTEGER :: ios ! Local integer output status for namelist read 73 INTEGER :: ios ! Local integer output status for namelist read 74 INTEGER :: idbi, idbj, idei, idej ! start/end of the subdomain for extended and regular bdy treatment 73 75 !!---------------------------------------------------------------------- 74 76 … … 105 107 106 108 IF( nb_bdy == 0 ) ln_bdy = .FALSE. 107 109 110 IF( nn_hlts > 1 .AND. MOD(nn_hlts,2)==0 ) THEN 111 WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to ',nn_hlts & 112 & ,' in namelist, is here set to ', nn_hlts-1 ,' must be odd' 113 CALL ctl_warn( ctmp1 ) 114 nn_hlts = nn_hlts - 1 115 END IF 116 ! 117 IF( nn_hlts > 1 .AND. ln_tide ) THEN 118 WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to ',nn_hlts & 119 & ,' in namelist, is here set to 1 for compatibility with tide treatment' 120 CALL ctl_warn( ctmp1 ) 121 nn_hlts = 1 122 END IF 123 ! 124 IF( nn_hlts > 1 .AND. ln_bdy ) THEN 125 WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to ',nn_hlts & 126 & ,' in namelist, is here set to 1 for compatibility with boundary treatment' 127 CALL ctl_warn( ctmp1 ) 128 nn_hlts = 1 129 END IF 108 130 ! ----------------------------------------- 109 131 ! unstructured open boundaries use control … … 115 137 ! 116 138 ! Open boundaries definition (arrays and masks) 117 CALL bdy_def 139 ! extended : interior domain + global halo + halo extension for time-splitting 140 idbi = 1 - nn_hlts ; idbj = 1 - nn_hlts 141 idei = jpi + nn_hlts ; idej = jpj + nn_hlts 142 idx_bdy => idx_bdy_xtd 143 dta_bdy => dta_bdy_xtd 144 lsend_bdy => lsend_bdy_xtd(:,:,:,:) 145 lrecv_bdy => lrecv_bdy_xtd(:,:,:,:) 146 lsend_bdyint => lsend_bdyint_xtd(:,:,:,:) 147 lrecv_bdyint => lrecv_bdyint_xtd(:,:,:,:) 148 lsend_bdyext => lsend_bdyext_xtd(:,:,:,:) 149 lrecv_bdyext => lrecv_bdyext_xtd(:,:,:,:) 150 CALL bdy_def( idbi, idbj, idei, idej, .true. ) 151 CALL swap_bdyptr 152 ! regular : interior domain + global halo 153 idbi = 1 ; idbj = 1 ; idei = jpi ; idej = jpj 154 idx_bdy => idx_bdy_reg 155 dta_bdy => dta_bdy_reg 156 lsend_bdy => lsend_bdy_reg(:,:,:,:) 157 lrecv_bdy => lrecv_bdy_reg(:,:,:,:) 158 lsend_bdyint => lsend_bdyint_reg(:,:,:,:) 159 lrecv_bdyint => lrecv_bdyint_reg(:,:,:,:) 160 lsend_bdyext => lsend_bdyext_reg(:,:,:,:) 161 lrecv_bdyext => lrecv_bdyext_reg(:,:,:,:) 162 CALL bdy_def( idbi, idbj, idei, idej ) 163 ! current bdy treated is regular 164 ! 118 165 IF( ln_meshmask ) CALL bdy_meshwri() 119 166 ! … … 134 181 135 182 136 SUBROUTINE bdy_def 183 SUBROUTINE bdy_def( idbi, idbj, idei, idej, ldxtd ) 137 184 !!---------------------------------------------------------------------- 138 185 !! *** ROUTINE bdy_init *** … … 144 191 !! 145 192 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 146 !!---------------------------------------------------------------------- 193 !!---------------------------------------------------------------------- 194 INTEGER , INTENT(in) :: idbi, idbj, idei, idej ! start/end of the subdomain for extended and regular bdy treatment 195 LOGICAL, OPTIONAL, INTENT(in) :: ldxtd ! indicate if extended domain is treated (for time splitting) 147 196 INTEGER :: ib_bdy, ii, ij, igrd, ib, ir, iseg ! dummy loop indices 148 197 INTEGER :: icount, icountr, icountr0, ibr_max ! local integers 149 INTEGER :: ilen1 ! - -150 198 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 151 INTEGER :: jpbdta 199 INTEGER :: jpbdta, ilen1 ! - - 152 200 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 153 201 INTEGER :: ii1, ii2, ii3, ij1, ij2, ij3 ! - - 154 202 INTEGER :: iibe, ijbe, iibi, ijbi ! - - 203 INTEGER :: iint1, iout1, iint2, iout2 ! - - 155 204 INTEGER :: flagu, flagv ! short cuts 156 205 INTEGER :: nbdyind, nbdybeg, nbdyend 206 INTEGER :: ihl ! total number of halos ( with added halos for time splitting) 157 207 INTEGER , DIMENSION(4) :: kdimsz 158 208 INTEGER , DIMENSION(jpbgrd,jp_bdy) :: nblendta ! Length of index arrays … … 162 212 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zz_read ! work space for 2D global boundary data 163 213 REAL(wp), POINTER , DIMENSION(:,:) :: zmask ! pointer to 2D mask fields 164 REAL(wp) , DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 165 REAL(wp) , DIMENSION(jpi,jpj) :: ztmask, zumask, zvmask ! temporary u/v mask array 214 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 215 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmask, zumask, zvmask ! temporary u/v mask array 216 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zbdytmask, zbdyumask, zbdyvmask ! temporary u/v mask array 166 217 !!---------------------------------------------------------------------- 167 218 ! 168 219 cgrid = (/'t','u','v'/) 169 220 221 ihl = nn_hls 222 IF( PRESENT(ldxtd) ) THEN ; IF( ldxtd ) ihl = nn_hls + nn_hlts ; ENDIF 223 224 ALLOCATE( zfmask(idbi:idei,idbj:idej), ztmask(idbi:idei,idbj:idej) & 225 & , zumask(idbi:idei,idbj:idej), zvmask(idbi:idei,idbj:idej) ) 226 227 ALLOCATE( zbdytmask(idbi:idei,idbj:idej), zbdyumask(idbi:idei,idbj:idej), zbdyvmask(idbi:idei,idbj:idej) ) 170 228 ! ----------------------------------------- 171 229 ! Check and write out namelist parameters … … 488 546 !------------------------------------------------------ 489 547 ! 490 iwe = mig(1)491 ies = mig(jpi)492 iso = mjg(1)493 ino = mjg(jpj)548 iwe = idbi + nimpp - 1 549 ies = idei + nimpp - 1 550 iso = idbj + njmpp - 1 551 ino = idej + njmpp - 1 494 552 ! 495 553 DO ib_bdy = 1, nb_bdy … … 551 609 ! 552 610 icount = icount + 1 553 idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy)- mig(1)+1 ! global to local indexes554 idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 ! global to local indexes611 idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy)- (1+nimpp-1)+1 ! global to local indexes 612 idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy)- (1+njmpp-1)+1 ! global to local indexes 555 613 idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy) 556 614 idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib … … 579 637 ! check if point has to be sent to a neighbour 580 638 ! W neighbour and on the inner left side 581 IF( ii == 2.and. (nbondi == 0 .or. nbondi == 1) ) lsend_bdy(ib_bdy,igrd,1,ir) = .true.639 IF( ii == idbi + 1 .and. (nbondi == 0 .or. nbondi == 1) ) lsend_bdy(ib_bdy,igrd,1,ir) = .true. 582 640 ! E neighbour and on the inner right side 583 IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) ) lsend_bdy(ib_bdy,igrd,2,ir) = .true.641 IF( ii == idei - 1 .and. (nbondi == 0 .or. nbondi == -1) ) lsend_bdy(ib_bdy,igrd,2,ir) = .true. 584 642 ! S neighbour and on the inner down side 585 IF( ij == 2.and. (nbondj == 0 .or. nbondj == 1) ) lsend_bdy(ib_bdy,igrd,3,ir) = .true.643 IF( ij == idbj + 1 .and. (nbondj == 0 .or. nbondj == 1) ) lsend_bdy(ib_bdy,igrd,3,ir) = .true. 586 644 ! N neighbour and on the inner up side 587 IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) ) lsend_bdy(ib_bdy,igrd,4,ir) = .true.645 IF( ij == idej - 1 .and. (nbondj == 0 .or. nbondj == -1) ) lsend_bdy(ib_bdy,igrd,4,ir) = .true. 588 646 ! 589 647 ! check if point has to be received from a neighbour 590 648 ! W neighbour and on the outter left side 591 IF( ii == 1.and. (nbondi == 0 .or. nbondi == 1) ) lrecv_bdy(ib_bdy,igrd,1,ir) = .true.649 IF( ii == idbi .and. (nbondi == 0 .or. nbondi == 1) ) lrecv_bdy(ib_bdy,igrd,1,ir) = .true. 592 650 ! E neighbour and on the outter right side 593 IF( ii == jpi.and. (nbondi == 0 .or. nbondi == -1) ) lrecv_bdy(ib_bdy,igrd,2,ir) = .true.651 IF( ii == idei .and. (nbondi == 0 .or. nbondi == -1) ) lrecv_bdy(ib_bdy,igrd,2,ir) = .true. 594 652 ! S neighbour and on the outter down side 595 IF( ij == 1.and. (nbondj == 0 .or. nbondj == 1) ) lrecv_bdy(ib_bdy,igrd,3,ir) = .true.653 IF( ij == idbj .and. (nbondj == 0 .or. nbondj == 1) ) lrecv_bdy(ib_bdy,igrd,3,ir) = .true. 596 654 ! N neighbour and on the outter up side 597 IF( ij == jpj.and. (nbondj == 0 .or. nbondj == -1) ) lrecv_bdy(ib_bdy,igrd,4,ir) = .true.655 IF( ij == idej .and. (nbondj == 0 .or. nbondj == -1) ) lrecv_bdy(ib_bdy,igrd,4,ir) = .true. 598 656 ! 599 657 END DO … … 633 691 ! ------------------------------------------ 634 692 635 ztmask(:,:) = tmask(:,:,1) ; zumask(:,:) = umask(:,:,1) ; zvmask(:,:) = vmask(:,:,1) 693 ztmask(1:jpi,1:jpj) = tmask(1:jpi,1:jpj,1) 694 zumask(1:jpi,1:jpj) = umask(1:jpi,1:jpj,1) 695 zvmask(1:jpi,1:jpj) = vmask(1:jpi,1:jpj,1) 636 696 ! For the flagu/flagv calculation below we require a version of fmask without 637 697 ! the land boundary condition (shlat) included: 638 DO ij = 1, jpjm1639 DO ii = 1, jpim1698 DO ij = 1, idej - 1 699 DO ii = 1, idei - 1 640 700 zfmask(ii,ij) = ztmask(ii,ij ) * ztmask(ii+1,ij ) & 641 701 & * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 642 702 END DO 643 703 END DO 644 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )704 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl ) 645 705 646 706 ! Read global 2D mask at T-points: bdytmask … … 648 708 ! bdytmask = 1 on the computational domain AND on open boundaries 649 709 ! = 0 elsewhere 650 651 bdytmask(:,:) = ssmask(:,:) 710 zbdytmask(1:jpi,1:jpj) = ssmask(1:jpi,1:jpj) 652 711 653 712 ! Derive mask on U and V grid from mask on T grid 654 DO ij = 1, jpjm1655 DO ii = 1, jpim1656 bdyumask(ii,ij) = bdytmask(ii,ij) *bdytmask(ii+1,ij )657 bdyvmask(ii,ij) = bdytmask(ii,ij) *bdytmask(ii ,ij+1)713 DO ij = 1, idej - 1 714 DO ii = 1, idei - 1 715 zbdyumask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii+1,ij ) 716 zbdyvmask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii ,ij+1) 658 717 END DO 659 718 END DO 660 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1., bdyvmask, 'V', 1.) ! Lateral boundary cond.719 CALL lbc_lnk_multi( 'bdyini', zbdytmask, 'T', 1., zbdyumask, 'U', 1., zbdyvmask, 'V', 1., khlcom = ihl ) ! Lateral boundary cond. 661 720 662 721 ! bdy masks are now set to zero on rim 0 points: 663 722 DO ib_bdy = 1, nb_bdy 664 723 DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(1) ! extent of rim 0 665 bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp724 zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 666 725 END DO 667 726 DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(2) ! extent of rim 0 668 bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp727 zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 669 728 END DO 670 729 DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(3) ! extent of rim 0 671 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp730 zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 672 731 END DO 673 732 END DO 674 675 CALL bdy_rim_treat( zumask, zvmask, zfmask, .true. ) ! compute flagu, flagv, ntreat on rim 0733 ! compute flagu, flagv, ntreat on rim 0 734 CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .true., idbi, idei, idbj, idej, ldxtd ) 676 735 677 736 ! ------------------------------------ … … 699 758 END DO 700 759 END DO 701 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )760 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl ) 702 761 703 762 ! bdy masks are now set to zero on rim1 points: 704 763 DO ib_bdy = 1, nb_bdy 705 764 DO ib = idx_bdy(ib_bdy)%nblenrim0(1) + 1, idx_bdy(ib_bdy)%nblenrim(1) ! extent of rim 1 706 bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp765 zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 707 766 END DO 708 767 DO ib = idx_bdy(ib_bdy)%nblenrim0(2) + 1, idx_bdy(ib_bdy)%nblenrim(2) ! extent of rim 1 709 bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp768 zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 710 769 END DO 711 770 DO ib = idx_bdy(ib_bdy)%nblenrim0(3) + 1, idx_bdy(ib_bdy)%nblenrim(3) ! extent of rim 1 712 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp771 zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 713 772 END DO 714 773 END DO 715 716 CALL bdy_rim_treat( zumask, zvmask, zfmask, .false. ) ! compute flagu, flagv, ntreat on rim 1774 ! compute flagu, flagv, ntreat on rim 1 775 CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .false., idbi, idei, idbj, idej, ldxtd ) 717 776 ! 718 777 ! Check which boundaries might need communication … … 743 802 ! <-- (o exterior) --> 744 803 ! (1) o|x OR (2) x|o 745 ! |___ ___| 746 IF( iibi == 0 .OR. ii1 == 0 .OR. ii2 == 0 .OR. ii3 == 0 ) lrecv_bdyint(ib_bdy,igrd,1,ir) = .true. 747 IF( iibi == jpi+1 .OR. ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 ) lrecv_bdyint(ib_bdy,igrd,2,ir) = .true. 748 IF( iibe == 0 ) lrecv_bdyext(ib_bdy,igrd,1,ir) = .true. 749 IF( iibe == jpi+1 ) lrecv_bdyext(ib_bdy,igrd,2,ir) = .true. 804 ! |___ ___| 805 iout1 = idbi-1 ; iout2 = idei+1 806 IF( iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1 ) lrecv_bdyint(ib_bdy,igrd,1,ir)=.true. 807 IF( iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2 ) lrecv_bdyint(ib_bdy,igrd,2,ir)=.true. 808 IF( iibe == iout1 ) lrecv_bdyext(ib_bdy,igrd,1,ir)=.true. 809 IF( iibe == iout2 ) lrecv_bdyext(ib_bdy,igrd,2,ir)=.true. 750 810 ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo 751 811 ! :¨¨¨¨¨|¨¨--> | | <--¨¨|¨¨¨¨¨: 752 812 ! : | x:o | neighbour limited by ... would need o | o:x | : 753 813 ! :.....|_._:_____| (1) W neighbour E neighbour (2) |_____:_._|.....: 754 IF( ii == 2 .AND. ( nbondi == 1 .OR. nbondi == 0 ) .AND. & 755 & ( iibi == 3 .OR. ii1 == 3 .OR. ii2 == 3 .OR. ii3 == 3 ) ) lsend_bdyint(ib_bdy,igrd,1,ir)=.true. 756 IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. & 757 & ( iibi == jpi-2 .OR. ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2) ) lsend_bdyint(ib_bdy,igrd,2,ir)=.true. 758 IF( ii == 2 .AND. ( nbondi == 1 .OR. nbondi == 0 ) .AND. iibe == 3 ) lsend_bdyext(ib_bdy,igrd,1,ir)=.true. 759 IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 ) lsend_bdyext(ib_bdy,igrd,2,ir)=.true. 814 iout1 = idbi+2*ihl ; iint1 = iout1-1 ; iout2 = idei-2*ihl ; iint2 = iout2+1 815 IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. & 816 & (iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1) ) lsend_bdyint(ib_bdy,igrd,1,ir)=.true. 817 IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. & 818 & (iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2) ) lsend_bdyint(ib_bdy,igrd,2,ir)=.true. 819 IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. iibe == iout1 ) lsend_bdyext(ib_bdy,igrd,1,ir)=.true. 820 IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. iibe == iout2 ) lsend_bdyext(ib_bdy,igrd,2,ir)=.true. 760 821 ! 761 822 ! search neighbour in the north/south direction … … 764 825 ! | |___x___| OR | | x | 765 826 ! v o (4) | | 766 IF( ijbi == 0 .OR. ij1 == 0 .OR. ij2 == 0 .OR. ij3 == 0 ) lrecv_bdyint(ib_bdy,igrd,3,ir) = .true. 767 IF( ijbi == jpj+1 .OR. ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 ) lrecv_bdyint(ib_bdy,igrd,4,ir) = .true. 768 IF( ijbe == 0 ) lrecv_bdyext(ib_bdy,igrd,3,ir) = .true. 769 IF( ijbe == jpj+1 ) lrecv_bdyext(ib_bdy,igrd,4,ir) = .true. 827 iout1 = idbj-1 ; iout2 = idej+1 828 IF( ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1 ) lrecv_bdyint(ib_bdy,igrd,3,ir)=.true. 829 IF( ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2 ) lrecv_bdyint(ib_bdy,igrd,4,ir)=.true. 830 IF( ijbe == iout1 ) lrecv_bdyext(ib_bdy,igrd,3,ir)=.true. 831 IF( ijbe == iout2 ) lrecv_bdyext(ib_bdy,igrd,4,ir)=.true. 770 832 ! Check if neighbour has its rim parallel to its mpi subdomain _________ border and next to its halo 771 833 ! ^ | o | : : 772 834 ! | |¨¨¨¨x¨¨¨¨| neighbour limited by ... would need o | |....x....| 773 835 ! :_________: (3) S neighbour N neighbour (4) v | o | 774 IF( ij == 2 .AND. ( nbondj == 1 .OR. nbondj == 0 ) .AND. & 775 & ( ijbi == 3 .OR. ij1 == 3 .OR. ij2 == 3 .OR. ij3 == 3 ) ) lsend_bdyint(ib_bdy,igrd,3,ir)=.true. 776 IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. & 777 & ( ijbi == jpj-2 .OR. ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2) ) lsend_bdyint(ib_bdy,igrd,4,ir)=.true. 778 IF( ij == 2 .AND. ( nbondj == 1 .OR. nbondj == 0 ) .AND. ijbe == 3 ) lsend_bdyext(ib_bdy,igrd,3,ir)=.true. 779 IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 ) lsend_bdyext(ib_bdy,igrd,4,ir)=.true. 836 iout1 = idbj+2*ihl ; iint1 = iout1-1 ; iout2 = idej-2*ihl ; iint2 = iout2+1 837 IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. & 838 & (ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1) ) lsend_bdyint(ib_bdy,igrd,3,ir)=.true. 839 IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. & 840 & (ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2) ) lsend_bdyint(ib_bdy,igrd,4,ir)=.true. 841 IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. ijbe == iout1 ) lsend_bdyext(ib_bdy,igrd,3,ir)=.true. 842 IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. ijbe == iout2 ) lsend_bdyext(ib_bdy,igrd,4,ir)=.true. 780 843 END DO 781 844 END DO … … 799 862 END DO 800 863 ! 801 DEALLOCATE( nbidta, nbjdta, nbrdta ) 864 ! initialize bdyXmask for global use 865 bdytmask(1:jpi,1:jpj) = zbdytmask(1:jpi,1:jpj) 866 bdyumask(1:jpi,1:jpj) = zbdyumask(1:jpi,1:jpj) 867 bdyvmask(1:jpi,1:jpj) = zbdyvmask(1:jpi,1:jpj) 868 ! 869 DEALLOCATE( nbidta, nbjdta, nbrdta, zfmask, ztmask, zumask, zvmask, zbdytmask, zbdyumask, zbdyvmask ) 802 870 ! 803 871 END SUBROUTINE bdy_def 804 872 805 873 806 SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, lrim0)874 SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, pbdytmask, pbdyumask, pbdyvmask, lrim0, idbi, idei, idbj, idej, ldxtd ) 807 875 !!---------------------------------------------------------------------- 808 876 !! *** ROUTINE bdy_rim_treat *** … … 821 889 !! - and look at the ocean neighbours to compute ntreat 822 890 !!---------------------------------------------------------------------- 823 REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in ) :: pfmask ! temporary fmask excluding coastal boundary condition (shlat) 824 REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in ) :: pumask, pvmask ! temporary t/u/v mask array 825 LOGICAL , INTENT (in ) :: lrim0 ! .true. -> rim 0 .false. -> rim 1 891 REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in ) :: pfmask ! temporary fmask excluding coastal boundary condition (shlat) 892 REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in ) :: pumask, pvmask ! temporary t/u/v mask array 893 REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in ) :: pbdytmask, pbdyumask, pbdyvmask 894 LOGICAL , INTENT(in ) :: lrim0 ! .true. -> rim 0 .false. -> rim 1 895 INTEGER , INTENT(in ) :: idbi, idbj, idei, idej ! start/end of the subdomain 896 ! for extended and regular bdy treatment 897 LOGICAL, OPTIONAL , INTENT(in ) :: ldxtd ! number of halos added to nn_hls for time splitting 898 ! 826 899 INTEGER :: ib_bdy, ii, ij, igrd, ib, icount ! dummy loop indices 827 INTEGER :: i_offset, j_offset, inn 900 INTEGER :: i_offset, j_offset, inn, ihl ! local integer 828 901 INTEGER :: ibeg, iend ! local integer 829 902 LOGICAL :: llnon, llson, llean, llwen ! local logicals indicating the presence of a ocean neighbour … … 831 904 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 832 905 CHARACTER(LEN=1), DIMENSION(jpbgrd) :: cgrid 833 REAL(wp) , DIMENSION( jpi,jpj) :: ztmp906 REAL(wp) , DIMENSION(idbi:idei,idbj:idej) :: ztmp 834 907 !!---------------------------------------------------------------------- 835 908 836 909 cgrid = (/'t','u','v'/) 910 ihl = nn_hls 911 IF( PRESENT(ldxtd) ) THEN ; IF( ldxtd ) ihl = nn_hls + nn_hlts ; ENDIF 837 912 838 913 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components … … 844 919 DO igrd = 1, jpbgrd 845 920 SELECT CASE( igrd ) 846 CASE( 1 ) ; zmask => pumask ; i_offset = 0847 CASE( 2 ) ; zmask => bdytmask ; i_offset = 1848 CASE( 3 ) ; zmask => pfmask ; i_offset = 0921 CASE( 1 ) ; zmask => pumask ; i_offset = 0 922 CASE( 2 ) ; zmask => pbdytmask ; i_offset = 1 923 CASE( 3 ) ; zmask => pfmask ; i_offset = 0 849 924 END SELECT 850 925 icount = 0 … … 858 933 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 859 934 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 860 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE935 IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej ) CYCLE 861 936 zwfl = zmask(ii+i_offset-1,ij) 862 937 zefl = zmask(ii+i_offset ,ij) … … 873 948 ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 874 949 CALL ctl_stop( ctmp1 ) 875 ENDIF 950 ENDIF 876 951 SELECT CASE( igrd ) 877 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )878 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )879 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )880 END SELECT 952 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 953 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 954 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 955 END SELECT 881 956 DO ib = ibeg, iend 882 957 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 892 967 DO igrd = 1, jpbgrd 893 968 SELECT CASE( igrd ) 894 CASE( 1 ) ; zmask => pvmask ; j_offset = 0895 CASE( 2 ) ; zmask => pfmask ; j_offset = 0896 CASE( 3 ) ; zmask => bdytmask ; j_offset = 1969 CASE( 1 ) ; zmask => pvmask ; j_offset = 0 970 CASE( 2 ) ; zmask => pfmask ; j_offset = 0 971 CASE( 3 ) ; zmask => pbdytmask ; j_offset = 1 897 972 END SELECT 898 973 icount = 0 … … 906 981 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 907 982 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 908 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE983 IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej ) CYCLE 909 984 zsfl = zmask(ii,ij+j_offset-1) 910 985 znfl = zmask(ii,ij+j_offset ) … … 923 998 ENDIF 924 999 SELECT CASE( igrd ) 925 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )926 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )927 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )928 END SELECT 1000 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 1001 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 1002 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 1003 END SELECT 929 1004 DO ib = ibeg, iend 930 1005 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 939 1014 DO igrd = 1, jpbgrd 940 1015 SELECT CASE( igrd ) 941 CASE( 1 ) ; zmask => bdytmask942 CASE( 2 ) ; zmask => bdyumask943 CASE( 3 ) ; zmask => bdyvmask1016 CASE( 1 ) ; zmask => pbdytmask 1017 CASE( 2 ) ; zmask => pbdyumask 1018 CASE( 3 ) ; zmask => pbdyvmask 944 1019 END SELECT 945 1020 ztmp(:,:) = -999._wp … … 952 1027 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 953 1028 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 954 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )CYCLE1029 IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej ) CYCLE 955 1030 llnon = zmask(ii ,ij+1) == 1. 956 1031 llson = zmask(ii ,ij-1) == 1. … … 1011 1086 END DO 1012 1087 SELECT CASE( igrd ) 1013 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )1014 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )1015 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )1016 END SELECT 1088 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 1089 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 1090 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 1091 END SELECT 1017 1092 DO ib = ibeg, iend 1018 1093 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 1040 1115 INTEGER, INTENT( out) :: ii1, ij1, ii2, ij2, ii3, ij3 1041 1116 !!---------------------------------------------------------------------- 1042 SELECT CASE( itreat ) ! points that will be used by bdy routines, - 1will be discarded1117 SELECT CASE( itreat ) ! points that will be used by bdy routines, -99 will be discarded 1043 1118 ! ! ! _____ ! _____ 1044 1119 ! 1 | o ! 2 o | ! 3 | x ! 4 x | 1045 1120 ! |_x_ _ ! _ _x_| ! | o ! o | 1046 CASE( 1 ) ; ii1 = ii+1 ; ij1 = ij+1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11047 CASE( 2 ) ; ii1 = ii-1 ; ij1 = ij+1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11048 CASE( 3 ) ; ii1 = ii+1 ; ij1 = ij-1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11049 CASE( 4 ) ; ii1 = ii-1 ; ij1 = ij-1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11121 CASE( 1 ) ; ii1 = ii+1 ; ij1 = ij+1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1122 CASE( 2 ) ; ii1 = ii-1 ; ij1 = ij+1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1123 CASE( 3 ) ; ii1 = ii+1 ; ij1 = ij-1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1124 CASE( 4 ) ; ii1 = ii-1 ; ij1 = ij-1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1050 1125 ! | ! | ! o ! ______ ! or incomplete corner 1051 1126 ! 5 | x o ! 6 o x | ! 7 __x__ ! 8 x ! 7 ____ o 1052 1127 ! | ! | ! ! o ! |x___ 1053 CASE( 5 ) ; ii1 = ii+1 ; ij1 = ij ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11054 CASE( 6 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11055 CASE( 7 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11056 CASE( 8 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = - 1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -11128 CASE( 5 ) ; ii1 = ii+1 ; ij1 = ij ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1129 CASE( 6 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1130 CASE( 7 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1131 CASE( 8 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = -99 ; ij2 = -99 ; ii3 = -99 ; ij3 = -99 1057 1132 ! o ! o ! _____| ! |_____ 1058 1133 ! 9 ____x o ! 10 o x___ ! 11 x o ! 12 o x 1059 1134 ! | ! | ! o ! o 1060 CASE( 9 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = - 1 ; ij3 = -11061 CASE( 10 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = - 1 ; ij3 = -11062 CASE( 11 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = - 1 ; ij3 = -11063 CASE( 12 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = - 1 ; ij3 = -11135 CASE( 9 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = -99 ; ij3 = -99 1136 CASE( 10 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = -99 ; ij3 = -99 1137 CASE( 11 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = -99 ; ij3 = -99 1138 CASE( 12 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = -99 ; ij3 = -99 1064 1139 ! |_ o ! o _| ! ¨¨|_|¨¨ ! o 1065 1140 ! 13 _| x o ! 14 o x |_ ! 15 o x o ! 16 o x o 1066 1141 ! | o ! o | ! o ! __|¨|__ 1067 CASE( 13 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1068 CASE( 14 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1142 CASE( 13 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1143 CASE( 14 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1069 1144 CASE( 15 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij-1 ; ii3 = ii+1 ; ij3 = ij 1070 1145 CASE( 16 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij+1 ; ii3 = ii+1 ; ij3 = ij
Note: See TracChangeset
for help on using the changeset viewer.
