Changeset 14433 for NEMO/trunk/src/OCE/CRS/crsdom.F90
- Timestamp:
- 2021-02-11T09:06:49+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/CRS/crsdom.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/CRS/crsdom.F90
r14275 r14433 30 30 !! Original. May 2012. (J. Simeon, C. Calone, G. Madec, C. Ethe) 31 31 !!=================================================================== 32 USE dom_oce ! ocean space and time domain and to get jperio32 USE dom_oce ! ocean space and time domain 33 33 USE crs ! domain for coarse grid 34 34 ! … … 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 … … 2117 2117 CASE ( 0 ) 2118 2118 2119 SELECT CASE ( jperio )2120 2121 2122 CASE ( 0, 1, 3, 4 ) ! 3, 4 : T-Pivot at North Fold2123 2124 DO ji = 2, jpiglo_crsm12125 ijie = ( ji * nn_factx ) - nn_factx !cc2126 ijis = ijie - nn_factx + 12127 mis2_crs(ji) = ijis2128 mie2_crs(ji) = ijie2129 ENDDO2130 IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 22131 2132 ! Handle first the northernmost bin2133 IF ( nn_facty == 2 ) THEN ; ijjgloT = jpjglo - 12134 ELSE ; ijjgloT = jpjglo2135 ENDIF2136 2137 DO jj = 2, jpjglo_crs2138 ijje = ijjgloT - nn_facty * ( jj - 3 )2139 ijjs = ijje - nn_facty + 12140 mjs2_crs(jpjglo_crs-jj+2) = ijjs2141 mje2_crs(jpjglo_crs-jj+2) = ijje2142 ENDDO2143 2144 CASE ( 2 )2145 WRITE(numout,*) 'crs_init, jperio=2 not supported'2146 2147 CASE ( 5, 6 ) ! F-pivot at North Fold2148 2149 DO ji = 2, jpiglo_crsm12150 ijie = ( ji * nn_factx ) - nn_factx2151 ijis = ijie - nn_factx + 12152 mis2_crs(ji) = ijis2153 mie2_crs(ji) = ijie2154 ENDDO2155 IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1) = jpiglo - 22156 2157 ! Treat the northernmost bin separately.2158 jj = 22159 ijje = jpj - nn_facty * ( jj - 2 )2160 IF ( nn_facty == 3 ) THEN ; ijjs = ijje - 12161 ELSE ; ijjs = ijje - nn_facty + 12162 ENDIF2163 mjs2_crs(jpj_crs-jj+1) = ijjs2164 mje2_crs(jpj_crs-jj+1) = ijje2165 2166 ! Now bin the rest, any remainder at the south is lumped in the southern bin2167 DO jj = 3, jpjglo_crsm12168 ijje = jpjglo - nn_facty * ( jj - 2 )2169 ijjs = ijje - nn_facty + 12170 IF ( ijjs <= nn_facty ) ijjs = 22171 mjs2_crs(jpj_crs-jj+1) = ijjs2172 mje2_crs(jpj_crs-jj+1) = ijje2173 ENDDO2174 2175 CASE DEFAULT2176 WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported'2177 2178 END SELECT2119 !!$ SELECT CASE ( jperio ) 2120 !!$ 2121 !!$ 2122 !!$ CASE ( 0, 1, 3, 4 ) ! 3, 4 : T-Pivot at North Fold 2123 !!$ 2124 !!$ DO ji = 2, jpiglo_crsm1 2125 !!$ ijie = ( ji * nn_factx ) - nn_factx !cc 2126 !!$ ijis = ijie - nn_factx + 1 2127 !!$ mis2_crs(ji) = ijis 2128 !!$ mie2_crs(ji) = ijie 2129 !!$ ENDDO 2130 !!$ IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 2 2131 !!$ 2132 !!$ ! Handle first the northernmost bin 2133 !!$ IF ( nn_facty == 2 ) THEN ; ijjgloT = jpjglo - 1 2134 !!$ ELSE ; ijjgloT = jpjglo 2135 !!$ ENDIF 2136 !!$ 2137 !!$ DO jj = 2, jpjglo_crs 2138 !!$ ijje = ijjgloT - nn_facty * ( jj - 3 ) 2139 !!$ ijjs = ijje - nn_facty + 1 2140 !!$ mjs2_crs(jpjglo_crs-jj+2) = ijjs 2141 !!$ mje2_crs(jpjglo_crs-jj+2) = ijje 2142 !!$ ENDDO 2143 !!$ 2144 !!$ CASE ( 2 ) 2145 !!$ WRITE(numout,*) 'crs_init, jperio=2 not supported' 2146 !!$ 2147 !!$ CASE ( 5, 6 ) ! F-pivot at North Fold 2148 !!$ 2149 !!$ DO ji = 2, jpiglo_crsm1 2150 !!$ ijie = ( ji * nn_factx ) - nn_factx 2151 !!$ ijis = ijie - nn_factx + 1 2152 !!$ mis2_crs(ji) = ijis 2153 !!$ mie2_crs(ji) = ijie 2154 !!$ ENDDO 2155 !!$ IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1) = jpiglo - 2 2156 !!$ 2157 !!$ ! Treat the northernmost bin separately. 2158 !!$ jj = 2 2159 !!$ ijje = jpj - nn_facty * ( jj - 2 ) 2160 !!$ IF ( nn_facty == 3 ) THEN ; ijjs = ijje - 1 2161 !!$ ELSE ; ijjs = ijje - nn_facty + 1 2162 !!$ ENDIF 2163 !!$ mjs2_crs(jpj_crs-jj+1) = ijjs 2164 !!$ mje2_crs(jpj_crs-jj+1) = ijje 2165 !!$ 2166 !!$ ! Now bin the rest, any remainder at the south is lumped in the southern bin 2167 !!$ DO jj = 3, jpjglo_crsm1 2168 !!$ ijje = jpjglo - nn_facty * ( jj - 2 ) 2169 !!$ ijjs = ijje - nn_facty + 1 2170 !!$ IF ( ijjs <= nn_facty ) ijjs = 2 2171 !!$ mjs2_crs(jpj_crs-jj+1) = ijjs 2172 !!$ mje2_crs(jpj_crs-jj+1) = ijje 2173 !!$ ENDDO 2174 !!$ 2175 !!$ CASE DEFAULT 2176 !!$ WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported' 2177 !!$ 2178 !!$ END SELECT 2179 2179 2180 2180 CASE (1 )
Note: See TracChangeset
for help on using the changeset viewer.
