- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4699 r6225 12 12 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 13 13 !! 3.4 ! 2012 (J. Chanut) straight open boundary case update 14 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Updates for the 15 !! optimization of BDY communications 14 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) optimization of BDY communications 16 15 !!---------------------------------------------------------------------- 17 16 #if defined key_bdy … … 19 18 !! 'key_bdy' Unstructured Open Boundary Conditions 20 19 !!---------------------------------------------------------------------- 21 !! bdy_init 20 !! bdy_init : Initialization of unstructured open boundaries 22 21 !!---------------------------------------------------------------------- 23 USE wrk_nemo ! Memory Allocation 24 USE timing ! Timing 25 USE oce ! ocean dynamics and tracers variables 26 USE dom_oce ! ocean space and time domain 27 USE bdy_oce ! unstructured open boundary conditions 28 USE in_out_manager ! I/O units 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! for mpp_sum 31 USE iom ! I/O 32 USE sbctide, ONLY: lk_tide ! Tidal forcing or not 33 USE phycst, ONLY: rday 22 USE oce ! ocean dynamics and tracers variables 23 USE dom_oce ! ocean space and time domain 24 USE bdy_oce ! unstructured open boundary conditions 25 USE sbctide , ONLY: lk_tide ! Tidal forcing or not 26 USE phycst , ONLY: rday 27 ! 28 USE in_out_manager ! I/O units 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! for mpp_sum 31 USE iom ! I/O 32 USE wrk_nemo ! Memory Allocation 33 USE timing ! Timing 34 34 35 35 IMPLICIT NONE … … 38 38 PUBLIC bdy_init ! routine called in nemo_init 39 39 40 INTEGER, PARAMETER :: jp_nseg = 10041 INTEGER, PARAMETER :: nrimmax = 20! maximum rimwidth in structured40 INTEGER, PARAMETER :: jp_nseg = 100 ! 41 INTEGER, PARAMETER :: nrimmax = 20 ! maximum rimwidth in structured 42 42 ! open boundary data files 43 43 ! Straight open boundary segment parameters: 44 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs45 INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge46 INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw47 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn48 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs44 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs 45 INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge ! 46 INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw ! 47 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn ! 48 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs ! 49 49 !!---------------------------------------------------------------------- 50 !! NEMO/OPA 4.0 , NEMO Consortium (2011)50 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 51 51 !! $Id$ 52 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 66 66 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 67 67 !!---------------------------------------------------------------------- 68 ! namelist variables69 !-------------------70 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile71 CHARACTER(LEN=1) :: ctypebdy72 INTEGER :: nbdyind, nbdybeg, nbdyend73 68 74 69 ! local variables … … 76 71 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 77 72 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 78 INTEGER :: iw , ie, is, in, inum, id_dummy! - -73 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 79 74 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 80 75 INTEGER :: jpbdtau, jpbdtas ! - - 81 76 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 82 77 INTEGER :: i_offset, j_offset ! - - 83 INTEGER , POINTER :: nbi, nbj, nbr! short cuts78 INTEGER , POINTER :: nbi, nbj, nbr ! short cuts 84 79 REAL(wp), POINTER :: flagu, flagv ! - - 85 80 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! pointer to 2D mask fields … … 94 89 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 95 90 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 96 91 !! 92 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile ! Namelist variables 93 CHARACTER(LEN=1) :: ctypebdy ! - - 94 INTEGER :: nbdyind, nbdybeg, nbdyend 97 95 !! 98 96 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, & … … 103 101 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 104 102 & ln_vol, nn_volctl, nn_rimwidth 105 !!103 ! 106 104 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 107 105 INTEGER :: ios ! Local integer output status for namelist read 108 106 !!---------------------------------------------------------------------- 109 110 IF( nn_timing == 1 ) CALL timing_start('bdy_init')111 107 ! 108 IF( nn_timing == 1 ) CALL timing_start('bdy_init') 109 ! 112 110 IF(lwp) WRITE(numout,*) 113 111 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 114 112 IF(lwp) WRITE(numout,*) '~~~~~~~~' 115 113 ! 116 117 114 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 118 115 & ' and general open boundary condition are not compatible' ) 119 116 120 cgrid = (/'t','u','v'/)117 cgrid = (/'t','u','v'/) 121 118 122 119 ! ------------------------ 123 120 ! Read namelist parameters 124 121 ! ------------------------ 125 126 122 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries 127 123 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 128 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )129 124 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 125 ! 130 126 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries 131 127 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 132 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )128 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 133 129 IF(lwm) WRITE ( numond, nambdy ) 134 130 … … 137 133 ! ----------------------------------------- 138 134 ! ! control prints 139 IF(lwp) WRITE(numout,*) ' 140 141 IF( nb_bdy .eq.0 ) THEN135 IF(lwp) WRITE(numout,*) ' nambdy' 136 137 IF( nb_bdy == 0 ) THEN 142 138 IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 143 139 ELSE 144 IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy140 IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 145 141 ENDIF 146 142 … … 158 154 IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution: ' 159 155 SELECT CASE( cn_dyn2d(ib_bdy) ) 160 CASE( 'none')156 CASE( 'none' ) 161 157 IF(lwp) WRITE(numout,*) ' no open boundary condition' 162 158 dta_bdy(ib_bdy)%ll_ssh = .false. 163 159 dta_bdy(ib_bdy)%ll_u2d = .false. 164 160 dta_bdy(ib_bdy)%ll_v2d = .false. 165 CASE( 'frs')161 CASE( 'frs' ) 166 162 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 167 163 dta_bdy(ib_bdy)%ll_ssh = .false. 168 164 dta_bdy(ib_bdy)%ll_u2d = .true. 169 165 dta_bdy(ib_bdy)%ll_v2d = .true. 170 CASE( 'flather')166 CASE( 'flather' ) 171 167 IF(lwp) WRITE(numout,*) ' Flather radiation condition' 172 168 dta_bdy(ib_bdy)%ll_ssh = .true. 173 169 dta_bdy(ib_bdy)%ll_u2d = .true. 174 170 dta_bdy(ib_bdy)%ll_v2d = .true. 175 CASE( 'orlanski')171 CASE( 'orlanski' ) 176 172 IF(lwp) WRITE(numout,*) ' Orlanski (fully oblique) radiation condition with adaptive nudging' 177 173 dta_bdy(ib_bdy)%ll_ssh = .false. 178 174 dta_bdy(ib_bdy)%ll_u2d = .true. 179 175 dta_bdy(ib_bdy)%ll_v2d = .true. 180 CASE( 'orlanski_npo')176 CASE( 'orlanski_npo' ) 181 177 IF(lwp) WRITE(numout,*) ' Orlanski (NPO) radiation condition with adaptive nudging' 182 178 dta_bdy(ib_bdy)%ll_ssh = .false. … … 392 388 REWIND( numnam_cfg ) 393 389 394 !!----------------------------------------------------------------------395 396 397 398 390 nblendta(:,:) = 0 399 391 nbdysege = 0 … … 492 484 nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 493 485 jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 494 END DO486 END DO 495 487 CALL iom_close( inum ) 496 488 ! 497 489 ENDIF 498 499 END DO ! ib_bdy490 ! 491 END DO ! ib_bdy 500 492 501 493 IF (nb_bdy>0) THEN … … 514 506 ! Now look for crossings in user (namelist) defined open boundary segments: 515 507 !-------------------------------------------------------------------------- 516 IF ( icount>0 )CALL bdy_ctl_seg508 IF( icount>0 ) CALL bdy_ctl_seg 517 509 518 510 ! Calculate global boundary index arrays or read in from file … … 520 512 ! 1. Read global index arrays from boundary coordinates file. 521 513 DO ib_bdy = 1, nb_bdy 522 514 ! 523 515 IF( ln_coords_file(ib_bdy) ) THEN 524 516 ! 525 517 CALL iom_open( cn_coords_file(ib_bdy), inum ) 526 518 DO igrd = 1, jpbgrd … … 537 529 nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 538 530 END DO 539 531 ! 540 532 ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 541 533 IF(lwp) WRITE(numout,*) … … 546 538 END DO 547 539 CALL iom_close( inum ) 548 540 ! 549 541 ENDIF 550 551 END DO542 ! 543 END DO 552 544 553 545 ! 2. Now fill indices corresponding to straight open boundary arrays: … … 777 769 ! is = mjg(1) + 1 ! if monotasking and no zoom, is=2 778 770 ! in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 779 iw = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2780 ie = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1781 is = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2782 in = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1771 iwe = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2 772 ies = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1 773 iso = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2 774 ino = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1 783 775 784 776 ALLOCATE( nbondi_bdy(nb_bdy)) … … 792 784 793 785 ! Work out dimensions of boundary data on each neighbour process 794 IF(nbondi .eq.0) THEN786 IF(nbondi == 0) THEN 795 787 iw_b(1) = jpizoom + nimppt(nowe+1) 796 788 ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 … … 802 794 is_b(2) = jpjzoom + njmppt(noea+1) 803 795 in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 804 ELSEIF(nbondi .eq.1) THEN796 ELSEIF(nbondi == 1) THEN 805 797 iw_b(1) = jpizoom + nimppt(nowe+1) 806 798 ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 807 799 is_b(1) = jpjzoom + njmppt(nowe+1) 808 800 in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 809 ELSEIF(nbondi .eq.-1) THEN801 ELSEIF(nbondi == -1) THEN 810 802 iw_b(2) = jpizoom + nimppt(noea+1) 811 803 ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 … … 814 806 ENDIF 815 807 816 IF(nbondj .eq.0) THEN808 IF(nbondj == 0) THEN 817 809 iw_b(3) = jpizoom + nimppt(noso+1) 818 810 ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 … … 824 816 is_b(4) = jpjzoom + njmppt(nono+1) 825 817 in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 826 ELSEIF(nbondj .eq.1) THEN818 ELSEIF(nbondj == 1) THEN 827 819 iw_b(3) = jpizoom + nimppt(noso+1) 828 820 ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 829 821 is_b(3) = jpjzoom + njmppt(noso+1) 830 822 in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 831 ELSEIF(nbondj .eq.-1) THEN823 ELSEIF(nbondj == -1) THEN 832 824 iw_b(4) = jpizoom + nimppt(nono+1) 833 825 ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 … … 853 845 ENDIF 854 846 ! check if point is in local domain 855 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &856 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in) THEN847 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 848 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino ) THEN 857 849 ! 858 850 icount = icount + 1 … … 867 859 ! Allocate index arrays for this boundary set 868 860 !-------------------------------------------- 869 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:))870 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) )871 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) )872 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) )873 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) )861 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 862 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) ) 863 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) ) 864 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) ) 865 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) ) 874 866 ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 875 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )876 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) )877 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )878 ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )867 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ) 868 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) ) 869 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ) 870 ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 879 871 880 872 ! Dispatch mapping indices and discrete distances on each processor 881 873 ! ----------------------------------------------------------------- 882 874 883 com_east = 0884 com_west = 0875 com_east = 0 876 com_west = 0 885 877 com_south = 0 886 878 com_north = 0 887 879 888 com_east_b = 0889 com_west_b = 0880 com_east_b = 0 881 com_west_b = 0 890 882 com_south_b = 0 891 883 com_north_b = 0 884 892 885 DO igrd = 1, jpbgrd 893 886 icount = 0 … … 896 889 DO ib = 1, nblendta(igrd,ib_bdy) 897 890 ! check if point is in local domain and equals ir 898 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &899 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in.AND. &891 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 892 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND. & 900 893 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 901 894 ! … … 911 904 ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 912 905 ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 913 if((com_east .ne. 1) .and. (ii .eq.(nlci-1)) .and. (nbondi .le. 0)) then906 if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then 914 907 com_east = 1 915 elseif((com_west .ne. 1) .and. (ii .eq.2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then908 elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 916 909 com_west = 1 917 910 endif 918 if((com_south .ne. 1) .and. (ij .eq.2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then911 if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 919 912 com_south = 1 920 elseif((com_north .ne. 1) .and. (ij .eq.(nlcj-1)) .and. (nbondj .le. 0)) then913 elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then 921 914 com_north = 1 922 915 endif … … 925 918 ENDIF 926 919 ! check if point has to be received from a neighbour 927 IF(nbondi .eq.0) THEN920 IF(nbondi == 0) THEN 928 921 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND. & 929 922 & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND. & 930 923 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 931 924 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 932 if((com_west_b .ne. 1) .and. (ii .eq.(nlcit(nowe+1)-1))) then925 if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 933 926 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 934 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then927 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 935 928 com_south = 1 936 elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then929 elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 937 930 com_north = 1 938 931 endif … … 944 937 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 945 938 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 946 if((com_east_b .ne. 1) .and. (ii .eq.2)) then939 if((com_east_b .ne. 1) .and. (ii == 2)) then 947 940 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 948 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then941 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 949 942 com_south = 1 950 elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then943 elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 951 944 com_north = 1 952 945 endif … … 954 947 endif 955 948 ENDIF 956 ELSEIF(nbondi .eq.1) THEN949 ELSEIF(nbondi == 1) THEN 957 950 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND. & 958 951 & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND. & 959 952 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 960 953 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 961 if((com_west_b .ne. 1) .and. (ii .eq.(nlcit(nowe+1)-1))) then954 if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 962 955 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 963 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then956 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 964 957 com_south = 1 965 elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then958 elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 966 959 com_north = 1 967 960 endif … … 969 962 endif 970 963 ENDIF 971 ELSEIF(nbondi .eq.-1) THEN964 ELSEIF(nbondi == -1) THEN 972 965 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND. & 973 966 & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND. & 974 967 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 975 968 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 976 if((com_east_b .ne. 1) .and. (ii .eq.2)) then969 if((com_east_b .ne. 1) .and. (ii == 2)) then 977 970 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 978 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then971 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 979 972 com_south = 1 980 elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then973 elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 981 974 com_north = 1 982 975 endif … … 985 978 ENDIF 986 979 ENDIF 987 IF(nbondj .eq.0) THEN980 IF(nbondj == 0) THEN 988 981 IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 & 989 982 & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & … … 1000 993 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1001 994 ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 1002 if((com_south_b .ne. 1) .and. (ij .eq.(nlcjt(noso+1)-1))) then995 if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 1003 996 com_south_b = 1 1004 997 endif … … 1008 1001 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1009 1002 ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 1010 if((com_north_b .ne. 1) .and. (ij .eq.2)) then1003 if((com_north_b .ne. 1) .and. (ij == 2)) then 1011 1004 com_north_b = 1 1012 1005 endif 1013 1006 ENDIF 1014 ELSEIF(nbondj .eq.1) THEN1007 ELSEIF(nbondj == 1) THEN 1015 1008 IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. & 1016 1009 & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & … … 1022 1015 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1023 1016 ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 1024 if((com_south_b .ne. 1) .and. (ij .eq.(nlcjt(noso+1)-1))) then1017 if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 1025 1018 com_south_b = 1 1026 1019 endif 1027 1020 ENDIF 1028 ELSEIF(nbondj .eq.-1) THEN1021 ELSEIF(nbondj == -1) THEN 1029 1022 IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 & 1030 1023 & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & … … 1036 1029 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1037 1030 ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 1038 if((com_north_b .ne. 1) .and. (ij .eq.2)) then1031 if((com_north_b .ne. 1) .and. (ij == 2)) then 1039 1032 com_north_b = 1 1040 1033 endif … … 1045 1038 ENDDO 1046 1039 1047 ! definition of the i- and j- direction local boundaries arrays 1048 ! used for sending the boudaries 1049 IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN 1050 nbondi_bdy(ib_bdy) = 0 1051 ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN 1052 nbondi_bdy(ib_bdy) = -1 1053 ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN 1054 nbondi_bdy(ib_bdy) = 1 1040 ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries 1041 IF( (com_east == 1) .and. (com_west == 1) ) THEN ; nbondi_bdy(ib_bdy) = 0 1042 ELSEIF( (com_east == 1) .and. (com_west == 0) ) THEN ; nbondi_bdy(ib_bdy) = -1 1043 ELSEIF( (com_east == 0) .and. (com_west == 1) ) THEN ; nbondi_bdy(ib_bdy) = 1 1055 1044 ENDIF 1056 1057 IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN 1058 nbondj_bdy(ib_bdy) = 0 1059 ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN 1060 nbondj_bdy(ib_bdy) = -1 1061 ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN 1062 nbondj_bdy(ib_bdy) = 1 1045 IF( (com_north == 1) .and. (com_south == 1) ) THEN ; nbondj_bdy(ib_bdy) = 0 1046 ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN ; nbondj_bdy(ib_bdy) = -1 1047 ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN ; nbondj_bdy(ib_bdy) = 1 1063 1048 ENDIF 1064 1049 1065 ! definition of the i- and j- direction local boundaries arrays 1066 ! used for receiving the boudaries 1067 IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN 1068 nbondi_bdy_b(ib_bdy) = 0 1069 ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN 1070 nbondi_bdy_b(ib_bdy) = -1 1071 ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN 1072 nbondi_bdy_b(ib_bdy) = 1 1050 ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries 1051 IF( (com_east_b == 1) .and. (com_west_b == 1) ) THEN ; nbondi_bdy_b(ib_bdy) = 0 1052 ELSEIF( (com_east_b == 1) .and. (com_west_b == 0) ) THEN ; nbondi_bdy_b(ib_bdy) = -1 1053 ELSEIF( (com_east_b == 0) .and. (com_west_b == 1) ) THEN ; nbondi_bdy_b(ib_bdy) = 1 1073 1054 ENDIF 1074 1075 IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN 1076 nbondj_bdy_b(ib_bdy) = 0 1077 ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN 1078 nbondj_bdy_b(ib_bdy) = -1 1079 ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN 1080 nbondj_bdy_b(ib_bdy) = 1 1055 IF( (com_north_b == 1) .and. (com_south_b == 1) ) THEN ; nbondj_bdy_b(ib_bdy) = 0 1056 ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN ; nbondj_bdy_b(ib_bdy) = -1 1057 ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN ; nbondj_bdy_b(ib_bdy) = 1 1081 1058 ENDIF 1082 1059 … … 1086 1063 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 1087 1064 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1088 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ! tanh formulation1089 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = ( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1090 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)) ! linear1065 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 ) ! tanh formulation 1066 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1067 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)) ! linear 1091 1068 END DO 1092 1069 END DO … … 1098 1075 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1099 1076 idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 1100 & *( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1077 & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1101 1078 idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 1102 & *( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1079 & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1103 1080 END DO 1104 1081 END DO … … 1121 1098 1122 1099 ! Derive mask on U and V grid from mask on T grid 1123 bdyumask(:,:) = 0. e01124 bdyvmask(:,:) = 0. e01100 bdyumask(:,:) = 0._wp 1101 bdyvmask(:,:) = 0._wp 1125 1102 DO ij=1, jpjm1 1126 1103 DO ii=1, jpim1 1127 bdyumask(ii,ij) =bdytmask(ii,ij)*bdytmask(ii+1, ij )1128 bdyvmask(ii,ij) =bdytmask(ii,ij)*bdytmask(ii ,ij+1)1104 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1105 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1129 1106 END DO 1130 1107 END DO … … 1140 1117 umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij) 1141 1118 vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij) 1142 bmask(ii,ij) = bmask(ii,ij) * bdytmask(ii,ij)1143 1119 END DO 1144 1120 END DO 1145 END DO1146 1147 DO ik = 1, jpkm11148 1121 DO ij = 2, jpjm1 1149 1122 DO ii = 2, jpim1 … … 1153 1126 END DO 1154 1127 END DO 1155 1156 tmask_i (:,:) = tmask(:,:,1) * tmask_i(:,:) 1157 1128 tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:) 1129 ! 1158 1130 ENDIF ! ln_mask_file=.TRUE. 1159 1131 1160 bdytmask(:,:) = tmask(:,:,1) 1161 IF( .not. ln_mask_file ) THEN 1162 ! If .not. ln_mask_file then we need to derive mask on U and V grid 1163 ! from mask on T grid here. 1164 bdyumask(:,:) = 0.e0 1165 bdyvmask(:,:) = 0.e0 1166 DO ij=1, jpjm1 1167 DO ii=1, jpim1 1168 bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 1169 bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii ,ij+1) 1132 bdytmask(:,:) = ssmask(:,:) 1133 IF( .NOT.ln_mask_file ) THEN 1134 ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 1135 bdyumask(:,:) = 0._wp 1136 bdyvmask(:,:) = 0._wp 1137 DO ij = 1, jpjm1 1138 DO ii = 1, jpim1 1139 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1140 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1170 1141 END DO 1171 1142 END DO … … 1173 1144 ENDIF 1174 1145 1175 ! bdy masks and bmask are now set to zero on boundary points: 1176 igrd = 1 ! In the free surface case, bmask is at T-points 1177 DO ib_bdy = 1, nb_bdy 1178 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1179 bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 1180 ENDDO 1181 ENDDO 1146 ! bdy masks are now set to zero on boundary points: 1182 1147 ! 1183 1148 igrd = 1 1184 1149 DO ib_bdy = 1, nb_bdy 1185 1150 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1186 bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01187 END DO1188 END DO1151 bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1152 END DO 1153 END DO 1189 1154 ! 1190 1155 igrd = 2 1191 1156 DO ib_bdy = 1, nb_bdy 1192 1157 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1193 bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01194 END DO1195 END DO1158 bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1159 END DO 1160 END DO 1196 1161 ! 1197 1162 igrd = 3 1198 1163 DO ib_bdy = 1, nb_bdy 1199 1164 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1200 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01165 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1201 1166 ENDDO 1202 1167 ENDDO … … 1204 1169 ! For the flagu/flagv calculation below we require a version of fmask without 1205 1170 ! the land boundary condition (shlat) included: 1206 CALL wrk_alloc(jpi,jpj, zfmask)1171 CALL wrk_alloc(jpi,jpj, zfmask ) 1207 1172 DO ij = 2, jpjm1 1208 1173 DO ii = 2, jpim1 … … 1219 1184 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1220 1185 1221 idx_bdy(ib_bdy)%flagu(:,:) = 0. e01222 idx_bdy(ib_bdy)%flagv(:,:) = 0. e01186 idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 1187 idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 1223 1188 icount = 0 1224 1189 … … 1230 1195 DO igrd = 1,jpbgrd 1231 1196 SELECT CASE( igrd ) 1232 CASE( 1 ) 1233 pmask => umask(:,:,1) 1234 i_offset = 0 1235 CASE( 2 ) 1236 pmask => bdytmask 1237 i_offset = 1 1238 CASE( 3 ) 1239 pmask => zfmask(:,:) 1240 i_offset = 0 1197 CASE( 1 ) ; pmask => umask (:,:,1) ; i_offset = 0 1198 CASE( 2 ) ; pmask => bdytmask(:,:) ; i_offset = 1 1199 CASE( 3 ) ; pmask => zfmask (:,:) ; i_offset = 0 1241 1200 END SELECT 1242 1201 icount = 0 … … 1269 1228 ! flagv = 1 : v is normal to the boundary and is direction is inward 1270 1229 1271 DO igrd = 1, jpbgrd1230 DO igrd = 1, jpbgrd 1272 1231 SELECT CASE( igrd ) 1273 CASE( 1 ) 1274 pmask => vmask(:,:,1) 1275 j_offset = 0 1276 CASE( 2 ) 1277 pmask => zfmask(:,:) 1278 j_offset = 0 1279 CASE( 3 ) 1280 pmask => bdytmask 1281 j_offset = 1 1232 CASE( 1 ) ; pmask => vmask (:,:,1) ; j_offset = 0 1233 CASE( 2 ) ; pmask => zfmask(:,:) ; j_offset = 0 1234 CASE( 3 ) ; pmask => bdytmask ; j_offset = 1 1282 1235 END SELECT 1283 1236 icount = 0 … … 1285 1238 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1286 1239 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1287 znfl = pmask(nbi,nbj+j_offset-1 1288 zsfl = pmask(nbi,nbj+j_offset )1240 znfl = pmask(nbi,nbj+j_offset-1) 1241 zsfl = pmask(nbi,nbj+j_offset ) 1289 1242 ! This error check only works if you are using the bdyXmask arrays 1290 1243 IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN … … 1304 1257 ENDIF 1305 1258 END DO 1306 1259 ! 1307 1260 END DO 1308 1261 1309 1262 ! Compute total lateral surface for volume correction: 1310 1263 ! ---------------------------------------------------- 1311 ! JC: this must be done at each time step with key_vvl1312 bdysurftot = 0. e01264 ! JC: this must be done at each time step with non-linear free surface 1265 bdysurftot = 0._wp 1313 1266 IF( ln_vol ) THEN 1314 1267 igrd = 2 ! Lateral surface at U-points … … 1318 1271 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1319 1272 flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 1320 bdysurftot = bdysurftot + hu 1273 bdysurftot = bdysurftot + hu_n (nbi , nbj) & 1321 1274 & * e2u (nbi , nbj) * ABS( flagu ) & 1322 1275 & * tmask_i(nbi , nbj) & 1323 1276 & * tmask_i(nbi+1, nbj) 1324 END DO1325 END DO1277 END DO 1278 END DO 1326 1279 1327 1280 igrd=3 ! Add lateral surface at V-points … … 1331 1284 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1332 1285 flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 1333 bdysurftot = bdysurftot + hv 1286 bdysurftot = bdysurftot + hv_n (nbi, nbj ) & 1334 1287 & * e1v (nbi, nbj ) * ABS( flagv ) & 1335 1288 & * tmask_i(nbi, nbj ) & 1336 1289 & * tmask_i(nbi, nbj+1) 1337 END DO1338 END DO1290 END DO 1291 END DO 1339 1292 ! 1340 1293 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain … … 1343 1296 ! Tidy up 1344 1297 !-------- 1345 IF (nb_bdy>0) THEN 1346 DEALLOCATE(nbidta, nbjdta, nbrdta) 1347 ENDIF 1348 1349 CALL wrk_dealloc(jpi,jpj,zfmask) 1350 1351 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 1352 1298 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1299 ! 1300 CALL wrk_dealloc(jpi,jpj, zfmask ) 1301 ! 1302 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 1303 ! 1353 1304 END SUBROUTINE bdy_init 1305 1354 1306 1355 1307 SUBROUTINE bdy_ctl_seg … … 1594 1546 ELSE 1595 1547 ! This is a corner 1596 WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)1548 IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 1597 1549 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 1598 1550 itest=itest+1 … … 1608 1560 ELSE 1609 1561 ! This is a corner 1610 WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)1562 IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 1611 1563 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 1612 1564 itest=itest+1 … … 1638 1590 ELSE 1639 1591 ! This is a corner 1640 WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)1592 IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 1641 1593 CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 1642 1594 itest=itest+1 … … 1652 1604 ELSE 1653 1605 ! This is a corner 1654 WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)1606 IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 1655 1607 CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 1656 1608 itest=itest+1 … … 1742 1694 itest = 0 1743 1695 1744 IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2))itest = itest + 11745 IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2))itest = itest + 11746 IF (cn_tra(ib1)/=cn_tra(ib2))itest = itest + 11747 ! 1748 IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2))itest = itest + 11749 IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2))itest = itest + 11750 IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2))itest = itest + 11751 ! 1752 IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2))itest = itest + 11753 ! 1754 IF 1696 IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) ) itest = itest + 1 1697 IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) ) itest = itest + 1 1698 IF( cn_tra (ib1) /= cn_tra (ib2) ) itest = itest + 1 1699 ! 1700 IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) ) itest = itest + 1 1701 IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) ) itest = itest + 1 1702 IF( nn_tra_dta (ib1) /= nn_tra_dta (ib2) ) itest = itest + 1 1703 ! 1704 IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) ) itest = itest + 1 1705 ! 1706 IF( itest>0 ) THEN 1755 1707 IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1756 1708 IF(lwp) WRITE(numout,*) ' ========== have different open bdy schemes'
Note: See TracChangeset
for help on using the changeset viewer.