Changeset 3096
- Timestamp:
- 2011-11-14T16:54:42+01:00 (12 years ago)
- Location:
- branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
-
FLO/floblk.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (5 diffs)
-
OBC/obcdta.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r3094 r3096 345 345 ! more time. 346 346 # if defined key_obc 347 !!!!!!!! NEED TO SORT THIS OUT !!!!!!!! 348 !!$ DO jfl = 1, jpnfl 349 !!$ IF( lp_obc_east ) THEN 350 !!$ IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 351 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 352 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 353 !!$ zagefl(jfl) = rdt 354 !!$ END IF 355 !!$ END IF 356 !!$ IF( lp_obc_west ) THEN 357 !!$ IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 358 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 359 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 360 !!$ zagefl(jfl) = rdt 361 !!$ END IF 362 !!$ END IF 363 !!$ IF( lp_obc_north ) THEN 364 !!$ IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 365 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 366 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 367 !!$ zagefl(jfl) = rdt 368 !!$ END IF 369 !!$ END IF 370 !!$ IF( lp_obc_south ) THEN 371 !!$ IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 372 !!$ zgifl (jfl) = INT(zgifl(jfl)) + 0.5 373 !!$ zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 374 !!$ zagefl(jfl) = rdt 375 !!$ END IF 376 !!$ END IF 377 !!$ END DO 347 DO jfl = 1, jpnfl 348 IF( lp_obc_east ) THEN 349 IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN 350 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 351 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 352 zagefl(jfl) = rdt 353 END IF 354 END IF 355 IF( lp_obc_west ) THEN 356 IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN 357 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 358 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 359 zagefl(jfl) = rdt 360 END IF 361 END IF 362 IF( lp_obc_north ) THEN 363 IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN 364 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 365 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 366 zagefl(jfl) = rdt 367 END IF 368 END IF 369 IF( lp_obc_south ) THEN 370 IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN 371 zgifl (jfl) = INT(zgifl(jfl)) + 0.5 372 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 373 zagefl(jfl) = rdt 374 END IF 375 END IF 376 END DO 378 377 #endif 379 378 -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3094 r3096 47 47 !! mppsync : 48 48 !! mppstop : 49 !! mppobc : variant of mpp_lnk for open boundary condition 49 50 !! mpp_ini_north : initialisation of north fold 50 51 !! mpp_lbc_north : north fold processors gathering … … 63 64 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 64 65 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 65 PUBLIC mpp _ini_ice, mpp_ini_znl66 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 66 67 PUBLIC mppsize 67 68 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 … … 1725 1726 END SUBROUTINE mppstop 1726 1727 1728 1729 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 1730 !!---------------------------------------------------------------------- 1731 !! *** routine mppobc *** 1732 !! 1733 !! ** Purpose : Message passing manadgement for open boundary 1734 !! conditions array 1735 !! 1736 !! ** Method : Use mppsend and mpprecv function for passing mask 1737 !! between processors following neighboring subdomains. 1738 !! domain parameters 1739 !! nlci : first dimension of the local subdomain 1740 !! nlcj : second dimension of the local subdomain 1741 !! nbondi : mark for "east-west local boundary" 1742 !! nbondj : mark for "north-south local boundary" 1743 !! noea : number for local neighboring processors 1744 !! nowe : number for local neighboring processors 1745 !! noso : number for local neighboring processors 1746 !! nono : number for local neighboring processors 1747 !! 1748 !!---------------------------------------------------------------------- 1749 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1750 USE wrk_nemo, ONLY: ztab => wrk_2d_1 1751 ! 1752 INTEGER , INTENT(in ) :: kd1, kd2 ! starting and ending indices 1753 INTEGER , INTENT(in ) :: kl ! index of open boundary 1754 INTEGER , INTENT(in ) :: kk ! vertical dimension 1755 INTEGER , INTENT(in ) :: ktype ! define north/south or east/west cdt 1756 ! ! = 1 north/south ; = 2 east/west 1757 INTEGER , INTENT(in ) :: kij ! horizontal dimension 1758 INTEGER , INTENT(in ) :: kumout ! ocean.output logical unit 1759 REAL(wp), INTENT(inout), DIMENSION(kij,kk) :: ptab ! variable array 1760 ! 1761 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1762 INTEGER :: iipt0, iipt1, ilpt1 ! local integers 1763 INTEGER :: ijpt0, ijpt1 ! - - 1764 INTEGER :: imigr, iihom, ijhom ! - - 1765 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1766 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 1767 !!---------------------------------------------------------------------- 1768 1769 IF( wrk_in_use(2, 1) ) THEN 1770 WRITE(kumout, cform_err) 1771 WRITE(kumout,*) 'mppobc : requested workspace array unavailable' 1772 CALL mppstop 1773 ENDIF 1774 1775 ! boundary condition initialization 1776 ! --------------------------------- 1777 ztab(:,:) = 0.e0 1778 ! 1779 IF( ktype==1 ) THEN ! north/south boundaries 1780 iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci ) ) 1781 iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) ) 1782 ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci ) ) 1783 ijpt0 = MAX( 1, MIN(kl - njmpp+1, nlcj ) ) 1784 ijpt1 = MAX( 0, MIN(kl - njmpp+1, nlcj - 1 ) ) 1785 ELSEIF( ktype==2 ) THEN ! east/west boundaries 1786 iipt0 = MAX( 1, MIN(kl - nimpp+1, nlci ) ) 1787 iipt1 = MAX( 0, MIN(kl - nimpp+1, nlci - 1 ) ) 1788 ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj ) ) 1789 ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) ) 1790 ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj ) ) 1791 ELSE 1792 WRITE(kumout, cform_err) 1793 WRITE(kumout,*) 'mppobc : bad ktype' 1794 CALL mppstop 1795 ENDIF 1796 1797 ! Communication level by level 1798 ! ---------------------------- 1799 !!gm Remark : this is very time consumming!!! 1800 ! ! ------------------------ ! 1801 DO jk = 1, kk ! Loop over the levels ! 1802 ! ! ------------------------ ! 1803 ! 1804 IF( ktype == 1 ) THEN ! north/south boundaries 1805 DO jj = ijpt0, ijpt1 1806 DO ji = iipt0, iipt1 1807 ztab(ji,jj) = ptab(ji,jk) 1808 END DO 1809 END DO 1810 ELSEIF( ktype == 2 ) THEN ! east/west boundaries 1811 DO jj = ijpt0, ijpt1 1812 DO ji = iipt0, iipt1 1813 ztab(ji,jj) = ptab(jj,jk) 1814 END DO 1815 END DO 1816 ENDIF 1817 1818 1819 ! 1. East and west directions 1820 ! --------------------------- 1821 ! 1822 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions 1823 iihom = nlci-nreci 1824 DO jl = 1, jpreci 1825 t2ew(:,jl,1) = ztab(jpreci+jl,:) 1826 t2we(:,jl,1) = ztab(iihom +jl,:) 1827 END DO 1828 ENDIF 1829 ! 1830 ! ! Migrations 1831 imigr=jpreci*jpj 1832 ! 1833 IF( nbondi == -1 ) THEN 1834 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 1835 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1836 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1837 ELSEIF( nbondi == 0 ) THEN 1838 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1839 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 1840 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1841 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1842 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1843 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1844 ELSEIF( nbondi == 1 ) THEN 1845 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1846 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1847 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1848 ENDIF 1849 ! 1850 ! ! Write Dirichlet lateral conditions 1851 iihom = nlci-jpreci 1852 ! 1853 IF( nbondi == 0 .OR. nbondi == 1 ) THEN 1854 DO jl = 1, jpreci 1855 ztab(jl,:) = t2we(:,jl,2) 1856 END DO 1857 ENDIF 1858 IF( nbondi == -1 .OR. nbondi == 0 ) THEN 1859 DO jl = 1, jpreci 1860 ztab(iihom+jl,:) = t2ew(:,jl,2) 1861 END DO 1862 ENDIF 1863 1864 1865 ! 2. North and south directions 1866 ! ----------------------------- 1867 ! 1868 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 1869 ijhom = nlcj-nrecj 1870 DO jl = 1, jprecj 1871 t2sn(:,jl,1) = ztab(:,ijhom +jl) 1872 t2ns(:,jl,1) = ztab(:,jprecj+jl) 1873 END DO 1874 ENDIF 1875 ! 1876 ! ! Migrations 1877 imigr = jprecj * jpi 1878 ! 1879 IF( nbondj == -1 ) THEN 1880 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 1881 CALL mpprecv( 3, t2ns(1,1,2), imigr ) 1882 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1883 ELSEIF( nbondj == 0 ) THEN 1884 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1885 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 1886 CALL mpprecv( 3, t2ns(1,1,2), imigr ) 1887 CALL mpprecv( 4, t2sn(1,1,2), imigr ) 1888 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1889 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1890 ELSEIF( nbondj == 1 ) THEN 1891 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1892 CALL mpprecv( 4, t2sn(1,1,2), imigr) 1893 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1894 ENDIF 1895 ! 1896 ! ! Write Dirichlet lateral conditions 1897 ijhom = nlcj - jprecj 1898 IF( nbondj == 0 .OR. nbondj == 1 ) THEN 1899 DO jl = 1, jprecj 1900 ztab(:,jl) = t2sn(:,jl,2) 1901 END DO 1902 ENDIF 1903 IF( nbondj == 0 .OR. nbondj == -1 ) THEN 1904 DO jl = 1, jprecj 1905 ztab(:,ijhom+jl) = t2ns(:,jl,2) 1906 END DO 1907 ENDIF 1908 IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 1909 DO jj = ijpt0, ijpt1 ! north/south boundaries 1910 DO ji = iipt0,ilpt1 1911 ptab(ji,jk) = ztab(ji,jj) 1912 END DO 1913 END DO 1914 ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN 1915 DO jj = ijpt0, ilpt1 ! east/west boundaries 1916 DO ji = iipt0,iipt1 1917 ptab(jj,jk) = ztab(ji,jj) 1918 END DO 1919 END DO 1920 ENDIF 1921 ! 1922 END DO 1923 ! 1924 IF( wrk_not_released(2, 1) ) THEN 1925 WRITE(kumout, cform_err) 1926 WRITE(kumout,*) 'mppobc : failed to release workspace array' 1927 CALL mppstop 1928 ENDIF 1929 ! 1930 END SUBROUTINE mppobc 1931 1932 1727 1933 SUBROUTINE mpp_comm_free( kcom ) 1728 1934 !!---------------------------------------------------------------------- … … 2282 2488 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 2283 2489 END INTERFACE 2490 INTERFACE mppobc 2491 MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 2492 END INTERFACE 2284 2493 INTERFACE mpp_minloc 2285 2494 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d … … 2394 2603 WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 2395 2604 END SUBROUTINE mppmin_int 2605 2606 SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 2607 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum 2608 REAL, DIMENSION(:) :: parr ! variable array 2609 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum 2610 END SUBROUTINE mppobc_1d 2611 2612 SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 2613 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum 2614 REAL, DIMENSION(:,:) :: parr ! variable array 2615 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum 2616 END SUBROUTINE mppobc_2d 2617 2618 SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 2619 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum 2620 REAL, DIMENSION(:,:,:) :: parr ! variable array 2621 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 2622 END SUBROUTINE mppobc_3d 2623 2624 SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 2625 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum 2626 REAL, DIMENSION(:,:,:,:) :: parr ! variable array 2627 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 2628 END SUBROUTINE mppobc_4d 2396 2629 2397 2630 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) -
branches/2011/dev_NOC_UKMO_MERGE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r2722 r3096 1237 1237 WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 1238 1238 END SUBROUTINE obc_dta 1239 !!----------------------------------------------------------------------------- 1240 !! Default option 1241 !!----------------------------------------------------------------------------- 1242 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 1243 INTEGER,INTENT(in) :: kt 1244 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 1245 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 1246 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 1247 END SUBROUTINE obc_dta_bt 1239 1248 #endif 1240 1249 !!==============================================================================
Note: See TracChangeset
for help on using the changeset viewer.
