Changeset 11071 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90
- Timestamp:
- 2019-06-04T14:58:06+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90
r11067 r11071 132 132 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 133 133 INTEGER :: i_offset, j_offset, inbdy, itreat ! - - 134 INTEGER :: ii1, ii2, ii3, ij1, ij2, ij3, iibe, ijbe ! - - 135 INTEGER :: flagu, flagv ! short cuts 134 136 INTEGER , POINTER :: nbi, nbj, nbr ! short cuts 135 137 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! pointer to 2D mask fields … … 145 147 REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 146 148 REAL(wp) , DIMENSION(jpi,jpj) :: ztmp 147 REAL(wp), POINTER :: flagu, flagv ! short cuts148 149 LOGICAL :: llnobdy, llsobdy, lleabdy, llwebdy ! local logicals 149 150 !! … … 867 868 ! Initialize array indicating communications in bdy 868 869 ! ------------------------------------------------- 869 870 ! Allocate array indicating if a send instruction is needed in bdy treatment 871 ALLOCATE( nbondi_bdy(nb_bdy) ) 872 ALLOCATE( nbondj_bdy(nb_bdy) ) 873 nbondi_bdy(:)=2 874 nbondj_bdy(:)=2 875 ! Allocate array indicating if a receive instruction is needed in bdy treatment 876 ALLOCATE( nbondi_bdy_b(nb_bdy)) 877 ALLOCATE( nbondj_bdy_b(nb_bdy)) 878 nbondi_bdy_b(:)=2 879 nbondj_bdy_b(:)=2 870 ALLOCATE( lsend_bdy(nb_bdy,jpbgrd,4), lrecv_bdy(nb_bdy,jpbgrd,4) ) 871 lsend_bdy(:,:,:) = .false. 872 lrecv_bdy(:,:,:) = .false. 880 873 881 874 DO ib_bdy = 1, nb_bdy 882 ! default : no send883 llsend_ea = .false.884 llsend_we = .false.885 llsend_so = .false.886 llsend_no = .false.887 ! default : no receive888 llrecv_ea = .false.889 llrecv_we = .false.890 llrecv_so = .false.891 llrecv_no = .false.892 875 DO igrd = 1, jpbgrd 893 876 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) ! only the rim triggers communications, see bdy routines … … 896 879 ! 897 880 ! check if point has to be sent to a neighbour 881 ! W neighbour and on the inner left side 882 IF( ii == 2 .and. (nbondi == 0 .or. nbondi == 1) ) lsend_bdy(ib_bdy,igrd,1) = .true. 898 883 ! E neighbour and on the inner right side 899 IF( ii == nlci-1 .and. (nbondi == 0 .or. nbondi == -1) ) llsend_ea= .true.900 ! W neighbour and on the inner leftside901 IF( i i == 2 .and. (nbondi == 0 .or. nbondi == 1) ) llsend_we= .true.884 IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) ) lsend_bdy(ib_bdy,igrd,2) = .true. 885 ! S neighbour and on the inner down side 886 IF( ij == 2 .and. (nbondj == 0 .or. nbondj == 1) ) lsend_bdy(ib_bdy,igrd,3) = .true. 902 887 ! N neighbour and on the inner up side 903 IF( ij == nlcj-1 .and. (nbondj == 0 .or. nbondj == -1) ) llsend_no = .true. 904 ! S neighbour and on the inner down side 905 IF( ij == 2 .and. (nbondj == 0 .or. nbondj == 1) ) llsend_so = .true. 888 IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) ) lsend_bdy(ib_bdy,igrd,4) = .true. 906 889 ! 907 890 ! check if point has to be received from a neighbour 891 ! W neighbour and on the outter left side 892 IF( ii == 1 .and. (nbondi == 0 .or. nbondi == 1) ) lrecv_bdy(ib_bdy,igrd,1) = .true. 908 893 ! E neighbour and on the outter right side 909 IF( ii == nlci .and. (nbondi == 0 .or. nbondi == -1) ) llrecv_ea= .true.910 ! W neighbour and on the outter leftside911 IF( i i == 1 .and. (nbondi == 0 .or. nbondi == 1) ) llrecv_we= .true.894 IF( ii == jpi .and. (nbondi == 0 .or. nbondi == -1) ) lrecv_bdy(ib_bdy,igrd,2) = .true. 895 ! S neighbour and on the outter down side 896 IF( ij == 1 .and. (nbondj == 0 .or. nbondj == 1) ) lrecv_bdy(ib_bdy,igrd,3) = .true. 912 897 ! N neighbour and on the outter up side 913 IF( ij == nlcj .and. (nbondj == 0 .or. nbondj == -1) ) llrecv_no = .true. 914 ! S neighbour and on the outter down side 915 IF( ij == 1 .and. (nbondj == 0 .or. nbondj == 1) ) llrecv_so = .true. 898 IF( ij == jpj .and. (nbondj == 0 .or. nbondj == -1) ) lrecv_bdy(ib_bdy,igrd,4) = .true. 916 899 ! 917 900 END DO 918 901 END DO ! igrd 919 920 ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries921 IF( llsend_ea .and. llsend_we ) THEN ; nbondi_bdy(ib_bdy) = 0922 ELSEIF( llsend_ea .and. .not. llsend_we ) THEN ; nbondi_bdy(ib_bdy) = -1923 ELSEIF( .not. llsend_ea .and. llsend_we ) THEN ; nbondi_bdy(ib_bdy) = 1924 ENDIF925 IF( llsend_no .and. llsend_so ) THEN ; nbondj_bdy(ib_bdy) = 0926 ELSEIF( llsend_no .and. .not. llsend_so ) THEN ; nbondj_bdy(ib_bdy) = -1927 ELSEIF( .not. llsend_no .and. llsend_so ) THEN ; nbondj_bdy(ib_bdy) = 1928 ENDIF929 930 ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries931 IF( llrecv_ea .and. llrecv_we ) THEN ; nbondi_bdy_b(ib_bdy) = 0932 ELSEIF( llrecv_ea .and. .not. llrecv_we ) THEN ; nbondi_bdy_b(ib_bdy) = -1933 ELSEIF( .not. llrecv_ea .and. llrecv_we ) THEN ; nbondi_bdy_b(ib_bdy) = 1934 ENDIF935 IF( llrecv_no .and. llrecv_so ) THEN ; nbondj_bdy_b(ib_bdy) = 0936 ELSEIF( llrecv_no .and. .not. llrecv_so ) THEN ; nbondj_bdy_b(ib_bdy) = -1937 ELSEIF( .not. llrecv_no .and. llrecv_so ) THEN ; nbondj_bdy_b(ib_bdy) = 1938 ENDIF939 902 940 903 ! Compute rim weights for FRS scheme … … 1134 1097 ! 1 | o ! 2 o | ! 3 | x ! 4 x | 1135 1098 ! |_x_ _ ! _ _x_| ! | o ! o | 1136 IF( pmask(ii+1,ij+1) == 1. ) ztmp(ii,ij) = 1 1137 IF( pmask(ii-1,ij+1) == 1. ) ztmp(ii,ij) = 2 1138 IF( pmask(ii+1,ij-1) == 1. ) ztmp(ii,ij) = 3 1139 IF( pmask(ii-1,ij-1) == 1. ) ztmp(ii,ij) = 4 1099 IF( pmask(ii+1,ij+1) == 1. ) ztmp(ii,ij) = 1. 1100 IF( pmask(ii-1,ij+1) == 1. ) ztmp(ii,ij) = 2. 1101 IF( pmask(ii+1,ij-1) == 1. ) ztmp(ii,ij) = 3. 1102 IF( pmask(ii-1,ij-1) == 1. ) ztmp(ii,ij) = 4. 1140 1103 END IF 1141 1104 IF( inbdy == 1 ) THEN ! middle of linear bdy 1142 ztmp(ii,ij) = 0 ! regular treatment with flags1105 ztmp(ii,ij) = 0. ! regular treatment with flags 1143 1106 END IF 1144 1107 IF( inbdy == 2 ) THEN ! exterior of a corner … … 1146 1109 ! 5 ____x o ! 6 o x___ ! 7 x o ! 8 o x 1147 1110 ! | ! | ! o ! o 1148 IF( llnobdy .AND. lleabdy ) ztmp(ii,ij) = 5 1149 IF( llnobdy .AND. llwebdy ) ztmp(ii,ij) = 6 1150 IF( llsobdy .AND. lleabdy ) ztmp(ii,ij) = 7 1151 IF( llsobdy .AND. llwebdy ) ztmp(ii,ij) = 8 1111 IF( llnobdy .AND. lleabdy ) ztmp(ii,ij) = 5. 1112 IF( llnobdy .AND. llwebdy ) ztmp(ii,ij) = 6. 1113 IF( llsobdy .AND. lleabdy ) ztmp(ii,ij) = 7. 1114 IF( llsobdy .AND. llwebdy ) ztmp(ii,ij) = 8. 1152 1115 END IF 1153 1116 IF( inbdy == 3 ) THEN ! 3 neighbours __ __ … … 1155 1118 ! 9 _| x o ! 10 o x |_ ! 11 o x o ! 12 o x o 1156 1119 ! | o ! o | ! o ! __|¨|__ 1157 IF( llnobdy .AND. lleabdy .AND. llsobdy ) ztmp(ii,ij) = 9 1158 IF( llnobdy .AND. llwebdy .AND. llsobdy ) ztmp(ii,ij) = 10 1159 IF( llwebdy .AND. llsobdy .AND. lleabdy ) ztmp(ii,ij) = 11 1160 IF( llwebdy .AND. llnobdy .AND. lleabdy ) ztmp(ii,ij) = 12 1120 IF( llnobdy .AND. lleabdy .AND. llsobdy ) ztmp(ii,ij) = 9. 1121 IF( llnobdy .AND. llwebdy .AND. llsobdy ) ztmp(ii,ij) = 10. 1122 IF( llwebdy .AND. llsobdy .AND. lleabdy ) ztmp(ii,ij) = 11. 1123 IF( llwebdy .AND. llnobdy .AND. lleabdy ) ztmp(ii,ij) = 12. 1161 1124 END IF 1162 1125 IF( inbdy == 4 ) THEN … … 1171 1134 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 1172 1135 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 1173 idx_bdy(ib_bdy)%ntreat(ib,igrd) = ztmp(ii,ij)1136 idx_bdy(ib_bdy)%ntreat(ib,igrd) = NINT(ztmp(ii,ij)) 1174 1137 END DO 1175 1138 END DO … … 1177 1140 1178 1141 1179 ALLOCATE( lsend_bdy(nb_bdy,jpbgrd,4), lrecv_bdy(nb_bdy,jpbgrd,4) ) 1180 lsend_bdy(:,:,:) = .false. 1181 lrecv_bdy(:,:,:) = .false. 1142 ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd,4), lrecv_bdyint(nb_bdy,jpbgrd,4) ) 1143 lsend_bdyint(:,:,:) = .false. 1144 lrecv_bdyint(:,:,:) = .false. 1145 ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd,4), lrecv_bdyext(nb_bdy,jpbgrd,4) ) 1146 lsend_bdyext(:,:,:) = .false. 1147 lrecv_bdyext(:,:,:) = .false. 1182 1148 ! 1183 1149 ! Check which boundaries might need communication 1184 1150 DO igrd = 1, jpbgrd 1185 1151 DO ib_bdy = 1, nb_bdy 1186 IF ( nbondi_bdy (ib_bdy) == 0 ) THEN 1187 lsend_bdy(ib_bdy,igrd,1) = .true. 1188 lsend_bdy(ib_bdy,igrd,2) = .true. 1189 ELSE IF( nbondi_bdy (ib_bdy) == 1 ) THEN 1190 lsend_bdy(ib_bdy,igrd,1) = .true. 1191 ELSE IF( nbondi_bdy (ib_bdy) == -1 ) THEN 1192 lsend_bdy(ib_bdy,igrd,2) = .true. 1193 END IF 1194 IF ( nbondi_bdy_b(ib_bdy) == 0 ) THEN 1195 lrecv_bdy(ib_bdy,igrd,1) = .true. 1196 lrecv_bdy(ib_bdy,igrd,2) = .true. 1197 ELSE IF( nbondi_bdy_b(ib_bdy) == 1 ) THEN 1198 lrecv_bdy(ib_bdy,igrd,1) = .true. 1199 ELSE IF( nbondi_bdy_b(ib_bdy) == -1 ) THEN 1200 lrecv_bdy(ib_bdy,igrd,2) = .true. 1201 END IF 1202 IF( nbondj_bdy (ib_bdy) == 0 ) THEN 1203 lsend_bdy(ib_bdy,igrd,3) = .true. 1204 lsend_bdy(ib_bdy,igrd,4) = .true. 1205 ELSE IF( nbondj_bdy (ib_bdy) == 1 ) THEN 1206 lsend_bdy(ib_bdy,igrd,3) = .true. 1207 ELSE IF( nbondj_bdy (ib_bdy) == -1 ) THEN 1208 lsend_bdy(ib_bdy,igrd,4) = .true. 1209 END IF 1210 IF( nbondj_bdy_b(ib_bdy) == 0 ) THEN 1211 lrecv_bdy(ib_bdy,igrd,3) = .true. 1212 lrecv_bdy(ib_bdy,igrd,4) = .true. 1213 ELSE IF( nbondj_bdy_b(ib_bdy) == 1 ) THEN 1214 lrecv_bdy(ib_bdy,igrd,3) = .true. 1215 ELSE IF( nbondj_bdy_b(ib_bdy) == -1 ) THEN 1216 lrecv_bdy(ib_bdy,igrd,4) = .true. 1217 END IF 1152 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1153 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 1154 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 1155 flagu = NINT(idx_bdy(ib_bdy)%flagu(ib,igrd)) 1156 flagv = NINT(idx_bdy(ib_bdy)%flagv(ib,igrd)) 1157 iibe = ii - flagu ! neighbouring point towards the exterior of the computational domain 1158 ijbe = ij - flagv ! neighbouring point towards the exterior of the computational domain 1159 SELECT CASE( idx_bdy(ib_bdy)%ntreat(ib,igrd) ) ! points that will be used by bdy routines, -1 will be discarded 1160 CASE( 0 ) ; ii1 = ii + flagu ; ii2 = -1 ; ii3 = -1 1161 ij1 = ij + flagv ; ij2 = -1 ; ij3 = -1 1162 CASE( 1 ) ; ii1 = ii+1 ; ij1 = ij+1 ; ii2 = -1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -1 1163 CASE( 2 ) ; ii1 = ii-1 ; ij1 = ij+1 ; ii2 = -1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -1 1164 CASE( 3 ) ; ii1 = ii+1 ; ij1 = ij-1 ; ii2 = -1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -1 1165 CASE( 4 ) ; ii1 = ii-1 ; ij1 = ij-1 ; ii2 = -1 ; ij2 = -1 ; ii3 = -1 ; ij3 = -1 1166 CASE( 5 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = -1 ; ij3 = -1 1167 CASE( 6 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = -1 ; ij3 = -1 1168 CASE( 7 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = -1 ; ij3 = -1 1169 CASE( 8 ) ; ii1 = ii ; ij1 = ij-1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = -1 ; ij3 = -1 1170 CASE( 9 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii+1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1171 CASE( 10 ) ; ii1 = ii ; ij1 = ij+1 ; ii2 = ii-1 ; ij2 = ij ; ii3 = ii ; ij3 = ij-1 1172 CASE( 11 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij-1 ; ii3 = ii+1 ; ij3 = ij 1173 CASE( 12 ) ; ii1 = ii-1 ; ij1 = ij ; ii2 = ii ; ij2 = ij+1 ; ii3 = ii+1 ; ij3 = ij 1174 END SELECT 1175 ! 1176 ! search neighbour in the west/east direction 1177 ! Rim is on the halo and computed ocean is towards exterior of mpi domain 1178 ! <-- (o exterior) --> 1179 ! (1) o|x OR (2) x|o 1180 ! |___ ___| 1181 IF( ii1 == 0 .OR. ii2 == 0 .OR. ii3 == 0 ) lrecv_bdyint(ib_bdy,igrd,1) = .true. 1182 IF( ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 ) lrecv_bdyint(ib_bdy,igrd,2) = .true. 1183 IF( iibe == 0 ) lrecv_bdyext(ib_bdy,igrd,1) = .true. 1184 IF( iibe == jpi+1 ) lrecv_bdyext(ib_bdy,igrd,2) = .true. 1185 ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo 1186 ! :¨¨¨¨¨|¨¨--> | | <--¨¨|¨¨¨¨¨: 1187 ! : | x:o | neighbour limited by ... would need o | o:x | : 1188 ! :.....|_._:_____| (1) W neighbour E neighbour (2) |_____:_._|.....: 1189 IF( ii == 2 .AND. ( nbondi == 1 .OR. nbondi == 0 ) & 1190 & .AND. ( ii1 == 3 .OR. ii2 == 3 .OR. ii3 == 3 ) ) lsend_bdyint(ib_bdy,igrd,1) = .true. 1191 IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) & 1192 & .AND. ( ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2 ) ) lsend_bdyint(ib_bdy,igrd,2) = .true. 1193 IF( ii == 2 .AND. ( nbondi == 1 .OR. nbondi == 0 ) .AND. iibe == 3 ) lsend_bdyext(ib_bdy,igrd,1) = .true. 1194 IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 ) lsend_bdyext(ib_bdy,igrd,2) = .true. 1195 ! 1196 ! search neighbour in the north/south direction 1197 ! Rim is on the halo and computed ocean is towards exterior of mpi domain 1198 !(3) | | ^ ___o___ 1199 ! | |___x___| OR | | x | 1200 ! v o (4) | | 1201 IF( ij1 == 0 .OR. ij2 == 0 .OR. ij3 == 0 ) lrecv_bdyint(ib_bdy,igrd,3) = .true. 1202 IF( ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 ) lrecv_bdyint(ib_bdy,igrd,4) = .true. 1203 IF( ijbe == 0 ) lrecv_bdyext(ib_bdy,igrd,3) = .true. 1204 IF( ijbe == jpj+1 ) lrecv_bdyext(ib_bdy,igrd,4) = .true. 1205 ! Check if neighbour has its rim parallel to its mpi subdomain _________ border and next to its halo 1206 ! ^ | o | : : 1207 ! | |¨¨¨¨x¨¨¨¨| neighbour limited by ... would need o | |....x....| 1208 ! :_________: (3) S neighbour N neighbour (4) v | o | 1209 IF( ij == 2 .AND. ( nbondj == 1 .OR. nbondj == 0 ) & 1210 & .AND. ( ij1 == 3 .OR. ij2 == 3 .OR. ij3 == 3 ) ) lsend_bdyint(ib_bdy,igrd,3) = .true. 1211 IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) & 1212 & .AND. ( ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2 ) ) lsend_bdyint(ib_bdy,igrd,4) = .true. 1213 IF( ij == 2 .AND. ( nbondj == 1 .OR. nbondj == 0 ) .AND. ijbe == 3 ) lsend_bdyext(ib_bdy,igrd,3) = .true. 1214 IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 ) lsend_bdyext(ib_bdy,igrd,4) = .true. 1215 END DO 1218 1216 END DO 1219 1217 END DO 1218 1219 DO ib_bdy = 1,nb_bdy 1220 IF( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' .OR. & 1221 & cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo' .OR. & 1222 & cn_tra(ib_bdy) == 'orlanski' .OR. cn_tra(ib_bdy) == 'orlanski_npo' ) THEN 1223 DO igrd = 1, jpbgrd 1224 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1225 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 1226 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 1227 IF( mig(ii) > 2 .AND. mig(ii) < jpiglo-2 .AND. mjg(ij) > 2 .AND. mjg(ij) < jpjglo-2 ) THEN 1228 WRITE(ctmp1,*) ' Orlanski can not be used when the open boundaries are on the interior of the computational domain' 1229 WRITE(ctmp2,*) ' ========== ' 1230 CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 1231 END IF 1232 END DO 1233 END DO 1234 END IF 1235 END DO 1236 1220 1237 ! 1221 1238 ! Tidy up
Note: See TracChangeset
for help on using the changeset viewer.
