- Timestamp:
- 2021-01-19T13:07:35+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/CRS/crsdom.F90
r14275 r14314 1877 1877 1878 1878 1879 ! 1.a. Define global domain indices : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points1880 jpiglo_crs = INT( (jpiglo - 2) / nn_factx ) + 21881 ! jpjglo_crs = INT( (jpjglo - 2) / nn_facty ) + 2 ! the -2 removes j=1, j=jpj1882 ! jpjglo_crs = INT( (jpjglo - 2) / nn_facty ) + 31883 jpjglo_crs = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 31884 jpiglo_crsm1 = jpiglo_crs - 11885 jpjglo_crsm1 = jpjglo_crs - 11886 1887 jpi_crs = ( jpiglo_crs - 2 * nn_hls + (jpni-1) ) / jpni + 2 * nn_hls1888 jpj_crs = ( jpjglo_crsm1 - 2 * nn_hls + (jpnj-1) ) / jpnj + 2 * nn_hls1889 1890 IF( noso < 0 ) jpj_crs = jpj_crs + 1 ! add a local band on southern processors1891 1892 jpi_crsm1 = jpi_crs - 11893 jpj_crsm1 = jpj_crs - 11894 nperio_crs = jperio1895 npolj_crs = npolj1896 1897 ierr = crs_dom_alloc() ! allocate most coarse grid arrays1898 1899 ! 2.a Define processor domain1900 IF( .NOT. lk_mpp ) THEN1901 nimpp_crs = 11902 njmpp_crs = 11903 Nis0_crs = 11904 Njs0_crs = 11905 Nie0_crs = jpi_crs1906 Nje0_crs = jpj_crs1907 ELSE1908 ! Initialisation of most local variables -1909 nimpp_crs = 11910 njmpp_crs = 11911 Nis0_crs = 11912 Njs0_crs = 11913 Nie0_crs = jpi_crs1914 Nje0_crs = jpj_crs1915 1916 ! Calculs suivant une découpage en j1917 DO jn = 1, jpnij, jpni1918 IF( jn < ( jpnij - jpni + 1 ) ) THEN1919 nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn ) - 1) ) / nn_facty, wp ) ) &1920 & - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )1921 ELSE1922 nje0all_crs(jn) = AINT( REAL( nje0all(jn) / nn_facty, wp ) ) + 11923 ENDIF1924 IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 11925 SELECT CASE( ibonjt(jn) )1926 CASE ( -1 )1927 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 11928 jpjall_crs (jn) = nje0all_crs(jn) + nn_hls1929 njs0all_crs(jn) = njs0all(jn)1930 1931 CASE ( 0 )1932 1933 njs0all_crs(jn) = njs0all(jn)1934 IF( njs0all(jn) == 1 ) nje0all_crs(jn) = nje0all_crs(jn) + 11935 nje0all_crs(jn) = nje0all_crs(jn) + nn_hls1936 jpjall_crs (jn) = nje0all_crs(jn) + nn_hls1937 1938 CASE ( 1, 2 )1939 1940 nje0all_crs(jn) = nje0all_crs(jn) + nn_hls1941 jpjall_crs (jn) = nje0all_crs(jn)1942 njs0all_crs(jn) = njs0all(jn)1943 1944 CASE DEFAULT1945 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' )1946 END SELECT1947 IF( jpjall_crs(jn) > jpj_crs ) jpj_crs = jpj_crs + 11948 1949 IF(njs0all_crs(jn) == 1 ) THEN1950 njmppt_crs(jn) = 11951 ELSE1952 njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) )1953 ENDIF1954 1955 DO jj = jn + 1, jn + jpni - 11956 nje0all_crs(jj) = nje0all_crs(jn)1957 jpjall_crs (jj) = jpjall_crs(jn)1958 njs0all_crs(jj) = njs0all_crs(jn)1959 njmppt_crs (jj) = njmppt_crs(jn)1960 ENDDO1961 ENDDO1962 Nje0_crs = nje0all_crs(narea)1963 jpj_crs = jpjall_crs (narea)1964 Njs0_crs = njs0all_crs(narea)1965 njmpp_crs = njmppt_crs (narea)1966 1967 ! Calcul suivant un decoupage en i1968 DO jn = 1, jpni1969 IF( jn == 1 ) THEN1970 nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) )1971 ELSE1972 nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) ) &1973 & - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) ) / nn_factx, wp) )1974 ENDIF1975 1976 SELECT CASE( ibonit(jn) )1977 CASE ( -1 )1978 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls1979 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls1980 nis0all_crs(jn) = nis0all(jn)1981 1982 CASE ( 0 )1983 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls1984 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls1985 nis0all_crs(jn) = nis0all(jn)1986 1987 CASE ( 1, 2 )1988 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 ) nie0all_crs(jn) = nie0all_crs(jn) + 11989 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls1990 jpiall_crs (jn) = nie0all_crs(jn)1991 nis0all_crs(jn) = nis0all(jn)1992 1993 CASE DEFAULT1994 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (2) ...' )1995 END SELECT1996 1997 nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 11998 DO jj = jn + jpni , jpnij, jpni1999 nie0all_crs(jj) = nie0all_crs(jn)2000 jpiall_crs (jj) = jpiall_crs (jn)2001 nis0all_crs(jj) = nis0all_crs(jn)2002 nimppt_crs (jj) = nimppt_crs (jn)2003 ENDDO2004 ENDDO2005 2006 Nie0_crs = nie0all_crs(narea)2007 jpi_crs = jpiall_crs (narea)2008 Nis0_crs = nis0all_crs(narea)2009 nimpp_crs = nimppt_crs (narea)2010 2011 DO ji = 1, jpi_crs2012 mig_crs(ji) = ji + nimpp_crs - 12013 ENDDO2014 DO jj = 1, jpj_crs2015 mjg_crs(jj) = jj + njmpp_crs - 1!2016 ENDDO2017 2018 DO ji = 1, jpiglo_crs2019 mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )2020 mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs ) )2021 ENDDO2022 2023 DO jj = 1, jpjglo_crs2024 mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )2025 mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs ) )2026 ENDDO2027 2028 ENDIF2029 2030 ! Save the parent grid information2031 jpi_full = jpi2032 jpj_full = jpj2033 jpim1_full = jpim12034 jpjm1_full = jpjm12035 nperio_full = jperio2036 2037 npolj_full = npolj2038 jpiglo_full = jpiglo2039 jpjglo_full = jpjglo2040 2041 jpj_full = jpj2042 jpi_full = jpi2043 Nis0_full = Nis02044 Njs0_full = Njs02045 Nie0_full = Nie02046 Nje0_full = Nje02047 nimpp_full = nimpp2048 njmpp_full = njmpp2049 2050 jpiall_full (:) = jpiall (:)2051 nis0all_full(:) = nis0all(:)2052 nie0all_full(:) = nie0all(:)2053 nimppt_full (:) = nimppt (:)2054 jpjall_full (:) = jpjall (:)2055 njs0all_full(:) = njs0all(:)2056 nje0all_full(:) = nje0all(:)2057 njmppt_full (:) = njmppt (:)1879 !!$ ! 1.a. Define global domain indices : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points 1880 !!$ jpiglo_crs = INT( (jpiglo - 2) / nn_factx ) + 2 1881 !!$ ! jpjglo_crs = INT( (jpjglo - 2) / nn_facty ) + 2 ! the -2 removes j=1, j=jpj 1882 !!$ ! jpjglo_crs = INT( (jpjglo - 2) / nn_facty ) + 3 1883 !!$ jpjglo_crs = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3 1884 !!$ jpiglo_crsm1 = jpiglo_crs - 1 1885 !!$ jpjglo_crsm1 = jpjglo_crs - 1 1886 !!$ 1887 !!$ jpi_crs = ( jpiglo_crs - 2 * nn_hls + (jpni-1) ) / jpni + 2 * nn_hls 1888 !!$ jpj_crs = ( jpjglo_crsm1 - 2 * nn_hls + (jpnj-1) ) / jpnj + 2 * nn_hls 1889 !!$ 1890 !!$ IF( noso < 0 ) jpj_crs = jpj_crs + 1 ! add a local band on southern processors 1891 !!$ 1892 !!$ jpi_crsm1 = jpi_crs - 1 1893 !!$ jpj_crsm1 = jpj_crs - 1 1894 !!$ nperio_crs = jperio 1895 !!$ npolj_crs = npolj 1896 !!$ 1897 !!$ ierr = crs_dom_alloc() ! allocate most coarse grid arrays 1898 !!$ 1899 !!$ ! 2.a Define processor domain 1900 !!$ IF( .NOT. lk_mpp ) THEN 1901 !!$ nimpp_crs = 1 1902 !!$ njmpp_crs = 1 1903 !!$ Nis0_crs = 1 1904 !!$ Njs0_crs = 1 1905 !!$ Nie0_crs = jpi_crs 1906 !!$ Nje0_crs = jpj_crs 1907 !!$ ELSE 1908 !!$ ! Initialisation of most local variables - 1909 !!$ nimpp_crs = 1 1910 !!$ njmpp_crs = 1 1911 !!$ Nis0_crs = 1 1912 !!$ Njs0_crs = 1 1913 !!$ Nie0_crs = jpi_crs 1914 !!$ Nje0_crs = jpj_crs 1915 !!$ 1916 !!$ ! Calculs suivant une découpage en j 1917 !!$ DO jn = 1, jpnij, jpni 1918 !!$ IF( jn < ( jpnij - jpni + 1 ) ) THEN 1919 !!$ nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn ) - 1) ) / nn_facty, wp ) ) & 1920 !!$ & - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 1921 !!$ ELSE 1922 !!$ nje0all_crs(jn) = AINT( REAL( nje0all(jn) / nn_facty, wp ) ) + 1 1923 !!$ ENDIF 1924 !!$ IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1925 !!$ SELECT CASE( ibonjt(jn) ) 1926 !!$ CASE ( -1 ) 1927 !!$ IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1928 !!$ jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 1929 !!$ njs0all_crs(jn) = njs0all(jn) 1930 !!$ 1931 !!$ CASE ( 0 ) 1932 !!$ 1933 !!$ njs0all_crs(jn) = njs0all(jn) 1934 !!$ IF( njs0all(jn) == 1 ) nje0all_crs(jn) = nje0all_crs(jn) + 1 1935 !!$ nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 1936 !!$ jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 1937 !!$ 1938 !!$ CASE ( 1, 2 ) 1939 !!$ 1940 !!$ nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 1941 !!$ jpjall_crs (jn) = nje0all_crs(jn) 1942 !!$ njs0all_crs(jn) = njs0all(jn) 1943 !!$ 1944 !!$ CASE DEFAULT 1945 !!$ CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' ) 1946 !!$ END SELECT 1947 !!$ IF( jpjall_crs(jn) > jpj_crs ) jpj_crs = jpj_crs + 1 1948 !!$ 1949 !!$ IF(njs0all_crs(jn) == 1 ) THEN 1950 !!$ njmppt_crs(jn) = 1 1951 !!$ ELSE 1952 !!$ njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 1953 !!$ ENDIF 1954 !!$ 1955 !!$ DO jj = jn + 1, jn + jpni - 1 1956 !!$ nje0all_crs(jj) = nje0all_crs(jn) 1957 !!$ jpjall_crs (jj) = jpjall_crs(jn) 1958 !!$ njs0all_crs(jj) = njs0all_crs(jn) 1959 !!$ njmppt_crs (jj) = njmppt_crs(jn) 1960 !!$ ENDDO 1961 !!$ ENDDO 1962 !!$ Nje0_crs = nje0all_crs(narea) 1963 !!$ jpj_crs = jpjall_crs (narea) 1964 !!$ Njs0_crs = njs0all_crs(narea) 1965 !!$ njmpp_crs = njmppt_crs (narea) 1966 !!$ 1967 !!$ ! Calcul suivant un decoupage en i 1968 !!$ DO jn = 1, jpni 1969 !!$ IF( jn == 1 ) THEN 1970 !!$ nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) ) 1971 !!$ ELSE 1972 !!$ nie0all_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + jpiall(jn ) ) / nn_factx, wp) ) & 1973 !!$ & - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) ) / nn_factx, wp) ) 1974 !!$ ENDIF 1975 !!$ 1976 !!$ SELECT CASE( ibonit(jn) ) 1977 !!$ CASE ( -1 ) 1978 !!$ nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1979 !!$ jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 1980 !!$ nis0all_crs(jn) = nis0all(jn) 1981 !!$ 1982 !!$ CASE ( 0 ) 1983 !!$ nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1984 !!$ jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 1985 !!$ nis0all_crs(jn) = nis0all(jn) 1986 !!$ 1987 !!$ CASE ( 1, 2 ) 1988 !!$ IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 ) nie0all_crs(jn) = nie0all_crs(jn) + 1 1989 !!$ nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 1990 !!$ jpiall_crs (jn) = nie0all_crs(jn) 1991 !!$ nis0all_crs(jn) = nis0all(jn) 1992 !!$ 1993 !!$ CASE DEFAULT 1994 !!$ CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (2) ...' ) 1995 !!$ END SELECT 1996 !!$ 1997 !!$ nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 1998 !!$ DO jj = jn + jpni , jpnij, jpni 1999 !!$ nie0all_crs(jj) = nie0all_crs(jn) 2000 !!$ jpiall_crs (jj) = jpiall_crs (jn) 2001 !!$ nis0all_crs(jj) = nis0all_crs(jn) 2002 !!$ nimppt_crs (jj) = nimppt_crs (jn) 2003 !!$ ENDDO 2004 !!$ ENDDO 2005 !!$ 2006 !!$ Nie0_crs = nie0all_crs(narea) 2007 !!$ jpi_crs = jpiall_crs (narea) 2008 !!$ Nis0_crs = nis0all_crs(narea) 2009 !!$ nimpp_crs = nimppt_crs (narea) 2010 !!$ 2011 !!$ DO ji = 1, jpi_crs 2012 !!$ mig_crs(ji) = ji + nimpp_crs - 1 2013 !!$ ENDDO 2014 !!$ DO jj = 1, jpj_crs 2015 !!$ mjg_crs(jj) = jj + njmpp_crs - 1! 2016 !!$ ENDDO 2017 !!$ 2018 !!$ DO ji = 1, jpiglo_crs 2019 !!$ mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 2020 !!$ mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs ) ) 2021 !!$ ENDDO 2022 !!$ 2023 !!$ DO jj = 1, jpjglo_crs 2024 !!$ mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 2025 !!$ mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs ) ) 2026 !!$ ENDDO 2027 !!$ 2028 !!$ ENDIF 2029 !!$ 2030 !!$ ! Save the parent grid information 2031 !!$ jpi_full = jpi 2032 !!$ jpj_full = jpj 2033 !!$ jpim1_full = jpim1 2034 !!$ jpjm1_full = jpjm1 2035 !!$ nperio_full = jperio 2036 !!$ 2037 !!$ npolj_full = npolj 2038 !!$ jpiglo_full = jpiglo 2039 !!$ jpjglo_full = jpjglo 2040 !!$ 2041 !!$ jpj_full = jpj 2042 !!$ jpi_full = jpi 2043 !!$ Nis0_full = Nis0 2044 !!$ Njs0_full = Njs0 2045 !!$ Nie0_full = Nie0 2046 !!$ Nje0_full = Nje0 2047 !!$ nimpp_full = nimpp 2048 !!$ njmpp_full = njmpp 2049 !!$ 2050 !!$ jpiall_full (:) = jpiall (:) 2051 !!$ nis0all_full(:) = nis0all(:) 2052 !!$ nie0all_full(:) = nie0all(:) 2053 !!$ nimppt_full (:) = nimppt (:) 2054 !!$ jpjall_full (:) = jpjall (:) 2055 !!$ njs0all_full(:) = njs0all(:) 2056 !!$ nje0all_full(:) = nje0all(:) 2057 !!$ njmppt_full (:) = njmppt (:) 2058 2058 2059 2059 CALL dom_grid_crs !swich de grille … … 2097 2097 IF ( nresty == 0 ) THEN 2098 2098 mybinctr = mybinctr - 1 2099 IF ( jperio == 3 .OR. jperio == 4 ) nperio_crs = jperio + 22100 IF ( jperio == 5 .OR. jperio == 6 ) nperio_crs = jperio - 22101 2102 IF ( npolj == 3 ) npolj_crs = 52103 IF ( npolj == 5 ) npolj_crs = 32099 !!$ IF ( jperio == 3 .OR. jperio == 4 ) nperio_crs = jperio + 2 2100 !!$ IF ( jperio == 5 .OR. jperio == 6 ) nperio_crs = jperio - 2 2101 !!$ 2102 !!$ IF ( npolj == 3 ) npolj_crs = 5 2103 !!$ IF ( npolj == 5 ) npolj_crs = 3 2104 2104 ENDIF 2105 2105
Note: See TracChangeset
for help on using the changeset viewer.