Changeset 13556
- Timestamp:
- 2020-10-02T13:01:08+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC
- Files:
-
- 2 edited
-
mpp_nfd_generic.h90 (modified) (2 diffs)
-
mppini.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mpp_nfd_generic.h90
r13553 r13556 106 106 REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo 107 107 !!---------------------------------------------------------------------- 108 #if defined key_mpp_mpi109 108 ! 110 109 ipk = K_SIZE(ptab) ! 3rd dimension … … 398 397 ENDIF ! l_north_nogather 399 398 ! 400 #endif401 399 END SUBROUTINE ROUTINE_NFD 402 400 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LBC/mppini.F90
r13553 r13556 672 672 673 673 #endif 674 675 SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 676 !!---------------------------------------------------------------------- 677 !! *** ROUTINE mpp_basesplit *** 678 !! 679 !! ** Purpose : Lay out the global domain over processors. 680 !! 681 !! ** Method : Global domain is distributed in smaller local domains. 682 !! 683 !! ** Action : - set for all knbi*knbj domains: 684 !! kimppt : longitudinal index 685 !! kjmppt : latitudinal index 686 !! klci : first dimension 687 !! klcj : second dimension 688 !!---------------------------------------------------------------------- 689 INTEGER, INTENT(in ) :: kiglo, kjglo 690 INTEGER, INTENT(in ) :: khls 691 INTEGER, INTENT(in ) :: knbi, knbj 692 INTEGER, INTENT( out) :: kimax, kjmax 693 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: kimppt, kjmppt 694 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: klci, klcj 695 ! 696 INTEGER :: ji, jj 697 INTEGER :: i2hls 698 INTEGER :: iresti, irestj, irm, ijpjmin 699 !!---------------------------------------------------------------------- 700 i2hls = 2*khls 701 ! 702 #if defined key_nemocice_decomp 703 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 704 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 705 #else 706 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 707 kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 708 #endif 709 IF( .NOT. PRESENT(kimppt) ) RETURN 710 ! 711 ! 1. Dimension arrays for subdomains 712 ! ----------------------------------- 713 ! Computation of local domain sizes klci() klcj() 714 ! These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 715 ! The subdomains are squares lesser than or equal to the global 716 ! dimensions divided by the number of processors minus the overlap array. 717 ! 718 iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 719 irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 720 ! 721 ! Need to use kimax and kjmax here since jpi and jpj not yet defined 722 #if defined key_nemocice_decomp 723 ! Change padding to be consistent with CICE 724 klci(1:knbi-1,: ) = kimax 725 klci( knbi ,: ) = kiglo - (knbi - 1) * (kimax - i2hls) 726 klcj(: ,1:knbj-1) = kjmax 727 klcj(: , knbj ) = kjglo - (knbj - 1) * (kjmax - i2hls) 728 #else 729 klci(1:iresti ,:) = kimax 730 klci(iresti+1:knbi ,:) = kimax-1 731 IF( MINVAL(klci) < 2*i2hls ) THEN 732 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 733 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 734 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 735 ENDIF 736 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 737 ! minimize the size of the last row to compensate for the north pole folding coast 738 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos 739 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos 740 irm = knbj - irestj ! total number of lines to be removed 741 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 742 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 743 irestj = knbj - 1 - irm 744 klcj(:, irestj+1:knbj-1) = kjmax-1 745 ELSE 746 klcj(:, irestj+1:knbj ) = kjmax-1 747 ENDIF 748 klcj(:,1:irestj) = kjmax 749 IF( MINVAL(klcj) < 2*i2hls ) THEN 750 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 751 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 752 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 753 ENDIF 754 #endif 755 756 ! 2. Index arrays for subdomains 757 ! ------------------------------- 758 kimppt(:,:) = 1 759 kjmppt(:,:) = 1 760 ! 761 IF( knbi > 1 ) THEN 762 DO jj = 1, knbj 763 DO ji = 2, knbi 764 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 765 END DO 766 END DO 767 ENDIF 768 ! 769 IF( knbj > 1 )THEN 770 DO jj = 2, knbj 771 DO ji = 1, knbi 772 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 773 END DO 774 END DO 775 ENDIF 776 777 END SUBROUTINE mpp_basesplit 778 674 779 675 780 SUBROUTINE bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) … … 925 1030 ! 926 1031 END SUBROUTINE mpp_init_landprop 927 928 929 SUBROUTINE init_ioipsl 930 !!---------------------------------------------------------------------- 931 !! *** ROUTINE init_ioipsl *** 932 !! 933 !! ** Purpose : 934 !! 935 !! ** Method : 936 !! 937 !! History : 938 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 939 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 940 !!---------------------------------------------------------------------- 941 INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 942 !!---------------------------------------------------------------------- 943 944 ! The domain is split only horizontally along i- or/and j- direction 945 ! So we need at the most only 1D arrays with 2 elements. 946 ! Set idompar values equivalent to the jpdom_local_noextra definition 947 ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 948 iglo( :) = (/ Ni0glo, Nj0glo /) 949 iloc( :) = (/ Ni_0 , Nj_0 /) 950 iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined! 951 iabsl(:) = iabsf(:) + iloc(:) - 1 952 ihals(:) = (/ 0 , 0 /) 953 ihale(:) = (/ 0 , 0 /) 954 idid( :) = (/ 1 , 2 /) 955 956 IF(lwp) THEN 957 WRITE(numout,*) 958 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc 959 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf 960 WRITE(numout,*) ' ihals = ', ihals 961 WRITE(numout,*) ' ihale = ', ihale 962 ENDIF 963 ! 964 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 965 ! 966 END SUBROUTINE init_ioipsl 967 968 969 SUBROUTINE init_nfdcom 970 !!---------------------------------------------------------------------- 971 !! *** ROUTINE init_nfdcom *** 972 !! ** Purpose : Setup for north fold exchanges with explicit 973 !! point-to-point messaging 974 !! 975 !! ** Method : Initialization of the northern neighbours lists. 976 !!---------------------------------------------------------------------- 977 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 978 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 979 !!---------------------------------------------------------------------- 980 INTEGER :: sxM, dxM, sxT, dxT, jn 981 !!---------------------------------------------------------------------- 982 ! 983 !initializes the north-fold communication variables 984 isendto(:) = 0 985 nsndto = 0 986 ! 987 IF ( njmpp == MAXVAL( njmppt ) ) THEN ! if I am a process in the north 988 ! 989 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 990 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 991 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 992 dxM = jpiglo - nimppt(narea) + 2 993 ! 994 ! loop over the other north-fold processes to find the processes 995 ! managing the points belonging to the sxT-dxT range 996 ! 997 DO jn = 1, jpni 998 ! 999 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1000 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1001 ! 1002 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1003 nsndto = nsndto + 1 1004 isendto(nsndto) = jn 1005 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1006 nsndto = nsndto + 1 1007 isendto(nsndto) = jn 1008 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1009 nsndto = nsndto + 1 1010 isendto(nsndto) = jn 1011 ENDIF 1012 ! 1013 END DO 1014 ! 1015 ENDIF 1016 l_north_nogather = .TRUE. 1017 ! 1018 END SUBROUTINE init_nfdcom 1019 1020 #endif 1021 1022 SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 1023 !!---------------------------------------------------------------------- 1024 !! *** ROUTINE mpp_basesplit *** 1025 !! 1026 !! ** Purpose : Lay out the global domain over processors. 1027 !! 1028 !! ** Method : Global domain is distributed in smaller local domains. 1029 !! 1030 !! ** Action : - set for all knbi*knbj domains: 1031 !! kimppt : longitudinal index 1032 !! kjmppt : latitudinal index 1033 !! klci : first dimension 1034 !! klcj : second dimension 1035 !!---------------------------------------------------------------------- 1036 INTEGER, INTENT(in ) :: kiglo, kjglo 1037 INTEGER, INTENT(in ) :: khls 1038 INTEGER, INTENT(in ) :: knbi, knbj 1039 INTEGER, INTENT( out) :: kimax, kjmax 1040 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: kimppt, kjmppt 1041 INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: klci, klcj 1042 ! 1043 INTEGER :: ji, jj 1044 INTEGER :: i2hls 1045 INTEGER :: iresti, irestj, irm, ijpjmin 1046 !!---------------------------------------------------------------------- 1047 i2hls = 2*khls 1048 ! 1049 #if defined key_nemocice_decomp 1050 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 1051 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 1052 #else 1053 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 1054 kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 1055 #endif 1056 IF( .NOT. PRESENT(kimppt) ) RETURN 1057 ! 1058 ! 1. Dimension arrays for subdomains 1059 ! ----------------------------------- 1060 ! Computation of local domain sizes klci() klcj() 1061 ! These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 1062 ! The subdomains are squares lesser than or equal to the global 1063 ! dimensions divided by the number of processors minus the overlap array. 1064 ! 1065 iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 1066 irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 1067 ! 1068 ! Need to use kimax and kjmax here since jpi and jpj not yet defined 1069 #if defined key_nemocice_decomp 1070 ! Change padding to be consistent with CICE 1071 klci(1:knbi-1,: ) = kimax 1072 klci( knbi ,: ) = kiglo - (knbi - 1) * (kimax - i2hls) 1073 klcj(: ,1:knbj-1) = kjmax 1074 klcj(: , knbj ) = kjglo - (knbj - 1) * (kjmax - i2hls) 1075 #else 1076 klci(1:iresti ,:) = kimax 1077 klci(iresti+1:knbi ,:) = kimax-1 1078 IF( MINVAL(klci) < 2*i2hls ) THEN 1079 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 1080 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 1081 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 1082 ENDIF 1083 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 1084 ! minimize the size of the last row to compensate for the north pole folding coast 1085 IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos 1086 IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos 1087 irm = knbj - irestj ! total number of lines to be removed 1088 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 1089 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 1090 irestj = knbj - 1 - irm 1091 klcj(:, irestj+1:knbj-1) = kjmax-1 1092 ELSE 1093 klcj(:, irestj+1:knbj ) = kjmax-1 1094 ENDIF 1095 klcj(:,1:irestj) = kjmax 1096 IF( MINVAL(klcj) < 2*i2hls ) THEN 1097 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 1098 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 1099 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 1100 ENDIF 1101 #endif 1102 1103 ! 2. Index arrays for subdomains 1104 ! ------------------------------- 1105 kimppt(:,:) = 1 1106 kjmppt(:,:) = 1 1107 ! 1108 IF( knbi > 1 ) THEN 1109 DO jj = 1, knbj 1110 DO ji = 2, knbi 1111 kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 1112 END DO 1113 END DO 1114 ENDIF 1115 ! 1116 IF( knbj > 1 )THEN 1117 DO jj = 2, knbj 1118 DO ji = 1, knbi 1119 kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 1120 END DO 1121 END DO 1122 ENDIF 1123 1124 END SUBROUTINE mpp_basesplit 1125 1126 1032 1033 1127 1034 SUBROUTINE mpp_is_ocean( ldisoce ) 1128 1035 !!---------------------------------------------------------------------- … … 1140 1047 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1141 1048 !!---------------------------------------------------------------------- 1142 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1049 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1143 1050 ! 1144 1051 INTEGER :: idiv, iimax, ijmax, iarea … … 1149 1056 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1150 1057 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1151 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1058 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1152 1059 !!---------------------------------------------------------------------- 1153 1060 ! do nothing if there is no land-sea mask … … 1182 1089 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1183 1090 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 1184 ! 1091 ! 1185 1092 IF( iarea == 1 ) THEN ! the first line was not read 1186 1093 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity … … 1193 1100 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1194 1101 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 1195 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1102 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1196 1103 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) 1197 1104 DO ji = 3,inx-1 … … 1227 1134 ENDIF 1228 1135 END DO 1229 1136 1230 1137 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1231 1138 CALL mpp_sum( 'mppini', inboce_1d ) … … 1235 1142 ! 1236 1143 END SUBROUTINE mpp_is_ocean 1144 1145 1146 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 1147 !!---------------------------------------------------------------------- 1148 !! *** ROUTINE readbot_strip *** 1149 !! 1150 !! ** Purpose : Read relevant bathymetric information in order to 1151 !! provide a land/sea mask used for the elimination 1152 !! of land domains, in an mpp computation. 1153 !! 1154 !! ** Method : read stipe of size (Ni0glo,...) 1155 !!---------------------------------------------------------------------- 1156 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1157 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1158 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1159 ! 1160 INTEGER :: inumsave ! local logical unit 1161 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1162 !!---------------------------------------------------------------------- 1163 ! 1164 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1165 ! 1166 IF( numbot /= -1 ) THEN 1167 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1168 ELSE 1169 zbot(:,:) = 1._wp ! put a non-null value 1170 ENDIF 1171 ! 1172 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1173 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1174 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1175 ENDIF 1176 ! 1177 ldoce(:,:) = zbot(:,:) > 0._wp 1178 numout = inumsave 1179 ! 1180 END SUBROUTINE readbot_strip 1237 1181 1238 1182 … … 1290 1234 1291 1235 1292 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 1293 !!---------------------------------------------------------------------- 1294 !! *** ROUTINE readbot_strip *** 1295 !! 1296 !! ** Purpose : Read relevant bathymetric information in order to 1297 !! provide a land/sea mask used for the elimination 1298 !! of land domains, in an mpp computation. 1299 !! 1300 !! ** Method : read stipe of size (Ni0glo,...) 1301 !!---------------------------------------------------------------------- 1302 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1303 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1304 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1305 ! 1306 INTEGER :: inumsave ! local logical unit 1307 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1308 !!---------------------------------------------------------------------- 1309 ! 1310 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1311 ! 1312 IF( numbot /= -1 ) THEN 1313 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1314 ELSE 1315 zbot(:,:) = 1._wp ! put a non-null value 1316 ENDIF 1317 ! 1318 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1319 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1320 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1321 ENDIF 1322 ! 1323 ldoce(:,:) = zbot(:,:) > 0._wp 1324 numout = inumsave 1325 ! 1326 END SUBROUTINE readbot_strip 1236 SUBROUTINE init_ioipsl 1237 !!---------------------------------------------------------------------- 1238 !! *** ROUTINE init_ioipsl *** 1239 !! 1240 !! ** Purpose : 1241 !! 1242 !! ** Method : 1243 !! 1244 !! History : 1245 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1246 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 1247 !!---------------------------------------------------------------------- 1248 INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 1249 !!---------------------------------------------------------------------- 1250 1251 ! The domain is split only horizontally along i- or/and j- direction 1252 ! So we need at the most only 1D arrays with 2 elements. 1253 ! Set idompar values equivalent to the jpdom_local_noextra definition 1254 ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 1255 iglo( :) = (/ Ni0glo, Nj0glo /) 1256 iloc( :) = (/ Ni_0 , Nj_0 /) 1257 iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined! 1258 iabsl(:) = iabsf(:) + iloc(:) - 1 1259 ihals(:) = (/ 0 , 0 /) 1260 ihale(:) = (/ 0 , 0 /) 1261 idid( :) = (/ 1 , 2 /) 1262 1263 IF(lwp) THEN 1264 WRITE(numout,*) 1265 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc 1266 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf 1267 WRITE(numout,*) ' ihals = ', ihals 1268 WRITE(numout,*) ' ihale = ', ihale 1269 ENDIF 1270 ! 1271 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 1272 ! 1273 END SUBROUTINE init_ioipsl 1274 1275 1276 SUBROUTINE init_nfdcom 1277 !!---------------------------------------------------------------------- 1278 !! *** ROUTINE init_nfdcom *** 1279 !! ** Purpose : Setup for north fold exchanges with explicit 1280 !! point-to-point messaging 1281 !! 1282 !! ** Method : Initialization of the northern neighbours lists. 1283 !!---------------------------------------------------------------------- 1284 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 1285 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1286 !!---------------------------------------------------------------------- 1287 INTEGER :: sxM, dxM, sxT, dxT, jn 1288 !!---------------------------------------------------------------------- 1289 ! 1290 !initializes the north-fold communication variables 1291 isendto(:) = 0 1292 nsndto = 0 1293 ! 1294 IF ( njmpp == MAXVAL( njmppt ) ) THEN ! if I am a process in the north 1295 ! 1296 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1297 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 1298 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1299 dxM = jpiglo - nimppt(narea) + 2 1300 ! 1301 ! loop over the other north-fold processes to find the processes 1302 ! managing the points belonging to the sxT-dxT range 1303 ! 1304 DO jn = 1, jpni 1305 ! 1306 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1307 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1308 ! 1309 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1310 nsndto = nsndto + 1 1311 isendto(nsndto) = jn 1312 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1313 nsndto = nsndto + 1 1314 isendto(nsndto) = jn 1315 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1316 nsndto = nsndto + 1 1317 isendto(nsndto) = jn 1318 ENDIF 1319 ! 1320 END DO 1321 ! 1322 ENDIF 1323 l_north_nogather = .TRUE. 1324 ! 1325 END SUBROUTINE init_nfdcom 1327 1326 1328 1327
Note: See TracChangeset
for help on using the changeset viewer.
