New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 779 for trunk/AGRIF/AGRIF_FILES/modupdate.F – NEMO

Ignore:
Timestamp:
2007-12-22T18:04:17+01:00 (16 years ago)
Author:
rblod
Message:

Agrif improvment for vectorization, see ticket #41

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/AGRIF_FILES/modupdate.F

    r662 r779  
    4242C 
    4343      IMPLICIT NONE 
     44      logical, private :: precomputedone(7) = .FALSE.       
    4445C       
    4546      CONTAINS 
    … …  
    13011302 
    13021303      if ( nbdim .EQ. 1 ) then 
     1304         tempP%var%array1 = 0. 
    13031305         Call Agrif_Update_1D_recursive(TypeUpdate, 
    13041306     &           tempP%var%array1,tempCextend%var%array1, 
    … …  
    18221824      REAL, DIMENSION(indmin(1):indmax(1), 
    18231825     &                 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 
    18241830      INTEGER :: i,j 
    18251831      INTEGER :: coeffraf,locind_child_left 
    18261832C 
     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 
    18271866      do j = pttab_child(nbdim),petab_child(nbdim) 
    18281867C 
     1868!---CDIR NEXPAND 
    18291869        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),     
    18301870     &         tabtemp(:,j), 
    … …  
    18361876C 
    18371877      enddo 
    1838        
     1878      ENDIF 
     1879      tabtemp_trsp = TRANSPOSE(tabtemp)  
     1880      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim)) 
     1881     
     1882!---CDIR NEXPAND 
    18391883      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
    18401884     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    18411885C 
     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 
    18421919      do i = indmin(1),indmax(1) 
    18431920C 
     1921!---CDIR NEXPAND 
    18441922        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), 
    18471925     &           indmin(nbdim),indmax(nbdim), 
    18481926     &           pttab_child(nbdim),petab_child(nbdim), 
    … …  
    18521930C         
    18531931      enddo 
     1932       
     1933      ENDIF 
     1934 
     1935      tempP = TRANSPOSE(tempP_trsp) 
    18541936C 
    18551937      Return 
    … …  
    19021984C 
    19031985C 
     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 
    19042029      do k = pttab_child(nbdim),petab_child(nbdim) 
    19052030C 
    … …  
    19142039      enddo 
    19152040C 
     2041      precomputedone(1) = .FALSE. 
     2042      precomputedone(2) = .FALSE. 
     2043      coeffraf = nint ( ds_parent(3) / ds_child(3) ) 
     2044 
    19162045      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
    19172046     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    … …  
    19302059               
    19312060      ELSE 
     2061      tempP = 0. 
    19322062C 
    19332063      do j = indmin(2),indmax(2) 
    … …  
    20212151     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    20222152C 
     2153      tempP = 0. 
     2154 
    20232155      do k = indmin(3),indmax(3) 
    20242156C 
    … …  
    21202252      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
    21212253     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
     2254      tempP = 0. 
    21222255C 
    21232256      do l = indmin(4),indmax(4) 
    … …  
    22322365     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    22332366C 
     2367      tempP = 0. 
     2368 
    22342369      do m = indmin(5),indmax(5) 
    22352370      do l = indmin(4),indmax(4) 
    … …  
    23072442C 
    23082443        elseif (TypeUpdate == AGRIF_Update_average) then 
    2309 C              
     2444C            
    23102445          Call average1D 
    23112446     &       (parenttab,childtab, 
    23122447     &          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)  
    23142449C 
    23152450        elseif (TypeUpdate == AGRIF_Update_full_weighting) then 
    … …  
    24212556#endif 
    24222557            
    2423       End Module Agrif_Update 
    24242558 
    24252559C     ************************************************************************** 
    … …  
    24432577C 
    24442578C     Arguments 
    2445       USE Agrif_Update 
    24462579      INTEGER                   :: nbdim 
    24472580      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average) 
    … …  
    24662599     &                  ds_parent(nbdim),ds_child(nbdim), 
    24672600     &                  coeffraf,locind_child_left) 
     2601 
    24682602C 
    24692603      Return 
    … …  
    24712605C 
    24722606      End Subroutine Agrif_Update_1D_recursive       
     2607 
     2608      End Module Agrif_Update 
Note: See TracChangeset for help on using the changeset viewer.