- Timestamp:
- 2020-06-29T18:02:13+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13174 r13176 32 32 PRIVATE 33 33 34 PUBLIC mpp_init ! called by opa.F90 35 34 PUBLIC mpp_init ! called by nemogcm.F90 35 PUBLIC mpp_getnum ! called by prtctl 36 PUBLIC mpp_basesplit ! called by prtctl 37 PUBLIC mpp_is_ocean ! called by prtctl 38 36 39 INTEGER :: numbot = -1 ! 'bottom_level' local logical unit 37 40 INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit … … 76 79 jpnj = 1 77 80 jpnij = jpni*jpnj 78 nimpp = 1 ! 81 nn_hls = 1 82 nimpp = 1 79 83 njmpp = 1 80 84 nbondi = 2 … … 137 141 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 138 142 INTEGER :: inijmin 139 INTEGER :: i2add140 143 INTEGER :: inum ! local logical unit 141 INTEGER :: idir, ifreq , icont! local integers144 INTEGER :: idir, ifreq ! local integers 142 145 INTEGER :: ii, il1, ili, imil ! - - 143 146 INTEGER :: ij, il2, ilj, ijm1 ! - - … … 186 189 ENDIF 187 190 WRITE(numout,*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather 191 WRITE(numout,*) ' halo width (applies to both rows and columns) nn_hls = ', nn_hls 188 192 ENDIF 189 193 ! … … 225 229 CALL bestpartition( mppsize, inbi, inbj, icnt2 ) ! best mpi decomposition for mppsize mpi processes 226 230 ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist 227 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax )231 CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 228 232 ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition 229 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, inbi, inbj, iimax, ijmax )233 CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, inbi, inbj, iimax, ijmax ) 230 234 icnt1 = jpni*jpnj - mppsize ! number of land subdomains that should be removed to use mppsize mpi processes 231 235 IF(lwp) THEN … … 258 262 ! look for land mpi subdomains... 259 263 ALLOCATE( llisoce(jpni,jpnj) ) 260 CALL is_ocean( jpni, jpnj,llisoce )264 CALL mpp_is_ocean( llisoce ) 261 265 inijmin = COUNT( llisoce ) ! number of oce subdomains 262 266 … … 316 320 9003 FORMAT (a, i5) 317 321 318 IF( numbot /= -1 ) CALL iom_close( numbot )319 IF( numbdy /= -1 ) CALL iom_close( numbdy )320 321 322 ALLOCATE( nfimpp(jpni ) , nfproc(jpni ) , nfjpi(jpni ) , & 322 323 & nimppt(jpnij) , ibonit(jpnij) , jpiall(jpnij) , jpjall(jpnij) , & … … 346 347 ! ----------------------------------- 347 348 ! 348 CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 349 CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 350 CALL mpp_getnum( llisoce, ipproc, iin, ijn ) 351 ! 352 nfproc(:) = ipproc(:,jpnj) 349 353 nfimpp(:) = iimppt(:,jpnj) 350 354 nfjpi (:) = ijpi(:,jpnj) … … 357 361 WRITE(numout,*) ' jpni = ', jpni 358 362 WRITE(numout,*) ' jpnj = ', jpnj 363 WRITE(numout,*) ' jpnij = ', jpnij 359 364 WRITE(numout,*) 360 365 WRITE(numout,*) ' sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo … … 431 436 ! ---------------------------- 432 437 ! 433 ! specify which subdomains are oce subdomains; other are land subdomains434 ipproc(:,:) = -1435 icont = -1436 DO jarea = 1, jpni*jpnj437 iarea0 = jarea - 1438 ii = 1 + MOD(iarea0,jpni)439 ij = 1 + iarea0/jpni440 IF( llisoce(ii,ij) ) THEN441 icont = icont + 1442 ipproc(ii,ij) = icont443 iin(icont+1) = ii444 ijn(icont+1) = ij445 ENDIF446 END DO447 ! if needed add some land subdomains to reach jpnij active subdomains448 i2add = jpnij - inijmin449 DO jarea = 1, jpni*jpnj450 iarea0 = jarea - 1451 ii = 1 + MOD(iarea0,jpni)452 ij = 1 + iarea0/jpni453 IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN454 icont = icont + 1455 ipproc(ii,ij) = icont456 iin(icont+1) = ii457 ijn(icont+1) = ij458 i2add = i2add - 1459 ENDIF460 END DO461 nfproc(:) = ipproc(:,jpnj)462 463 438 ! neighbour treatment: change ibondi, ibondj if next to a land zone 464 439 DO jarea = 1, jpni*jpnj … … 655 630 WRITE(numout,*) ' nimpp = ', nimpp 656 631 WRITE(numout,*) ' njmpp = ', njmpp 657 WRITE(numout,*) ' nn_hls = ', nn_hls658 632 ENDIF 659 633 … … 700 674 701 675 702 SUBROUTINE basic_decomposition( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)703 !!---------------------------------------------------------------------- 704 !! *** ROUTINE basic_decomposition***676 SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 677 !!---------------------------------------------------------------------- 678 !! *** ROUTINE mpp_basesplit *** 705 679 !! 706 680 !! ** Purpose : Lay out the global domain over processors. … … 757 731 klci(iresti+1:knbi ,:) = kimax-1 758 732 IF( MINVAL(klci) < 2*i2hls ) THEN 759 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpi must be >= ', 2*i2hls733 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 760 734 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 761 735 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 775 749 klcj(:,1:irestj) = kjmax 776 750 IF( MINVAL(klcj) < 2*i2hls ) THEN 777 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpj must be >= ', 2*i2hls751 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 778 752 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 779 753 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 802 776 ENDIF 803 777 804 END SUBROUTINE basic_decomposition778 END SUBROUTINE mpp_basesplit 805 779 806 780 … … 909 883 iszij1(:) = iszi1(:) * iszj1(:) 910 884 911 ! if ther ris no land and no print885 ! if there is no land and no print 912 886 IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN 913 887 ! get the smaller partition which gives the smallest subdomain size … … 957 931 ji = isz0 ! initialization with the largest value 958 932 ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 959 CALL is_ocean( inbi0(ji), inbj0(ji), llisoce )! Warning: must be call by all cores (call mpp_sum)933 CALL mpp_is_ocean( llisoce ) ! Warning: must be call by all cores (call mpp_sum) 960 934 inbijold = COUNT(llisoce) 961 935 DEALLOCATE( llisoce ) 962 936 DO ji =isz0-1,1,-1 963 937 ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 964 CALL is_ocean( inbi0(ji), inbj0(ji), llisoce )! Warning: must be call by all cores (call mpp_sum)938 CALL mpp_is_ocean( llisoce ) ! Warning: must be call by all cores (call mpp_sum) 965 939 inbij = COUNT(llisoce) 966 940 DEALLOCATE( llisoce ) … … 988 962 ii = ii -1 989 963 ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 990 CALL is_ocean( inbi0(ii), inbj0(ii),llisoce ) ! must be done by all core964 CALL mpp_is_ocean( llisoce ) ! must be done by all core 991 965 inbij = COUNT(llisoce) 992 966 DEALLOCATE( llisoce ) … … 1052 1026 1053 1027 1054 SUBROUTINE is_ocean( knbi, knbj,ldisoce )1055 !!---------------------------------------------------------------------- 1056 !! *** ROUTINE mpp_i nit_nboce***1057 !! 1058 !! ** Purpose : Check for a mpi domain decomposition knbi x knbj which1028 SUBROUTINE mpp_is_ocean( ldisoce ) 1029 !!---------------------------------------------------------------------- 1030 !! *** ROUTINE mpp_is_ocean *** 1031 !! 1032 !! ** Purpose : Check for a mpi domain decomposition inbi x inbj which 1059 1033 !! subdomains, including 1 halo (even if nn_hls>1), contain 1060 1034 !! at least 1 ocean point. … … 1065 1039 !! a subdomain with a closed boundary. 1066 1040 !! 1067 !! ** Method : read knbj strips (of length Ni0glo) of the land-sea mask 1068 !!---------------------------------------------------------------------- 1069 INTEGER, INTENT(in ) :: knbi, knbj ! domain decomposition 1070 LOGICAL, DIMENSION(knbi,knbj), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1071 ! 1072 INTEGER, DIMENSION(knbi,knbj) :: inboce ! number oce oce pint in each mpi subdomain 1073 INTEGER, DIMENSION(knbi*knbj) :: inboce_1d 1041 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1042 !!---------------------------------------------------------------------- 1043 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1044 ! 1074 1045 INTEGER :: idiv, iimax, ijmax, iarea 1075 INTEGER :: in x, iny, inry, isty1046 INTEGER :: inbi, inbj, inx, iny, inry, isty 1076 1047 INTEGER :: ji, jn 1077 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1048 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: inboce ! number oce oce pint in each mpi subdomain 1049 INTEGER, ALLOCATABLE, DIMENSION(: ) :: inboce_1d 1078 1050 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1079 1051 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1052 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1080 1053 !!---------------------------------------------------------------------- 1081 1054 ! do nothing if there is no land-sea mask … … 1084 1057 RETURN 1085 1058 ENDIF 1086 1087 ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1 1088 IF ( knbj == 1 ) THEN ; idiv = mppsize 1089 ELSE IF ( mppsize < knbj ) THEN ; idiv = 1 1090 ELSE ; idiv = ( mppsize - 1 ) / ( knbj - 1 ) 1091 ENDIF 1059 ! 1060 inbi = SIZE( ldisoce, dim = 1 ) 1061 inbj = SIZE( ldisoce, dim = 2 ) 1062 ! 1063 ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1 1064 IF ( inbj == 1 ) THEN ; idiv = mppsize 1065 ELSE IF ( mppsize < inbj ) THEN ; idiv = 1 1066 ELSE ; idiv = ( mppsize - 1 ) / ( inbj - 1 ) 1067 ENDIF 1068 ! 1069 ALLOCATE( inboce(inbi,inbj), inboce_1d(inbi*inbj) ) 1092 1070 inboce(:,:) = 0 ! default no ocean point found 1093 1094 DO jn = 0, ( knbj-1)/mppsize ! if mppsize < knbj : more strips than mpi processes (because of potential land domains)1071 ! 1072 DO jn = 0, (inbj-1)/mppsize ! if mppsize < inbj : more strips than mpi processes (because of potential land domains) 1095 1073 ! 1096 1074 iarea = (narea-1)/idiv + jn * mppsize + 1 ! involed process number (starting counting at 1) 1097 IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= knbj ) THEN ! beware idiv can be = to 11075 IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= inbj ) THEN ! beware idiv can be = to 1 1098 1076 ! 1099 ALLOCATE( iimppt( knbi,knbj), ijmppt(knbi,knbj), ijpi(knbi,knbj), ijpj(knbi,knbj) )1100 CALL basic_decomposition( Ni0glo, Nj0glo, 0, knbi, knbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj )1077 ALLOCATE( iimppt(inbi,inbj), ijmppt(inbi,inbj), ijpi(inbi,inbj), ijpj(inbi,inbj) ) 1078 CALL mpp_basesplit( Ni0glo, Nj0glo, 0, inbi, inbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 1101 1079 ! 1102 1080 inx = Ni0glo + 2 ; iny = ijpj(1,iarea) + 2 ! strip size + 1 halo on each direction (even if nn_hls>1) 1103 1081 ALLOCATE( lloce(inx, iny) ) ! allocate the strip 1104 inry = iny - COUNT( (/ iarea == 1, iarea == knbj /) ) ! number of point to read in y-direction1082 inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) ) ! number of point to read in y-direction 1105 1083 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1106 1084 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip … … 1113 1091 ENDIF 1114 1092 ENDIF 1115 IF( iarea == knbj ) THEN ! the last line was not read1093 IF( iarea == inbj ) THEN ! the last line was not read 1116 1094 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1117 1095 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce … … 1127 1105 ENDIF 1128 1106 ! 1129 DO ji = 1, knbi1107 DO ji = 1, inbi 1130 1108 inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) ) ! lloce as 2 points more than Ni0glo 1131 1109 END DO … … 1137 1115 END DO 1138 1116 1139 inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))1117 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1140 1118 CALL mpp_sum( 'mppini', inboce_1d ) 1141 inboce = RESHAPE(inboce_1d, (/ knbi, knbj/))1119 inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 1142 1120 ldisoce(:,:) = inboce(:,:) /= 0 1143 ! 1144 END SUBROUTINE is_ocean 1121 DEALLOCATE(inboce, inboce_1d) 1122 ! 1123 END SUBROUTINE mpp_is_ocean 1145 1124 1146 1125 … … 1155 1134 !! ** Method : read stipe of size (Ni0glo,...) 1156 1135 !!---------------------------------------------------------------------- 1157 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading1158 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1159 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean1136 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1137 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1138 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1160 1139 ! 1161 1140 INTEGER :: inumsave ! local logical unit … … 1180 1159 ! 1181 1160 END SUBROUTINE readbot_strip 1161 1162 1163 SUBROUTINE mpp_getnum( ldisoce, kproc, kipos, kjpos ) 1164 !!---------------------------------------------------------------------- 1165 !! *** ROUTINE mpp_getnum *** 1166 !! 1167 !! ** Purpose : give a number to each MPI subdomains (starting at 0) 1168 !! 1169 !! ** Method : start from bottom left. First skip land subdomain, and finally use them if needed 1170 !!---------------------------------------------------------------------- 1171 LOGICAL, DIMENSION(:,:), INTENT(in ) :: ldisoce ! F if land process 1172 INTEGER, DIMENSION(:,:), INTENT( out) :: kproc ! subdomain number (-1 if supressed, starting at 0) 1173 INTEGER, DIMENSION( :), INTENT( out) :: kipos ! i-position of the subdomain (from 1 to jpni) 1174 INTEGER, DIMENSION( :), INTENT( out) :: kjpos ! j-position of the subdomain (from 1 to jpnj) 1175 ! 1176 INTEGER :: ii, ij, jarea, iarea0 1177 INTEGER :: icont, i2add , ini, inj, inij 1178 !!---------------------------------------------------------------------- 1179 ! 1180 ini = SIZE(ldisoce, dim = 1) 1181 inj = SIZE(ldisoce, dim = 2) 1182 inij = SIZE(kipos) 1183 ! 1184 ! specify which subdomains are oce subdomains; other are land subdomains 1185 kproc(:,:) = -1 1186 icont = -1 1187 DO jarea = 1, ini*inj 1188 iarea0 = jarea - 1 1189 ii = 1 + MOD(iarea0,ini) 1190 ij = 1 + iarea0/ini 1191 IF( ldisoce(ii,ij) ) THEN 1192 icont = icont + 1 1193 kproc(ii,ij) = icont 1194 kipos(icont+1) = ii 1195 kjpos(icont+1) = ij 1196 ENDIF 1197 END DO 1198 ! if needed add some land subdomains to reach inij active subdomains 1199 i2add = inij - COUNT( ldisoce ) 1200 DO jarea = 1, ini*inj 1201 iarea0 = jarea - 1 1202 ii = 1 + MOD(iarea0,ini) 1203 ij = 1 + iarea0/ini 1204 IF( .NOT. ldisoce(ii,ij) .AND. i2add > 0 ) THEN 1205 icont = icont + 1 1206 kproc(ii,ij) = icont 1207 kipos(icont+1) = ii 1208 kjpos(icont+1) = ij 1209 i2add = i2add - 1 1210 ENDIF 1211 END DO 1212 ! 1213 END SUBROUTINE mpp_getnum 1182 1214 1183 1215
Note: See TracChangeset
for help on using the changeset viewer.
