New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3849 – NEMO

Changeset 3849


Ignore:
Timestamp:
2013-03-26T11:45:16+01:00 (11 years ago)
Author:
trackstand2
Message:

Merge branch 'partitioner'

Location:
branches/2011/DEV_r2739_STFC_dCSE
Files:
6 added
11 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/.gitignore

    r3432 r3849  
    66*.err 
    77*.out 
     8*.o 
     9*.exe 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/ARCH/arch-gfortran_linux.fcm

    r2315 r3849  
    1515 
    1616 
    17 %NCDF_INC            -I/usr/local/netcdf/include 
    18 %NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf 
     17%NCDF_INC            -I/home/kbc59144/MyInstalls/include 
     18%NCDF_LIB            -L/home/kbc59144/MyInstalls/lib -lnetcdf -lnetcdff 
    1919%FC                gfortran 
    20 %FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer  
     20#%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer  
     21%FCFLAGS             -O0 -g -Wall -Warray-bounds -fbacktrace -fbounds-check -fcheck=all 
    2122%FFLAGS              %FCFLAGS 
    2223%LD                  gfortran 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/ARCH/arch-gfortran_mpi_linux.fcm

    r3837 r3849  
    1515 
    1616 
    17 %NCDF_INC            -I/usr/local/netcdf/include 
    18 %NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf 
    19 %FC                gfortran 
     17%NCDF_INC            -I/home/kbc59144/MyInstalls/include 
     18%NCDF_LIB            -L/home/kbc59144/MyInstalls/lib -lnetcdf -lnetcdff 
     19%FC                mpif90 
    2020%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer  
    2121%FFLAGS              %FCFLAGS 
    22 %LD                  gfortran 
     22%LD                  mpif90 
    2323%LDFLAGS 
    2424%FPPFLAGS            -P -C -traditional 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm

    r2670 r3849  
    1  bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_zdftmx key_iomput  
     1 bld::tool::fppkeys key_trabbl  key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_zdftmx   key_mpp_mpi     key_mpp_rkpart 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r3211 r3849  
    541541         WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean 
    542542#if defined key_z_first 
    543          ELSE WHERE                     ;   btm30(:,:) = tmask_1(:,:) 
     543         ELSEWHERE                     ;   btm30(:,:) = tmask_1(:,:) 
    544544#else 
    545          ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1) 
     545         ELSEWHERE                     ;   btm30(:,:) = tmask(:,:,1) 
    546546#endif 
    547547         END WHERE 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3837 r3849  
    157157   INTEGER, SAVE, PUBLIC                 :: nn_cpnode = 4 ! Number of cores per  
    158158                                                          ! compute node on current computer 
    159   
     159   LOGICAL, SAVE, PUBLIC                 :: nn_readpart = .FALSE. ! Whether to read partition from 
     160                                                            ! file (1) or not (0) 
    160161   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
    161162 
     
    263264      ! 
    264265      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, & 
    265                        nn_xfactors, nn_yfactors, nn_pttrim, nn_cpnode 
     266                       nn_readpart, nn_xfactors, nn_yfactors,     & 
     267                       nn_pttrim, nn_cpnode 
    266268      !!---------------------------------------------------------------------- 
    267269      ! 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mapcomm_mod.F90

    r3837 r3849  
    156156 
    157157  ! Public routines 
    158   PUBLIC :: mapcomms, iprocmap 
     158  PUBLIC :: mapcomms, iprocmap, set_num_subdomains 
    159159 
    160160  ! Public variables 
     
    165165  PUBLIC :: nsendp,nsendp2d,nrecvp,nrecvp2d,npatchsend,npatchrecv, & 
    166166            nxsendp,nysendp,nzsendp,nxrecvp,nyrecvp,nzrecvp,       & 
    167             idesrecvp,jdesrecvp,isrcsendp,jsrcsendp 
     167            idesrecvp,jdesrecvp,isrcsendp,jsrcsendp, nprocp 
    168168 
    169169  PUBLIC :: ielb,  ieub,  pielb, pjelb, pieub, pjeub,                    & 
    170170            iesub, jesub, jeub, ilbext, iubext, jubext, jlbext, pnactive,& 
    171             piesub, pjesub, jelb, pilbext, pjlbext, pjubext, piubext,    & 
    172             nprocp 
     171            piesub, pjesub, jelb, pilbext, pjlbext, pjubext, piubext 
    173172 
    174173  PUBLIC :: NONE         & 
     
    191190 
    192191  ! Switch for trimming points below ocean floor from halo swaps 
    193   !LOGICAL, PARAMETER :: msgtrim_z = .TRUE. ! .FALSE. 
    194   LOGICAL, PUBLIC, SAVE      :: msgtrim_z 
     192  ! Defaults to true unless set via NEMO_MSGTRIM_Z environment var. 
     193  LOGICAL, PUBLIC, SAVE :: msgtrim_z 
    195194 
    196195CONTAINS 
     196 
     197  SUBROUTINE set_num_subdomains(npes) 
     198    IMPLICIT none 
     199    !!------------------------------------------------------------------ 
     200    !! Set the number of subdomains to partition the domain into. 
     201    !!------------------------------------------------------------------ 
     202    INTEGER, INTENT(in) :: npes 
     203 
     204    nprocp = npes 
     205 
     206  END SUBROUTINE set_num_subdomains 
     207 
    197208 
    198209  SUBROUTINE mapcomms ( depth, ibotlvl, nx, ny, jperio, ierr ) 
     
    213224 
    214225    ! Local variables. 
    215     INTEGER :: i, i1, i2, icol, ihalo, iproc, iprocc, iprocx, & 
    216                iprocy, j, j1, j2, lumapout, nadd, naddmaxr, naddmaxs 
     226    INTEGER :: i, i1, i2, ihalo, iproc, iprocc, iprocx, & 
     227               iprocy, j, j1, j2, nadd, naddmaxr, naddmaxs 
    217228    INTEGER :: ldiff0, ldiff1 ! Local vars for coping with wrapping of coords 
    218229    INTEGER :: imax, imin ! Max/min value of i that a halo strip can run  
     
    13021313        IF ( addcorner ) THEN 
    13031314#if defined ARPDEBUG 
    1304           WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I2,', dir = ',I1)") & 
     1315          WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I4,', dir = ',I1)") & 
    13051316                 narea-1, procid(iprocc),i 
    13061317#endif 
     
    13141325 
    13151326#if defined ARPDEBUG 
    1316           WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I3,', old dir = ',I1,' new dir = ',I1)") & 
     1327          WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I4,', old dir = ',I1,' new dir = ',I1)") & 
    13171328                 narea-1, procid(iprocc),i, j 
    13181329#endif 
     
    13801391! ARP - for debugging only 
    13811392!!$        IF(iprocmap == 0)THEN 
    1382 !!$           WRITE(*,"('iprocmap: failed to find owner PE for (',I3,I3,')')") ia, ja 
     1393!!$           WRITE(*,"('iprocmap: failed to find owner PE for (',I3,1x,I3,')')") ia, ja 
    13831394!!$           WRITE(*,*) 'PE domains are [xmin:xmax][ymin:ymax]:' 
    13841395!!$           DO iproc=1,nprocp,1 
     
    18261837 
    18271838        ! Can any points along the left (low i) edge be trimmed? 
    1828         left_edge: DO i=ilo, ihi - nextra 
     1839        left_edge: DO i=ilo, ihi 
    18291840          DO j=jlo, jhi 
    18301841             ! depth is global mask, i and j are local coords 
     
    18561867 
    18571868        ! Can any points along the right (high i) edge be trimmed? 
    1858         right_edge: DO i=ihi, ilo + nextra, -1 
     1869        right_edge: DO i=ihi, ilo, -1 
    18591870          DO j=jlo, jhi 
    18601871!            IF (depth(i+nimpp-1-nextra,j+njmpp-1) .ne. land) exit right_edge 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/partition_mod.F90

    r3837 r3849  
    11MODULE partition_mod 
    2    USE par_oce, ONLY: jpni, jpnj, jpi, jpj, jpim1, jpjm1, jpij, & 
     2   USE par_oce, ONLY: jpni, jpnj, jpnij, jpi, jpj, jpim1, jpjm1, jpij, & 
    33                      jpreci, jprecj, jpk, jpkm1, jperio, jpiglo, jpjglo 
    44   USE dom_oce, ONLY: ln_zco, nbondi, nbondj, nidom, npolj, & 
     
    1818   USE lib_mpp,        ONLY: mppsize, mppsync, mpi_comm_opa,                & 
    1919                             MAX_FACTORS, xfactors, yfactors, nn_pttrim,    & 
    20                              nn_cpnode 
     20                             nn_cpnode, nn_readpart 
    2121#endif 
    2222   USE lib_mpp,        ONLY: ctl_stop, ctl_warn 
     
    3434                                                 ! (1 for ocean, 0 for land) 
    3535                                                 ! 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  
    3739 
    3840   ! Parameters for the cost function used when evaluating different  
     
    7577   PUBLIC imask, ibotlevel, smooth_global_bathy, global_bot_level, partition_mask_alloc 
    7678   PUBLIC mpp_init3, partition_rk, partition_mca_rk, write_partition_map 
     79   PUBLIC read_partition, write_partition 
    7780 
    7881CONTAINS 
     
    292295      CALL mpp_init_ioipsl() 
    293296 
     297      ! Write this partition to file in the format that the code can 
     298      ! read 
     299      CALL write_partition() 
     300 
    294301      ! ARPDBG - test comms setup 
    295302      CALL mpp_test_comms(imask, ibotlevel) 
     
    396403#if defined key_mpp_mpi 
    397404 
    398       ! IMPORTANT: Set the number of PEs to partition over (mapcomm_mod  
    399       ! module variable) 
    400       nprocp = mppsize 
    401  
    402405#if defined PARTIT_DEBUG 
    403406      IF(lwp)WRITE(*,*) 'ARPDBG partition_rk: jpn{i,j} = ',jpni,jpnj 
     
    478481       ! set that here 
    479482       myinst = narea - 1 
    480  
    481        ! IMPORTANT: set the number of PEs to partition over (mapcomm_mod  
    482        ! module variable) 
    483        nprocp = mppsize 
    484483 
    485484       ! Factorise the total number of MPI processes that we have 
     
    682681      jpni = nprocx 
    683682      jpnj = nprocy 
     683      jpnij = jpni*jpnj 
    684684 
    685685      IF (lwp) THEN 
     
    13881388 
    13891389 
    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,      & 
    13931393                             jlbext,pnactive,piesub,pjesub,jelb,pilbext, & 
    1394                              piubext, pjlbext, pjubext, & 
     1394                             piubext, pjlbext, pjubext,                  & 
    13951395                             trimmed, nidx,eidx,sidx,widx 
    13961396      IMPLICIT NONE 
     1397      LOGICAL, INTENT(in), OPTIONAL :: fromFile 
     1398      ! Locals 
    13971399      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. 
    14021412       
    1403       DO iproc=1, nprocp, 1 
    1404            pilbext(iproc) = pielb(iproc).EQ.1 
    1405            piubext(iproc) = pieub(iproc).EQ.jpiglo 
    1406            pjlbext(iproc) = pjelb(iproc).EQ.1 
    1407            pjubext(iproc) = pjeub(iproc).EQ.jpjglo 
    1408         ENDDO 
    1409  
    1410       ! Trim off redundant rows and columns containing all land. 
    1411         IF(.NOT. ALLOCATED(trimmed) )THEN 
    1412            ALLOCATE(trimmed(4,nprocp), Stat=ierr) 
    1413            IF(ierr /= 0)THEN 
    1414               CALL ctl_stop('STOP',    & 
    1415                             'Failed to allocate memory for domain trimming') 
    1416            END IF 
    1417         END IF 
     1413         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 
    14181428 
    14191429#if defined key_mpp_mpi 
     
    14301440        ENDIF 
    14311441#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 
    14771488           ! Western boundary 
    14781489           ! First column of global domain is actually a halo but NEMO 
     
    15471558        nlcj = jpj 
    15481559 
    1549 ! Unlike the East-West boundaries, the global domain does not include 
    1550 ! halo (rows) at the Northern and Southern edges. In fact, there is no 
    1551 ! cyclic boundary condition in the North-South direction so there are no 
    1552 ! 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. 
    15531564      IF( nbondj == -1 .AND. (.NOT. trimmed(sidx,narea)) )THEN 
    15541565         ! Southern edge 
     
    27722783    END SUBROUTINE global_bot_level 
    27732784 
     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 
    27742921END MODULE partition_mod 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r3211 r3849  
    114114      WHERE(z_mdt(:,:) /= zfill)   ;   mdtmask(:,:) = tmask(:,:,1) 
    115115#endif 
    116       ELSE WHERE                   ;   mdtmask(:,:) = 0 
     116      ELSEWHERE                   ;   mdtmask(:,:) = 0 
    117117      END WHERE 
    118118 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r2715 r3849  
    105105      ! ice free of snow and melts 
    106106      WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalbfz(:,:,:) = rn_albice 
    107       ELSE WHERE                                              ;   zalbfz(:,:,:) = rn_alphdi 
     107      ELSEWHERE                                              ;   zalbfz(:,:,:) = rn_alphdi 
    108108      END  WHERE 
    109109 
    110110      WHERE     ( 1.5  < ph_ice                     )  ;  zficeth = zalbfz 
    111       ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 ) 
    112       ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              & 
     111      ELSEWHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 ) 
     112      ELSEWHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              & 
    113113         &                                                                 - 0.8608 * ph_ice * ph_ice     & 
    114114         &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice 
    115       ELSE WHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice 
     115      ELSEWHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice 
    116116      END WHERE 
    117117 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r3432 r3849  
    14331433      ! 
    14341434      INTEGER ::   jit, jk   ! dummy loop indices 
    1435       INTEGER ::   id1, id2, id3, id4, id5, id6, id7, id8 
     1435      INTEGER ::   id1, id2, id3, id4, id5, id6 
    14361436      INTEGER ::   ji, jj, ikbu, ikbv 
    14371437      REAL(wp)::   cbx, cby 
     
    14481448            id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 
    14491449            ! 
    1450             IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN        ! all required arrays exist 
     1450            IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist 
    14511451               CALL iom_get( numror, jpdom_autoglo, 'en'    , en     ) 
    14521452               CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt    ) 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3837 r3849  
    601601      USE iom,            ONLY: jpiglo, jpjglo, wp, jpdom_unknown, & 
    602602                                iom_open, iom_get, iom_close 
    603       USE mapcomm_mod, ONLY: ielb, ieub, pielb, pjelb, pieub, pjeub, & 
    604                              iesub, jesub, jeub, ilbext, iubext, jubext, & 
     603      USE mapcomm_mod, ONLY: ielb, ieub, pielb, pjelb, pieub, pjeub,          & 
     604                             iesub, jesub, jeub, ilbext, iubext, jubext,      & 
    605605                             jlbext, pnactive, piesub, pjesub, jelb, pilbext, & 
    606                              piubext, pjlbext, pjubext, LAND, msgtrim_z 
    607       USE partition_mod, ONLY: partition_rk, partition_mca_rk, & 
    608                                imask, ibotlevel, partition_mask_alloc, & 
     606                             piubext, pjlbext, pjubext, LAND, trimmed,        & 
     607                             msgtrim_z, set_num_subdomains 
     608      USE partition_mod, ONLY: partition_rk, partition_mca_rk, read_partition, & 
     609                               imask, ibotlevel, partition_mask_alloc,         & 
    609610                               smooth_global_bathy, global_bot_level 
    610611      USE par_oce,       ONLY: do_exchanges 
     
    645646      END IF 
    646647 
    647       ! Check whether user has specified halo trimming in z via environment variable 
     648      ! Check whether user has specified halo trimming in z via environment  
     649      ! variable. 
    648650      ! Halo trimming in z is on by default 
    649651      msgtrim_z = .TRUE. 
    650       CALL GET_ENVIRONMENT_VARIABLE(NAME='NEMO_MSGTRIM_Z', VALUE=lstr, STATUS=ierr) 
     652      CALL GET_ENVIRONMENT_VARIABLE(NAME='NEMO_MSGTRIM_Z', VALUE=lstr, & 
     653                                    STATUS=ierr) 
    651654      IF( ierr == 0)THEN 
    652655         READ(lstr,FMT="(I)",IOSTAT=ierr) lztrim 
     
    658661      END IF 
    659662 
    660       WRITE(*,*) 'ARPDBG: msgtrim_z = ',msgtrim_z 
    661  
    662       ! Factorise the number of MPI PEs to get jpi and jpj as usual 
    663       CALL nemo_partition(num_pes) 
     663      IF(lwp) WRITE(*,*) 'ARPDBG: msgtrim_z = ',msgtrim_z 
    664664 
    665665      ! ============================ 
     
    674674      CALL dom_nam() 
    675675 
    676       ! Allocate these arrays so we can use domzgr::zgr_z routine; free them at 
     676      ! Allocate these arrays so we can use domzgr::zgr_z routine; free them 
    677677      ! when we're done so as not to upset the 'official' allocation once 
    678678      ! the domain decomposition is done. 
    679679      ALLOCATE(gdepw_0(jpk), gdept_0(jpk), e3w_0(jpk), e3t_0(jpk), & 
    680                ! Need many global, 3D arrays if zgr_zco is to be called 
    681                !gdepw(jpiglo,jpjglo,jpk), gdept(jpiglo,jpjglo,jpk), & 
    682                !gdep3w(jpiglo,jpjglo,jpk), e3t(jpiglo,jpjglo,jpk),  & 
    683680               mig(jpiglo), mjg(jpjglo), & 
    684681               mbathy(jpiglo,jpjglo), bathy(jpiglo,jpjglo), Stat=ierr) 
    685682      IF(ierr /= 0)THEN 
    686          CALL ctl_stop('nemo_recursive_partition: failed to allocate zgr_z() arrays') 
     683         CALL ctl_stop('STOP', & 
     684                       'nemo_recursive_partition: failed to allocate zgr_z() arrays') 
    687685         RETURN 
    688686      END IF 
     
    743741      ! Allocate partitioning arrays. 
    744742 
    745       IF ( .not.allocated(pielb) ) THEN 
     743      IF ( .NOT. ALLOCATED(pielb) ) THEN 
    746744         ALLOCATE (pielb(num_pes),   pieub(num_pes), piesub(num_pes),     & 
    747745                   pilbext(num_pes), piubext(num_pes),                    & 
    748746                   pjelb(num_pes),   pjeub(num_pes), pjesub(num_pes),     & 
    749747                   pjlbext(num_pes), pjubext(num_pes), pnactive(num_pes), & 
    750                    Stat = ierr) 
     748                   trimmed(4,num_pes), Stat = ierr) 
    751749         IF(ierr /= 0)THEN 
    752750            CALL ctl_stop('STOP', & 
     
    756754      ENDIF 
    757755 
    758       ! Now we can do recursive k-section partitioning 
    759       ! ARPDBG - BUG if limits on array below are set to anything other than 
    760       ! 1 and jp{i,j}glo then check for external boundaries in a few lines 
    761       ! time WILL FAIL! 
    762       !      CALL partition_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 
    763  
    764       ! Multi-core aware version of recursive k-section partitioning. Currently 
    765       ! only accounts for whether a grid point is wet or dry. It has no knowledge 
    766       ! of the number of wet levels at a point. 
    767       CALL partition_mca_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 
     756      ! Set error flag so that we calculate domain decomp if not reading 
     757      ! existing decomposition or if read fails. 
     758      ierr = 1 
     759 
     760      IF( nn_readpart )THEN 
     761         ! Read the partitioning to use from disk  
     762         CALL read_partition(ierr) 
     763         IF ( ierr /= 0 ) THEN 
     764            CALL ctl_warn('Read of pre-calculated domain decomposition failed - will calculate one instead.') 
     765         END IF 
     766      END IF 
     767 
     768      ! Set the number of sub-domains for which we are to partition  
     769      ! (module var in mapcomm_mod) 
     770      CALL set_num_subdomains(num_pes) 
     771 
     772      IF(ierr /= 0)THEN 
     773         ! Multi-core aware version of recursive k-section partitioning.  
     774         ! Currently only accounts for whether a grid point is wet or dry. 
     775         ! It has no knowledge of the number of wet levels at a point. 
     776         CALL partition_mca_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 
     777 
     778         ! Now we can do recursive k-section partitioning 
     779         ! ARPDBG - BUG if limits on array below are set to anything other than 
     780         ! 1 and jp{i,j}glo then check for external boundaries in a few lines 
     781         ! time WILL FAIL! 
     782         ! CALL partition_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 
     783     END IF 
    768784 
    769785      ! Check the error code from partitioning. 
     
    854870      ! Search backwards from the square root of n. 
    855871 
    856       fact_loop: DO kna=SQRT(REAL(kn)),1,-1 
     872      fact_loop: DO kna=INT(SQRT(REAL(kn))),1,-1 
    857873         IF ( kn/kna*kna == kn ) THEN 
    858874            EXIT fact_loop 
Note: See TracChangeset for help on using the changeset viewer.