- Timestamp:
- 2013-03-26T11:45:16+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/partition_mod.F90
r3837 r3849 1 1 MODULE partition_mod 2 USE par_oce, ONLY: jpni, jpnj, jp i, jpj, jpim1, jpjm1, jpij, &2 USE par_oce, ONLY: jpni, jpnj, jpnij, jpi, jpj, jpim1, jpjm1, jpij, & 3 3 jpreci, jprecj, jpk, jpkm1, jperio, jpiglo, jpjglo 4 4 USE dom_oce, ONLY: ln_zco, nbondi, nbondj, nidom, npolj, & … … 18 18 USE lib_mpp, ONLY: mppsize, mppsync, mpi_comm_opa, & 19 19 MAX_FACTORS, xfactors, yfactors, nn_pttrim, & 20 nn_cpnode 20 nn_cpnode, nn_readpart 21 21 #endif 22 22 USE lib_mpp, ONLY: ctl_stop, ctl_warn … … 34 34 ! (1 for ocean, 0 for land) 35 35 ! set in nemogcm.F90 36 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:), TARGET :: ibotlevel ! Holds the bottom level of the ocean at each grid point - used for trimming halos in z direction 36 ! Holds the bottom level of the ocean at each grid point - used for 37 ! trimming halos in z direction 38 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:,:), TARGET :: ibotlevel 37 39 38 40 ! Parameters for the cost function used when evaluating different … … 75 77 PUBLIC imask, ibotlevel, smooth_global_bathy, global_bot_level, partition_mask_alloc 76 78 PUBLIC mpp_init3, partition_rk, partition_mca_rk, write_partition_map 79 PUBLIC read_partition, write_partition 77 80 78 81 CONTAINS … … 292 295 CALL mpp_init_ioipsl() 293 296 297 ! Write this partition to file in the format that the code can 298 ! read 299 CALL write_partition() 300 294 301 ! ARPDBG - test comms setup 295 302 CALL mpp_test_comms(imask, ibotlevel) … … 396 403 #if defined key_mpp_mpi 397 404 398 ! IMPORTANT: Set the number of PEs to partition over (mapcomm_mod399 ! module variable)400 nprocp = mppsize401 402 405 #if defined PARTIT_DEBUG 403 406 IF(lwp)WRITE(*,*) 'ARPDBG partition_rk: jpn{i,j} = ',jpni,jpnj … … 478 481 ! set that here 479 482 myinst = narea - 1 480 481 ! IMPORTANT: set the number of PEs to partition over (mapcomm_mod482 ! module variable)483 nprocp = mppsize484 483 485 484 ! Factorise the total number of MPI processes that we have … … 682 681 jpni = nprocx 683 682 jpnj = nprocy 683 jpnij = jpni*jpnj 684 684 685 685 IF (lwp) THEN … … 1388 1388 1389 1389 1390 SUBROUTINE finish_partition( )1391 USE mapcomm_mod, ONLY: ielb,ieub,pielb,pjelb,pieub,pjeub, &1392 iesub,jesub,jeub,ilbext,iubext,jubext, &1390 SUBROUTINE finish_partition(fromFile) 1391 USE mapcomm_mod, ONLY: ielb,ieub,pielb,pjelb,pieub,pjeub, & 1392 iesub,jesub,jeub,ilbext,iubext,jubext, & 1393 1393 jlbext,pnactive,piesub,pjesub,jelb,pilbext, & 1394 piubext, pjlbext, pjubext, &1394 piubext, pjlbext, pjubext, & 1395 1395 trimmed, nidx,eidx,sidx,widx 1396 1396 IMPLICIT NONE 1397 LOGICAL, INTENT(in), OPTIONAL :: fromFile 1398 ! Locals 1397 1399 INTEGER :: iproc, ierr 1398 1399 ! Set the external boundary flags before boundaries are 1400 ! altered by the trimming process and it becomes more difficult 1401 ! to recognize which were the external boundaries. 1400 LOGICAL :: lFromFile 1401 1402 ! Check to see whether we're dealing with a partion that has been 1403 ! read from file. If we are then there are some things we don't 1404 ! calculate here. 1405 lFromFile = .FALSE. 1406 IF( PRESENT(fromFile) ) lFromFile = fromFile 1407 1408 IF(.NOT. lFromFile)THEN 1409 ! Set the external boundary flags before boundaries are 1410 ! altered by the trimming process and it becomes more difficult 1411 ! to recognize which were the external boundaries. 1402 1412 1403 DO iproc=1, nprocp, 11404 pilbext(iproc) = pielb(iproc).EQ.11405 piubext(iproc) = pieub(iproc).EQ.jpiglo1406 pjlbext(iproc) = pjelb(iproc).EQ.11407 pjubext(iproc) = pjeub(iproc).EQ.jpjglo1408 ENDDO1409 1410 ! Trim off redundant rows and columns containing all land.1411 IF(.NOT. ALLOCATED(trimmed) )THEN1412 ALLOCATE(trimmed(4,nprocp), Stat=ierr)1413 IF(ierr /= 0)THEN1414 CALL ctl_stop('STOP', &1415 'Failed to allocate memory for domain trimming')1416 END IF1417 END IF1413 DO iproc=1, nprocp, 1 1414 pilbext(iproc) = pielb(iproc).EQ.1 1415 piubext(iproc) = pieub(iproc).EQ.jpiglo 1416 pjlbext(iproc) = pjelb(iproc).EQ.1 1417 pjubext(iproc) = pjeub(iproc).EQ.jpjglo 1418 ENDDO 1419 1420 ! Trim off redundant rows and columns containing all land. 1421 IF(.NOT. ALLOCATED(trimmed) )THEN 1422 ALLOCATE(trimmed(4,nprocp), Stat=ierr) 1423 IF(ierr /= 0)THEN 1424 CALL ctl_stop('STOP', & 1425 'Failed to allocate memory for domain trimming') 1426 END IF 1427 END IF 1418 1428 1419 1429 #if defined key_mpp_mpi … … 1430 1440 ENDIF 1431 1441 #else 1432 trimmed(1:4,1:nprocp) = .FALSE. 1433 #endif 1434 1435 ! Lower boundary (long.) of sub-domain, GLOBAL coords 1436 ! before correction for global halos 1437 nimpp = pielb(narea) 1438 1439 ! Is the domain on an external LONGITUDE boundary? 1440 nbondi = 0 1441 ilbext = pilbext(narea) 1442 IF(ilbext)THEN 1443 nbondi = -1 1444 END IF 1445 1446 IF( (.NOT. ilbext) .OR. (ilbext .AND. trimmed(widx,narea)) )THEN 1447 ! It isn't, which means we must shift its lower boundary by 1448 ! -jpreci to allow for the overlap of this domain with its 1449 ! westerly neighbour. 1450 nimpp = nimpp - jpreci 1451 END IF 1452 1453 iubext = piubext(narea) 1454 IF(iubext)THEN 1455 nbondi = 1 1456 IF(ilbext)nbondi = 2 ! Both East and West boundaries are at 1457 ! edges of global domain 1458 END IF 1459 1460 ! Set local values for limits in global coords of the sub-domain 1461 ! owned by this process. 1462 ielb = pielb (narea) 1463 ieub = pieub (narea) 1464 iesub = piesub(narea) 1465 1466 jpi = iesub + 2*jpreci ! jpi is the same for all domains - this is 1467 ! what original decomposition did 1468 nlci = jpi 1469 1470 ! If the domain is at the edge of the model domain and a cyclic 1471 ! East-West b.c. is in effect then it already incorporates one 1472 ! extra halo column (because of the way the model domain itself is 1473 ! set-up). If we've trimmed-off dry rows and columns then, even if 1474 ! a domain is on the model boundary, it may still need a halo so 1475 ! we add one. 1476 IF( nbondi == -1 .AND. (.NOT. trimmed(widx,narea)) )THEN 1442 trimmed(1:4,1:nprocp) = .FALSE. 1443 #endif 1444 END IF ! not read from file 1445 1446 ! Lower boundary (long.) of sub-domain, GLOBAL coords 1447 ! before correction for global halos 1448 nimpp = pielb(narea) 1449 1450 ! Is the domain on an external LONGITUDE boundary? 1451 nbondi = 0 1452 ilbext = pilbext(narea) 1453 IF(ilbext)THEN 1454 nbondi = -1 1455 END IF 1456 1457 IF( (.NOT. ilbext) .OR. (ilbext .AND. trimmed(widx,narea)) )THEN 1458 ! It isn't, which means we must shift its lower boundary by 1459 ! -jpreci to allow for the overlap of this domain with its 1460 ! westerly neighbour. 1461 nimpp = nimpp - jpreci 1462 END IF 1463 1464 iubext = piubext(narea) 1465 IF(iubext)THEN 1466 nbondi = 1 1467 IF(ilbext)nbondi = 2 ! Both East and West boundaries are at 1468 ! edges of global domain 1469 END IF 1470 1471 ! Set local values for limits in global coords of the sub-domain 1472 ! owned by this process. 1473 ielb = pielb (narea) 1474 ieub = pieub (narea) 1475 iesub = piesub(narea) 1476 1477 jpi = iesub + 2*jpreci ! jpi is the same for all domains - this is 1478 ! what original decomposition did 1479 nlci = jpi 1480 1481 ! If the domain is at the edge of the model domain and a cyclic 1482 ! East-West b.c. is in effect then it already incorporates one 1483 ! extra halo column (because of the way the model domain itself is 1484 ! set-up). If we've trimmed-off dry rows and columns then, even if 1485 ! a domain is on the model boundary, it may still need a halo so 1486 ! we add one. 1487 IF( nbondi == -1 .AND. (.NOT. trimmed(widx,narea)) )THEN 1477 1488 ! Western boundary 1478 1489 ! First column of global domain is actually a halo but NEMO … … 1547 1558 nlcj = jpj 1548 1559 1549 ! Unlike the East-West boundaries, the global domain does not include1550 ! halo (rows) at the Northern and Southern edges. In fact, there is no1551 ! cyclic boundary condition in the North-South direction so there are no1552 ! halos at all at the edges of the global domain.1560 ! Unlike the East-West boundaries, the global domain does not include 1561 ! halo (rows) at the Northern and Southern edges. In fact, there is no 1562 ! cyclic boundary condition in the North-South direction so there are no 1563 ! halos at all at the edges of the global domain. 1553 1564 IF( nbondj == -1 .AND. (.NOT. trimmed(sidx,narea)) )THEN 1554 1565 ! Southern edge … … 2772 2783 END SUBROUTINE global_bot_level 2773 2784 2785 2786 SUBROUTINE read_partition(ierr) 2787 USE par_oce, ONLY: jpni, jpnj, jpnij 2788 USE mapcomm_mod, ONLY: eidx, widx, sidx, nidx, trimmed, & 2789 pilbext, piubext, pjlbext, pjubext 2790 IMPLICIT none 2791 INTEGER, INTENT(out) :: ierr 2792 ! Locals 2793 INTEGER, PARAMETER :: funit = 1099 2794 INTEGER :: idom, ndom 2795 CHARACTER(len=200) :: linein 2796 !====================================================================== 2797 2798 ierr = 0 2799 2800 OPEN(UNIT=funit, file='partition.dat', status='OLD', & 2801 ACTION='READ', IOSTAT=ierr) 2802 IF(ierr /= 0)THEN 2803 CALL ctl_warn('read_partition: failed to read partitioning from file - will calculate it instead.') 2804 RETURN 2805 END IF 2806 2807 ! Number of procs in x and y 2808 CALL read_next_line(funit, linein, ierr) 2809 READ(linein,FMT=*) jpni, jpnj 2810 2811 ! Store their product 2812 jpnij = jpni*jpnj 2813 2814 ! Check that the implied number of PEs matches that 2815 ! in our MPI world 2816 ndom = jpni*jpnj 2817 IF(ndom /= mppsize)THEN 2818 CALL ctl_stop('STOP', & 2819 'read_partition: no. of PEs specified in partition.dat does not match no. of PEs in use by this job.') 2820 END IF 2821 2822 ! Read the description of each sub-domain 2823 domains: DO idom = 1, ndom, 1 2824 2825 ! Coordinates of bottom-left (SW) corner of domain 2826 CALL read_next_line(funit, linein, ierr) 2827 READ(linein,FMT=*) pielb(idom), pjelb(idom) 2828 ! Top-right (NE) corner 2829 CALL read_next_line(funit, linein, ierr) 2830 READ(linein,FMT=*) pieub(idom), pjeub(idom) 2831 ! Whether this domain has external boundaries and has been trimmed 2832 CALL read_next_line(funit, linein, ierr) 2833 READ(linein,FMT=*) pilbext(idom), trimmed(widx,idom) 2834 CALL read_next_line(funit, linein, ierr) 2835 READ(linein,FMT=*) piubext(idom), trimmed(eidx,idom) 2836 CALL read_next_line(funit, linein, ierr) 2837 READ(linein,FMT=*) pjlbext(idom), trimmed(sidx,idom) 2838 CALL read_next_line(funit, linein, ierr) 2839 READ(linein,FMT=*) pjubext(idom), trimmed(nidx,idom) 2840 2841 piesub(idom) = pieub(idom) - pielb(idom) + 1 2842 pjesub(idom) = pjeub(idom) - pjelb(idom) + 1 2843 2844 END DO domains 2845 2846 ! All done - close the file 2847 CLOSE(UNIT=funit) 2848 2849 CALL finish_partition(fromFile=.TRUE.) 2850 2851 END SUBROUTINE read_partition 2852 2853 !=================================================================== 2854 2855 SUBROUTINE write_partition 2856 USE par_oce, ONLY: jpni, jpnj 2857 USE mapcomm_mod, ONLY: eidx, widx, sidx, nidx, trimmed, & 2858 pjubext, pjlbext, piubext, pilbext, & 2859 pielb, pieub, pjelb, pjeub 2860 IMPLICIT none 2861 INTEGER, PARAMETER :: funit = 1099 2862 INTEGER :: ierr 2863 INTEGER :: idom 2864 2865 ! Only PE 0 (narea==1) writes this file 2866 IF(narea /= 1) RETURN 2867 2868 OPEN(UNIT=funit, file='partition.dat.new', status='REPLACE', & 2869 ACTION='WRITE', IOSTAT=ierr) 2870 IF(ierr /= 0)THEN 2871 CALL ctl_warn('write_partition: failed to write partition description to file.') 2872 RETURN 2873 END IF 2874 WRITE(UNIT=funit,FMT="('# jpni jpnj')") 2875 WRITE(UNIT=funit,FMT="(I5,1x,I5)") jpni, jpnj 2876 2877 DO idom = 1, mppsize, 1 2878 WRITE(UNIT=funit,FMT="('# Domain: ',I5)") idom 2879 IF(idom==1)WRITE(UNIT=funit,FMT="('# Lower bounds: x y')") 2880 WRITE(UNIT=funit,FMT="(I5,1x,I5)") pielb(idom), pjelb(idom) 2881 IF(idom==1)WRITE(UNIT=funit,FMT="('# Upper bounds: x y')") 2882 WRITE(UNIT=funit,FMT="(I5,1x,I5)") pieub(idom), pjeub(idom) 2883 IF(idom==1)WRITE(UNIT=funit,FMT="('# x: Lower bound external, trimmed')") 2884 WRITE(UNIT=funit,FMT="(L5,1x,L5)") pilbext(idom), trimmed(widx,idom) 2885 IF(idom==1)WRITE(UNIT=funit,FMT="('# x: Upper bound external, trimmed')") 2886 WRITE(UNIT=funit,FMT="(L5,1x,L5)") piubext(idom), trimmed(eidx,idom) 2887 IF(idom==1)WRITE(UNIT=funit,FMT="('# y: Lower bound external, trimmed')") 2888 WRITE(UNIT=funit,FMT="(L5,1x,L5)") pjlbext(idom), trimmed(sidx,idom) 2889 IF(idom==1)WRITE(UNIT=funit,FMT="('# y: Upper bound external, trimmed')") 2890 WRITE(UNIT=funit,FMT="(L5,1x,L5)") pjubext(idom), trimmed(nidx,idom) 2891 END DO 2892 2893 CLOSE(UNIT=funit) 2894 2895 END SUBROUTINE write_partition 2896 2897 SUBROUTINE read_next_line(funit, linein, ierr) 2898 IMPLICIT none 2899 !!------------------------------------------------------------------ 2900 INTEGER, INTENT( in) :: funit ! Unit no. to read 2901 CHARACTER(len=200), INTENT(out) :: linein ! String containing next 2902 ! non-comment line in file 2903 INTEGER, INTENT(out) :: ierr ! Error flag (0==OK) 2904 !!------------------------------------------------------------------ 2905 2906 ierr = 0 2907 2908 READ(UNIT=funit,FMT="(200A)") linein 2909 2910 ! Comment lines begin with '#'. Skip those plus any blank 2911 ! lines... 2912 DO WHILE( INDEX( TRIM(ADJUSTL(linein)),'#') /= 0 .OR. & 2913 LEN_TRIM(linein) == 0 ) 2914 READ(UNIT=funit,FMT="(200A)") linein 2915 END DO 2916 2917 WRITE(*,*)'returning linein >>'//linein//'<<' 2918 2919 END SUBROUTINE read_next_line 2920 2774 2921 END MODULE partition_mod
Note: See TracChangeset
for help on using the changeset viewer.
