Changeset 779 for trunk/AGRIF/AGRIF_FILES/modupdate.F
- Timestamp:
- 2007-12-22T18:04:17+01:00 (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/AGRIF_FILES/modupdate.F
r662 r779 42 42 C 43 43 IMPLICIT NONE 44 logical, private :: precomputedone(7) = .FALSE. 44 45 C 45 46 CONTAINS … … 1301 1302 1302 1303 if ( nbdim .EQ. 1 ) then 1304 tempP%var%array1 = 0. 1303 1305 Call Agrif_Update_1D_recursive(TypeUpdate, 1304 1306 & tempP%var%array1,tempCextend%var%array1, … … 1822 1824 REAL, DIMENSION(indmin(1):indmax(1), 1823 1825 & pttab_child(2):petab_child(2)) :: tabtemp 1826 REAL, DIMENSION(indmin(2):indmax(2), 1827 & indmin(1):indmax(1)) :: tempP_trsp 1828 REAL, DIMENSION(pttab_child(2):petab_child(2), 1829 & indmin(1):indmax(1)) :: tabtemp_trsp 1824 1830 INTEGER :: i,j 1825 1831 INTEGER :: coeffraf,locind_child_left 1826 1832 C 1833 tabtemp = 0. 1834 1835 1836 coeffraf = nint ( ds_parent(1) / ds_child(1) ) 1837 IF((TypeUpdate(1) == AGRIF_Update_average) 1838 & .AND. (coeffraf /= 1 ))THEN 1839 !---CDIR NEXPAND 1840 IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D 1841 & (petab_child(2)-pttab_child(2)+1, 1842 & indmax(1)-indmin(1)+1, 1843 & petab_child(1)-pttab_child(1)+1, 1844 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 1845 !---CDIR NEXPAND 1846 Call average1Daftercompute 1847 & ( tabtemp, tempC, 1848 & size(tabtemp), size(tempC), 1849 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 1850 1851 ELSEIF((TypeUpdate(1) == AGRIF_Update_copy) 1852 & .AND. (coeffraf /= 1 ))THEN 1853 !---CDIR NEXPAND 1854 IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D 1855 & (petab_child(2)-pttab_child(2)+1, 1856 & indmax(1)-indmin(1)+1, 1857 & petab_child(1)-pttab_child(1)+1, 1858 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 1859 !---CDIR NEXPAND 1860 Call copy1Daftercompute 1861 & ( tabtemp, tempC, 1862 & size(tabtemp), size(tempC), 1863 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 1864 1865 ELSE 1827 1866 do j = pttab_child(nbdim),petab_child(nbdim) 1828 1867 C 1868 !---CDIR NEXPAND 1829 1869 Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1), 1830 1870 & tabtemp(:,j), … … 1836 1876 C 1837 1877 enddo 1838 1878 ENDIF 1879 tabtemp_trsp = TRANSPOSE(tabtemp) 1880 coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim)) 1881 1882 !---CDIR NEXPAND 1839 1883 Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 1840 1884 & ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 1841 1885 C 1886 1887 tempP_trsp = 0. 1888 1889 IF((TypeUpdate(2) == AGRIF_Update_average) 1890 & .AND. (coeffraf /= 1 ))THEN 1891 !---CDIR NEXPAND 1892 IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D 1893 & ( indmax(1)-indmin(1)+1, 1894 & indmax(2)-indmin(2)+1, 1895 & petab_child(2)-pttab_child(2)+1, 1896 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 1897 !---CDIR NEXPAND 1898 Call average1Daftercompute 1899 & ( tempP_trsp, tabtemp_trsp, 1900 & size(tempP_trsp), size(tabtemp_trsp), 1901 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 1902 1903 ELSEIF((TypeUpdate(2) == AGRIF_Update_copy) 1904 & .AND. (coeffraf /= 1 ))THEN 1905 !---CDIR NEXPAND 1906 IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D 1907 & ( indmax(1)-indmin(1)+1, 1908 & indmax(2)-indmin(2)+1, 1909 & petab_child(2)-pttab_child(2)+1, 1910 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 1911 !---CDIR NEXPAND 1912 Call copy1Daftercompute 1913 & ( tempP_trsp, tabtemp_trsp, 1914 & size(tempP_trsp), size(tabtemp_trsp), 1915 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 1916 1917 ELSE 1918 1842 1919 do i = indmin(1),indmax(1) 1843 1920 C 1921 !---CDIR NEXPAND 1844 1922 Call Agrif_UpdateBase(TypeUpdate(2), 1845 & tempP (i,:),1846 & tabtemp (i,:),1923 & tempP_trsp(indmin(nbdim):indmax(nbdim),i), 1924 & tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i), 1847 1925 & indmin(nbdim),indmax(nbdim), 1848 1926 & pttab_child(nbdim),petab_child(nbdim), … … 1852 1930 C 1853 1931 enddo 1932 1933 ENDIF 1934 1935 tempP = TRANSPOSE(tempP_trsp) 1854 1936 C 1855 1937 Return … … 1902 1984 C 1903 1985 C 1986 coeffraf = nint ( ds_parent(1) / ds_child(1) ) 1987 IF((TypeUpdate(1) == AGRIF_Update_average) 1988 & .AND. (coeffraf /= 1 ))THEN 1989 !---CDIR NEXPAND 1990 Call average1Dprecompute2D 1991 & (petab_child(2)-pttab_child(2)+1, 1992 & indmax(1)-indmin(1)+1, 1993 & petab_child(1)-pttab_child(1)+1, 1994 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 1995 precomputedone(1) = .TRUE. 1996 ELSEIF((TypeUpdate(1) == AGRIF_Update_copy) 1997 & .AND. (coeffraf /= 1 ))THEN 1998 !---CDIR NEXPAND 1999 Call copy1Dprecompute2D 2000 & (petab_child(2)-pttab_child(2)+1, 2001 & indmax(1)-indmin(1)+1, 2002 & petab_child(1)-pttab_child(1)+1, 2003 & s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 2004 precomputedone(1) = .TRUE. 2005 ENDIF 2006 2007 coeffraf = nint ( ds_parent(2) / ds_child(2) ) 2008 IF((TypeUpdate(2) == AGRIF_Update_average) 2009 & .AND. (coeffraf /= 1 ))THEN 2010 !---CDIR NEXPAND 2011 Call average1Dprecompute2D 2012 & ( indmax(1)-indmin(1)+1, 2013 & indmax(2)-indmin(2)+1, 2014 & petab_child(2)-pttab_child(2)+1, 2015 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 2016 precomputedone(2) = .TRUE. 2017 ELSEIF((TypeUpdate(2) == AGRIF_Update_copy) 2018 & .AND. (coeffraf /= 1 ))THEN 2019 !---CDIR NEXPAND 2020 Call copy1Dprecompute2D 2021 & ( indmax(1)-indmin(1)+1, 2022 & indmax(2)-indmin(2)+1, 2023 & petab_child(2)-pttab_child(2)+1, 2024 & s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 2025 precomputedone(2) = .TRUE. 2026 ENDIF 2027 2028 1904 2029 do k = pttab_child(nbdim),petab_child(nbdim) 1905 2030 C … … 1914 2039 enddo 1915 2040 C 2041 precomputedone(1) = .FALSE. 2042 precomputedone(2) = .FALSE. 2043 coeffraf = nint ( ds_parent(3) / ds_child(3) ) 2044 1916 2045 Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 1917 2046 & ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) … … 1930 2059 1931 2060 ELSE 2061 tempP = 0. 1932 2062 C 1933 2063 do j = indmin(2),indmax(2) … … 2021 2151 & ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 2022 2152 C 2153 tempP = 0. 2154 2023 2155 do k = indmin(3),indmax(3) 2024 2156 C … … 2120 2252 Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 2121 2253 & ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 2254 tempP = 0. 2122 2255 C 2123 2256 do l = indmin(4),indmax(4) … … 2232 2365 & ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 2233 2366 C 2367 tempP = 0. 2368 2234 2369 do m = indmin(5),indmax(5) 2235 2370 do l = indmin(4),indmax(4) … … 2307 2442 C 2308 2443 elseif (TypeUpdate == AGRIF_Update_average) then 2309 C 2444 C 2310 2445 Call average1D 2311 2446 & (parenttab,childtab, 2312 2447 & indmax-indmin+1,petab_child-pttab_child+1, 2313 & s_parent,s_child,ds_parent,ds_child) 2448 & s_parent,s_child,ds_parent,ds_child) 2314 2449 C 2315 2450 elseif (TypeUpdate == AGRIF_Update_full_weighting) then … … 2421 2556 #endif 2422 2557 2423 End Module Agrif_Update2424 2558 2425 2559 C ************************************************************************** … … 2443 2577 C 2444 2578 C Arguments 2445 USE Agrif_Update2446 2579 INTEGER :: nbdim 2447 2580 INTEGER, DIMENSION(nbdim) :: TypeUpdate ! TYPE of update (copy or average) … … 2466 2599 & ds_parent(nbdim),ds_child(nbdim), 2467 2600 & coeffraf,locind_child_left) 2601 2468 2602 C 2469 2603 Return … … 2471 2605 C 2472 2606 End Subroutine Agrif_Update_1D_recursive 2607 2608 End Module Agrif_Update
Note: See TracChangeset
for help on using the changeset viewer.