Changeset 14072 for NEMO/trunk/src/OCE/LBC/mppini.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/mppini.F90
r14053 r14072 9 9 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 10 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add init_nfdcom 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication 12 12 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 13 13 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 … … 16 16 !!---------------------------------------------------------------------- 17 17 !! mpp_init : Lay out the global domain over processors with/without land processor elimination 18 !! init_ioipsl: IOIPSL initialization in mpp 18 !! init_ioipsl: IOIPSL initialization in mpp 19 19 !! init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging 20 !! init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 20 !! init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE bdy_oce ! open BounDarY 23 USE bdy_oce ! open BounDarY 24 24 ! 25 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 25 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 26 26 USE lib_mpp ! distribued memory computing library 27 USE iom ! nemo I/O library 27 USE iom ! nemo I/O library 28 28 USE ioipsl ! I/O IPSL library 29 29 USE in_out_manager ! I/O Manager … … 36 36 PUBLIC mpp_basesplit ! called by prtctl 37 37 PUBLIC mpp_is_ocean ! called by prtctl 38 38 39 39 INTEGER :: numbot = -1 ! 'bottom_level' local logical unit 40 40 INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit 41 41 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 44 !! $Id$ 44 !! $Id$ 45 45 !! Software governed by the CeCILL license (see ./LICENSE) 46 46 !!---------------------------------------------------------------------- … … 88 88 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 89 89 ! 90 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) 90 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) 91 91 ! 92 92 IF(lwp) THEN … … 94 94 WRITE(numout,*) 'mpp_init : NO massively parallel processing' 95 95 WRITE(numout,*) '~~~~~~~~ ' 96 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 96 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 97 97 WRITE(numout,*) ' npolj = ', npolj , ' njmpp = ', njmpp 98 98 ENDIF … … 114 114 !!---------------------------------------------------------------------- 115 115 !! *** ROUTINE mpp_init *** 116 !! 116 !! 117 117 !! ** Purpose : Lay out the global domain over processors. 118 118 !! If land processors are to be eliminated, this program requires the … … 128 128 !! 129 129 !! ** Action : - set domain parameters 130 !! nimpp : longitudinal index 130 !! nimpp : longitudinal index 131 131 !! njmpp : latitudinal index 132 132 !! narea : number for local area … … 148 148 INTEGER :: iiea, ijea, iiwe, ijwe ! - - 149 149 INTEGER :: iarea0 ! - - 150 INTEGER :: ierr, ios ! 150 INTEGER :: ierr, ios ! 151 151 INTEGER :: inbi, inbj, iimax, ijmax, icnt1, icnt2 152 152 LOGICAL :: llbest, llauto … … 162 162 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & 163 163 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 164 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 164 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 165 165 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 166 166 & cn_ice, nn_ice_dta, & … … 177 177 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist' ) 178 178 READ ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 179 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 179 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 180 180 ! 181 181 nn_hls = MAX(1, nn_hls) ! nn_hls must be > 0 … … 259 259 ENDIF 260 260 ENDIF 261 261 262 262 ! look for land mpi subdomains... 263 263 ALLOCATE( llisoce(jpni,jpnj) ) … … 333 333 CALL mpp_sum( 'mppini', ierr ) 334 334 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 335 335 336 336 #if defined key_agrif 337 337 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) … … 354 354 ! nfjpi (jn) = ijpi(ii,ij) 355 355 !END DO 356 nfproc(:) = ipproc(:,jpnj) 357 nfimpp(:) = iimppt(:,jpnj) 356 nfproc(:) = ipproc(:,jpnj) 357 nfimpp(:) = iimppt(:,jpnj) 358 358 nfjpi (:) = ijpi(:,jpnj) 359 359 ! … … 363 363 WRITE(numout,*) 364 364 WRITE(numout,*) ' defines mpp subdomains' 365 WRITE(numout,*) ' jpni = ', jpni 365 WRITE(numout,*) ' jpni = ', jpni 366 366 WRITE(numout,*) ' jpnj = ', jpnj 367 367 WRITE(numout,*) ' jpnij = ', jpnij … … 370 370 WRITE(numout,*) ' sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 371 371 ENDIF 372 372 373 373 ! 3. Subdomain description in the Regular Case 374 374 ! -------------------------------------------- 375 375 ! specific cases where there is no communication -> must do the periodicity by itself 376 ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2 376 ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2 377 377 l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 378 378 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 379 379 380 380 DO jarea = 1, jpni*jpnj 381 381 ! … … 450 450 ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057) 451 451 ! --> for northern neighbours of northern row processors (in case of north-fold) 452 ! need to reverse the LOGICAL direction of communication 452 ! need to reverse the LOGICAL direction of communication 453 453 idir = 1 ! we are indeed the s neigbour of this n neigbour 454 454 IF( ij == jpnj .AND. ijno == jpnj ) idir = -1 ! both are on the last row, we are in fact the n neigbour … … 478 478 ENDIF 479 479 END DO 480 480 481 481 ! 5. Subdomain print 482 482 ! ------------------ … … 504 504 9404 FORMAT(' * ' ,20(' ' ,i4,' * ') ) 505 505 ENDIF 506 506 507 507 ! just to save nono etc for all proc 508 508 ! warning ii*ij (zone) /= nproc (processors)! … … 511 511 ii_nono(:) = -1 512 512 ii_noea(:) = -1 513 ii_nowe(:) = -1 513 ii_nowe(:) = -1 514 514 DO jproc = 1, jpnij 515 515 ii = iin(jproc) … … 536 536 ENDIF 537 537 END DO 538 538 539 539 ! 6. Change processor name 540 540 ! ------------------------ … … 542 542 ij = ijn(narea) 543 543 ! 544 jpi = ijpi(ii,ij) 544 jpi = ijpi(ii,ij) 545 545 !!$ Nis0 = iis0(ii,ij) 546 546 !!$ Nie0 = iie0(ii,ij) 547 jpj = ijpj(ii,ij) 547 jpj = ijpj(ii,ij) 548 548 !!$ Njs0 = ijs0(ii,ij) 549 549 !!$ Nje0 = ije0(ii,ij) 550 550 nbondi = ibondi(ii,ij) 551 551 nbondj = ibondj(ii,ij) 552 nimpp = iimppt(ii,ij) 552 nimpp = iimppt(ii,ij) 553 553 njmpp = ijmppt(ii,ij) 554 554 jpk = jpkglo ! third dim … … 564 564 noses = -1 565 565 nosws = -1 566 566 567 567 noner = -1 568 568 nonwr = -1 … … 613 613 614 614 ! 615 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 615 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 616 616 ! 617 617 jpim1 = jpi-1 ! inner domain indices … … 630 630 ibonit(jproc) = ibondi(ii,ij) 631 631 ibonjt(jproc) = ibondj(ii,ij) 632 nimppt(jproc) = iimppt(ii,ij) 633 njmppt(jproc) = ijmppt(ii,ij) 632 nimppt(jproc) = iimppt(ii,ij) 633 njmppt(jproc) = ijmppt(ii,ij) 634 634 END DO 635 635 … … 647 647 & nis0all(jproc), njs0all(jproc), & 648 648 & nie0all(jproc), nje0all(jproc), & 649 & nimppt (jproc), njmppt (jproc), & 649 & nimppt (jproc), njmppt (jproc), & 650 650 & ii_nono(jproc), ii_noso(jproc), & 651 651 & ii_nowe(jproc), ii_noea(jproc), & 652 & ibonit (jproc), ibonjt (jproc) 652 & ibonit (jproc), ibonjt (jproc) 653 653 END DO 654 654 END IF … … 707 707 ! 708 708 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 709 ! 709 ! 710 710 IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN 711 711 CALL init_nfdcom ! northfold neighbour lists … … 719 719 ENDIF 720 720 ! 721 IF (llwrtlay) CLOSE(inum) 721 IF (llwrtlay) CLOSE(inum) 722 722 ! 723 723 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & … … 733 733 !!---------------------------------------------------------------------- 734 734 !! *** ROUTINE mpp_basesplit *** 735 !! 735 !! 736 736 !! ** Purpose : Lay out the global domain over processors. 737 737 !! … … 752 752 ! 753 753 INTEGER :: ji, jj 754 INTEGER :: i2hls 754 INTEGER :: i2hls 755 755 INTEGER :: iresti, irestj, irm, ijpjmin 756 756 !!---------------------------------------------------------------------- … … 759 759 #if defined key_nemocice_decomp 760 760 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 761 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 761 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 762 762 #else 763 763 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. … … 797 797 irm = knbj - irestj ! total number of lines to be removed 798 798 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 799 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 799 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 800 800 irestj = knbj - 1 - irm 801 801 klcj(:, irestj+1:knbj-1) = kjmax-1 … … 831 831 END DO 832 832 ENDIF 833 833 834 834 END SUBROUTINE mpp_basesplit 835 835 … … 890 890 ! get the list of knbi that gives a smaller jpimax than knbi-1 891 891 ! get the list of knbj that gives a smaller jpjmax than knbj-1 892 DO ji = 1, inbijmax 892 DO ji = 1, inbijmax 893 893 #if defined key_nemocice_decomp 894 894 iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls ! first dim. … … 958 958 ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions 959 959 ALLOCATE( indexok(isz1) ) ! to store indices of the best partitions 960 isz0 = 0 ! number of best partitions 960 isz0 = 0 ! number of best partitions 961 961 inbij = 1 ! start with the min value of inbij1 => 1 962 962 iszij = jpiglo*jpjglo+1 ! default: larger than global domain … … 1018 1018 CALL mppstop( ld_abort = .TRUE. ) 1019 1019 ENDIF 1020 1020 1021 1021 DEALLOCATE( iszi0, iszj0 ) 1022 1022 inbij = inbijmax + 1 ! default: larger than possible 1023 1023 ii = isz0+1 ! start from the end of the list (smaller subdomains) 1024 1024 DO WHILE( inbij > knbij ) ! while the number of ocean subdomains exceed the number of procs 1025 ii = ii -1 1025 ii = ii -1 1026 1026 ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 1027 1027 CALL mpp_is_ocean( llisoce ) ! must be done by all core … … 1035 1035 ! 1036 1036 END SUBROUTINE bestpartition 1037 1038 1037 1038 1039 1039 SUBROUTINE mpp_init_landprop( propland ) 1040 1040 !!---------------------------------------------------------------------- … … 1059 1059 ENDIF 1060 1060 1061 ! number of processes reading the bathymetry file 1061 ! number of processes reading the bathymetry file 1062 1062 iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) ) ! read a least 2 lines, no more that 100 processes reading at the same time 1063 1063 1064 1064 ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 1065 1065 IF( iproc == 1 ) THEN ; idiv = mppsize … … 1084 1084 CALL mpp_sum( 'mppini', inboce ) ! total number of ocean points over the global domain 1085 1085 ! 1086 propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 1086 propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 1087 1087 ! 1088 1088 END SUBROUTINE mpp_init_landprop 1089 1090 1089 1090 1091 1091 SUBROUTINE mpp_is_ocean( ldisoce ) 1092 1092 !!---------------------------------------------------------------------- … … 1104 1104 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1105 1105 !!---------------------------------------------------------------------- 1106 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1106 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point 1107 1107 ! 1108 1108 INTEGER :: idiv, iimax, ijmax, iarea … … 1113 1113 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1114 1114 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1115 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1115 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1116 1116 !!---------------------------------------------------------------------- 1117 1117 ! do nothing if there is no land-sea mask … … 1146 1146 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1147 1147 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 1148 ! 1148 ! 1149 1149 IF( iarea == 1 ) THEN ! the first line was not read 1150 1150 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity … … 1157 1157 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1158 1158 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 1159 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1159 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point 1160 1160 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) 1161 1161 DO ji = 3,inx-1 … … 1191 1191 ENDIF 1192 1192 END DO 1193 1193 1194 1194 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1195 1195 CALL mpp_sum( 'mppini', inboce_1d ) … … 1199 1199 ! 1200 1200 END SUBROUTINE mpp_is_ocean 1201 1202 1201 1202 1203 1203 SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 1204 1204 !!---------------------------------------------------------------------- … … 1213 1213 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading 1214 1214 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read 1215 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1215 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1216 1216 ! 1217 1217 INTEGER :: inumsave ! local logical unit 1218 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1218 REAL(wp), DIMENSION(Ni0glo,kjcnt) :: zbot, zbdy 1219 1219 !!---------------------------------------------------------------------- 1220 1220 ! 1221 1221 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1222 1222 ! 1223 IF( numbot /= -1 ) THEN 1223 IF( numbot /= -1 ) THEN 1224 1224 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1225 1225 ELSE … … 1227 1227 ENDIF 1228 1228 ! 1229 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1229 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1230 1230 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 1231 1231 zbot(:,:) = zbot(:,:) * zbdy(:,:) … … 1295 1295 !! *** ROUTINE init_ioipsl *** 1296 1296 !! 1297 !! ** Purpose : 1298 !! 1299 !! ** Method : 1297 !! ** Purpose : 1298 !! 1299 !! ** Method : 1300 1300 !! 1301 1301 !! History : 1302 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1302 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1303 1303 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 1304 1304 !!---------------------------------------------------------------------- … … 1328 1328 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 1329 1329 ! 1330 END SUBROUTINE init_ioipsl 1330 END SUBROUTINE init_ioipsl 1331 1331 1332 1332 … … 1334 1334 !!---------------------------------------------------------------------- 1335 1335 !! *** ROUTINE init_nfdcom *** 1336 !! ** Purpose : Setup for north fold exchanges with explicit 1336 !! ** Purpose : Setup for north fold exchanges with explicit 1337 1337 !! point-to-point messaging 1338 1338 !! … … 1340 1340 !!---------------------------------------------------------------------- 1341 1341 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 1342 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1342 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1343 1343 !!---------------------------------------------------------------------- 1344 1344 INTEGER :: sxM, dxM, sxT, dxT, jn … … 1392 1392 ! 1393 1393 Nis0 = 1+nn_hls ; Nis1 = Nis0-1 ; Nis2 = MAX( 1, Nis0-2) 1394 Njs0 = 1+nn_hls ; Njs1 = Njs0-1 ; Njs2 = MAX( 1, Njs0-2) 1395 ! 1394 Njs0 = 1+nn_hls ; Njs1 = Njs0-1 ; Njs2 = MAX( 1, Njs0-2) 1395 ! 1396 1396 Nie0 = jpi-nn_hls ; Nie1 = Nie0+1 ; Nie2 = MIN(jpi, Nie0+2) 1397 1397 Nje0 = jpj-nn_hls ; Nje1 = Nje0+1 ; Nje2 = MIN(jpj, Nje0+2) … … 1402 1402 Nie1nxt2 = Nie0 ; Nje1nxt2 = Nje0 1403 1403 ! 1404 ELSE !* larger halo size... 1404 ELSE !* larger halo size... 1405 1405 ! 1406 1406 Nis1nxt2 = Nis1 ; Njs1nxt2 = Njs1 … … 1417 1417 ! 1418 1418 END SUBROUTINE init_doloop 1419 1419 1420 1420 !!====================================================================== 1421 1421 END MODULE mppini
Note: See TracChangeset
for help on using the changeset viewer.