Changeset 3849
- Timestamp:
- 2013-03-26T11:45:16+01:00 (11 years ago)
- 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 6 6 *.err 7 7 *.out 8 *.o 9 *.exe -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/ARCH/arch-gfortran_linux.fcm
r2315 r3849 15 15 16 16 17 %NCDF_INC -I/ usr/local/netcdf/include18 %NCDF_LIB -L/ usr/local/netcdf/lib -lnetcdf17 %NCDF_INC -I/home/kbc59144/MyInstalls/include 18 %NCDF_LIB -L/home/kbc59144/MyInstalls/lib -lnetcdf -lnetcdff 19 19 %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 21 22 %FFLAGS %FCFLAGS 22 23 %LD gfortran -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/ARCH/arch-gfortran_mpi_linux.fcm
r3837 r3849 15 15 16 16 17 %NCDF_INC -I/ usr/local/netcdf/include18 %NCDF_LIB -L/ usr/local/netcdf/lib -lnetcdf19 %FC gfortran17 %NCDF_INC -I/home/kbc59144/MyInstalls/include 18 %NCDF_LIB -L/home/kbc59144/MyInstalls/lib -lnetcdf -lnetcdff 19 %FC mpif90 20 20 %FCFLAGS -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 21 21 %FFLAGS %FCFLAGS 22 %LD gfortran22 %LD mpif90 23 23 %LDFLAGS 24 24 %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_iomput1 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 541 541 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 542 542 #if defined key_z_first 543 ELSE 543 ELSEWHERE ; btm30(:,:) = tmask_1(:,:) 544 544 #else 545 ELSE 545 ELSEWHERE ; btm30(:,:) = tmask(:,:,1) 546 546 #endif 547 547 END WHERE -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3837 r3849 157 157 INTEGER, SAVE, PUBLIC :: nn_cpnode = 4 ! Number of cores per 158 158 ! compute node on current computer 159 159 LOGICAL, SAVE, PUBLIC :: nn_readpart = .FALSE. ! Whether to read partition from 160 ! file (1) or not (0) 160 161 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 161 162 … … 263 264 ! 264 265 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 266 268 !!---------------------------------------------------------------------- 267 269 ! -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mapcomm_mod.F90
r3837 r3849 156 156 157 157 ! Public routines 158 PUBLIC :: mapcomms, iprocmap 158 PUBLIC :: mapcomms, iprocmap, set_num_subdomains 159 159 160 160 ! Public variables … … 165 165 PUBLIC :: nsendp,nsendp2d,nrecvp,nrecvp2d,npatchsend,npatchrecv, & 166 166 nxsendp,nysendp,nzsendp,nxrecvp,nyrecvp,nzrecvp, & 167 idesrecvp,jdesrecvp,isrcsendp,jsrcsendp 167 idesrecvp,jdesrecvp,isrcsendp,jsrcsendp, nprocp 168 168 169 169 PUBLIC :: ielb, ieub, pielb, pjelb, pieub, pjeub, & 170 170 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 173 172 174 173 PUBLIC :: NONE & … … 191 190 192 191 ! Switch for trimming points below ocean floor from halo swaps 193 ! LOGICAL, PARAMETER :: msgtrim_z = .TRUE. ! .FALSE.194 LOGICAL, PUBLIC, SAVE 192 ! Defaults to true unless set via NEMO_MSGTRIM_Z environment var. 193 LOGICAL, PUBLIC, SAVE :: msgtrim_z 195 194 196 195 CONTAINS 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 197 208 198 209 SUBROUTINE mapcomms ( depth, ibotlvl, nx, ny, jperio, ierr ) … … 213 224 214 225 ! Local variables. 215 INTEGER :: i, i1, i2, i col, ihalo, iproc, iprocc, iprocx, &216 iprocy, j, j1, j2, lumapout,nadd, naddmaxr, naddmaxs226 INTEGER :: i, i1, i2, ihalo, iproc, iprocc, iprocx, & 227 iprocy, j, j1, j2, nadd, naddmaxr, naddmaxs 217 228 INTEGER :: ldiff0, ldiff1 ! Local vars for coping with wrapping of coords 218 229 INTEGER :: imax, imin ! Max/min value of i that a halo strip can run … … 1302 1313 IF ( addcorner ) THEN 1303 1314 #if defined ARPDEBUG 1304 WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I 2,', dir = ',I1)") &1315 WRITE (*,FMT="(I3,': ARPDBG adding corner send to ',I4,', dir = ',I1)") & 1305 1316 narea-1, procid(iprocc),i 1306 1317 #endif … … 1314 1325 1315 1326 #if defined ARPDEBUG 1316 WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I 3,', old dir = ',I1,' new dir = ',I1)") &1327 WRITE (*,FMT="(I3,': ARPDBG adding corner recv. from ',I4,', old dir = ',I1,' new dir = ',I1)") & 1317 1328 narea-1, procid(iprocc),i, j 1318 1329 #endif … … 1380 1391 ! ARP - for debugging only 1381 1392 !!$ IF(iprocmap == 0)THEN 1382 !!$ WRITE(*,"('iprocmap: failed to find owner PE for (',I3, I3,')')") ia, ja1393 !!$ WRITE(*,"('iprocmap: failed to find owner PE for (',I3,1x,I3,')')") ia, ja 1383 1394 !!$ WRITE(*,*) 'PE domains are [xmin:xmax][ymin:ymax]:' 1384 1395 !!$ DO iproc=1,nprocp,1 … … 1826 1837 1827 1838 ! Can any points along the left (low i) edge be trimmed? 1828 left_edge: DO i=ilo, ihi - nextra1839 left_edge: DO i=ilo, ihi 1829 1840 DO j=jlo, jhi 1830 1841 ! depth is global mask, i and j are local coords … … 1856 1867 1857 1868 ! Can any points along the right (high i) edge be trimmed? 1858 right_edge: DO i=ihi, ilo + nextra, -11869 right_edge: DO i=ihi, ilo, -1 1859 1870 DO j=jlo, jhi 1860 1871 ! 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 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 -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3211 r3849 114 114 WHERE(z_mdt(:,:) /= zfill) ; mdtmask(:,:) = tmask(:,:,1) 115 115 #endif 116 ELSE 116 ELSEWHERE ; mdtmask(:,:) = 0 117 117 END WHERE 118 118 -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r2715 r3849 105 105 ! ice free of snow and melts 106 106 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalbfz(:,:,:) = rn_albice 107 ELSE 107 ELSEWHERE ; zalbfz(:,:,:) = rn_alphdi 108 108 END WHERE 109 109 110 110 WHERE ( 1.5 < ph_ice ) ; zficeth = zalbfz 111 ELSE 112 ELSE 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 & 113 113 & - 0.8608 * ph_ice * ph_ice & 114 114 & + 0.3812 * ph_ice * ph_ice * ph_ice 115 ELSE 115 ELSEWHERE ; zficeth = 0.1 + 3.6 * ph_ice 116 116 END WHERE 117 117 -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r3432 r3849 1433 1433 ! 1434 1434 INTEGER :: jit, jk ! dummy loop indices 1435 INTEGER :: id1, id2, id3, id4, id5, id6 , id7, id81435 INTEGER :: id1, id2, id3, id4, id5, id6 1436 1436 INTEGER :: ji, jj, ikbu, ikbv 1437 1437 REAL(wp):: cbx, cby … … 1448 1448 id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. ) 1449 1449 ! 1450 IF( MIN( id1, id2, id3, id4, id5, id6 , id7, id8) > 0 ) THEN ! all required arrays exist1450 IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 1451 1451 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1452 1452 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3837 r3849 601 601 USE iom, ONLY: jpiglo, jpjglo, wp, jpdom_unknown, & 602 602 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, & 605 605 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, & 609 610 smooth_global_bathy, global_bot_level 610 611 USE par_oce, ONLY: do_exchanges … … 645 646 END IF 646 647 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. 648 650 ! Halo trimming in z is on by default 649 651 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) 651 654 IF( ierr == 0)THEN 652 655 READ(lstr,FMT="(I)",IOSTAT=ierr) lztrim … … 658 661 END IF 659 662 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 664 664 665 665 ! ============================ … … 674 674 CALL dom_nam() 675 675 676 ! Allocate these arrays so we can use domzgr::zgr_z routine; free them at676 ! Allocate these arrays so we can use domzgr::zgr_z routine; free them 677 677 ! when we're done so as not to upset the 'official' allocation once 678 678 ! the domain decomposition is done. 679 679 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 called681 !gdepw(jpiglo,jpjglo,jpk), gdept(jpiglo,jpjglo,jpk), &682 !gdep3w(jpiglo,jpjglo,jpk), e3t(jpiglo,jpjglo,jpk), &683 680 mig(jpiglo), mjg(jpjglo), & 684 681 mbathy(jpiglo,jpjglo), bathy(jpiglo,jpjglo), Stat=ierr) 685 682 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') 687 685 RETURN 688 686 END IF … … 743 741 ! Allocate partitioning arrays. 744 742 745 IF ( . not.allocated(pielb) ) THEN743 IF ( .NOT. ALLOCATED(pielb) ) THEN 746 744 ALLOCATE (pielb(num_pes), pieub(num_pes), piesub(num_pes), & 747 745 pilbext(num_pes), piubext(num_pes), & 748 746 pjelb(num_pes), pjeub(num_pes), pjesub(num_pes), & 749 747 pjlbext(num_pes), pjubext(num_pes), pnactive(num_pes), & 750 Stat = ierr)748 trimmed(4,num_pes), Stat = ierr) 751 749 IF(ierr /= 0)THEN 752 750 CALL ctl_stop('STOP', & … … 756 754 ENDIF 757 755 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 768 784 769 785 ! Check the error code from partitioning. … … 854 870 ! Search backwards from the square root of n. 855 871 856 fact_loop: DO kna= SQRT(REAL(kn)),1,-1872 fact_loop: DO kna=INT(SQRT(REAL(kn))),1,-1 857 873 IF ( kn/kna*kna == kn ) THEN 858 874 EXIT fact_loop
Note: See TracChangeset
for help on using the changeset viewer.