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/modinterp.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/modinterp.F

    r662 r779  
    4242C       
    4343      IMPLICIT NONE 
     44      logical,  private:: precomputedone(7) = .FALSE. 
    4445C 
    4546      CONTAINS 
    … …  
    13511352     &                  s_parent(nbdim),s_child(nbdim), 
    13521353     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf) 
     1354                 
    13531355C                 
    13541356      Return 
    … …  
    13991401      INTEGER i,j 
    14001402      INTEGER :: coeffraf 
     1403      REAL   , DIMENSION( 
     1404     &                pttab_child(nbdim):petab_child(nbdim), 
     1405     &                pttab_child(nbdim-1):petab_child(nbdim-1) 
     1406     &                ) :: tabout_trsp 
     1407      REAL, DIMENSION(indmin(nbdim):indmax(nbdim), 
     1408     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp 
     1409 
    14011410C 
    14021411C 
    … …  
    14051414C     Commentaire perso : nbdim vaut toujours 2 ici. 
    14061415C 
     1416      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
     1417      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN 
     1418 
     1419!---CDIR NEXPAND 
     1420          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D( 
     1421     &          indmax(2)-indmin(2)+1,    
     1422     &          indmax(1)-indmin(1)+1,    
     1423     &          petab_child(1)-pttab_child(1)+1, 
     1424     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1425!---CDIR NEXPAND 
     1426           call linear1daftercompute(tabin,tabtemp, 
     1427     &          size(tabin), size(tabtemp),   
     1428     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1429  
     1430      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN 
     1431!---CDIR NEXPAND 
     1432          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D( 
     1433     &          indmax(2)-indmin(2)+1,    
     1434     &          indmax(1)-indmin(1)+1,    
     1435     &          petab_child(1)-pttab_child(1)+1, 
     1436     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1437!---CDIR NEXPAND 
     1438           call ppm1daftercompute(tabin,tabtemp, 
     1439     &          size(tabin), size(tabtemp),   
     1440     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1441 
     1442      ELSE 
     1443 
    14071444      do j = indmin(nbdim),indmax(nbdim) 
    14081445C         
     1446!---CDIR NEXPAND 
    14091447        Call Agrif_Interp_1D_recursive(TypeInterp(1), 
    14101448     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j), 
    … …  
    14161454C         
    14171455      enddo 
    1418 C         
     1456      ENDIF    
     1457 
    14191458      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim)) 
    14201459       
     1460      tabtemp_trsp = TRANSPOSE(tabtemp) 
     1461 
     1462      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN 
     1463 
     1464!---CDIR NEXPAND 
     1465          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D( 
     1466     &          petab_child(1)-pttab_child(1)+1, 
     1467     &          indmax(2)-indmin(2)+1, 
     1468     &          petab_child(2)-pttab_child(2)+1, 
     1469     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1470!---CDIR NEXPAND 
     1471           call linear1daftercompute(tabtemp_trsp,tabout_trsp, 
     1472     &          size(tabtemp_trsp), size(tabout_trsp), 
     1473     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1474 
     1475      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN 
     1476 
     1477!---CDIR NEXPAND 
     1478           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D( 
     1479     &          petab_child(1)-pttab_child(1)+1, 
     1480     &          indmax(2)-indmin(2)+1, 
     1481     &          petab_child(2)-pttab_child(2)+1, 
     1482     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1483!---CDIR NEXPAND 
     1484           call ppm1daftercompute(tabtemp_trsp,tabout_trsp, 
     1485     &          size(tabtemp_trsp), size(tabout_trsp), 
     1486     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1487 
     1488      ELSE 
    14211489      do i=pttab_child(nbdim-1),petab_child(nbdim-1) 
    14221490C 
     1491!---CDIR NEXPAND 
    14231492        Call Agrif_InterpBase(TypeInterp(2), 
    1424      &           tabtemp(i,indmin(nbdim):indmax(nbdim)), 
    1425      &                  tabout(i,pttab_child(nbdim):petab_child(nbdim)), 
     1493     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i), 
     1494     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i), 
    14261495     &           indmin(nbdim),indmax(nbdim), 
    14271496     &           pttab_child(nbdim),petab_child(nbdim), 
    14281497     &           s_parent(nbdim),s_child(nbdim), 
    14291498     &           ds_parent(nbdim),ds_child(nbdim),coeffraf) 
     1499 
    14301500C         
    14311501      enddo 
     1502      ENDIF 
     1503       
     1504      tabout = TRANSPOSE(tabout_trsp) 
    14321505C 
    14331506      Return 
    … …  
    14761549C 
    14771550C 
     1551      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
     1552      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN  
     1553        Call linear1Dprecompute2D( 
     1554     &          indmax(2)-indmin(2)+1, 
     1555     &          indmax(1)-indmin(1)+1, 
     1556     &          petab_child(1)-pttab_child(1)+1, 
     1557     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1558      precomputedone(1) = .TRUE.  
     1559      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN 
     1560        Call ppm1Dprecompute2D( 
     1561     &          indmax(2)-indmin(2)+1, 
     1562     &          indmax(1)-indmin(1)+1, 
     1563     &          petab_child(1)-pttab_child(1)+1, 
     1564     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) 
     1565      precomputedone(1) = .TRUE. 
     1566      ENDIF 
     1567 
     1568      coeffraf = nint ( ds_parent(2) / ds_child(2) ) 
     1569      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN 
     1570         Call linear1Dprecompute2D( 
     1571     &          petab_child(1)-pttab_child(1)+1, 
     1572     &          indmax(2)-indmin(2)+1, 
     1573     &          petab_child(2)-pttab_child(2)+1, 
     1574     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1575      precomputedone(2) = .TRUE.  
     1576      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN 
     1577         Call ppm1Dprecompute2D( 
     1578     &          petab_child(1)-pttab_child(1)+1, 
     1579     &          indmax(2)-indmin(2)+1, 
     1580     &          petab_child(2)-pttab_child(2)+1, 
     1581     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) 
     1582      precomputedone(2) = .TRUE. 
     1583      ENDIF 
     1584 
    14781585      do k = indmin(nbdim),indmax(nbdim) 
    14791586C         
    … …  
    14901597      enddo 
    14911598       
     1599      precomputedone(1) = .FALSE. 
     1600      precomputedone(2) = .FALSE. 
     1601      coeffraf = nint ( ds_parent(3) / ds_child(3) ) 
    14921602 
    14931603      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim), 
    … …  
    18511961       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then     
    18521962C 
    1853 C         Linear interpolation          
     1963C         Linear interpolation  
     1964   
    18541965          Call linear1D 
    18551966     &         (parenttab,childtab, 
    … …  
    18571968     &          s_parent,s_child,ds_parent,ds_child) 
    18581969C           
     1970      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then 
     1971 
     1972          Call ppm1D 
     1973     &         (parenttab,childtab, 
     1974     &         indmax-indmin+1,petab_child-pttab_child+1, 
     1975     &         s_parent,s_child,ds_parent,ds_child) 
     1976C 
     1977 
    18591978        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then 
    18601979C           
    … …  
    19062025     &         s_parent,s_child,ds_parent,ds_child) 
    19072026C               
    1908       elseif ( TYPEinterp .EQ. AGRIF_PPM ) then 
    1909           Call ppm1D          
    1910      &         (parenttab,childtab, 
    1911      &         indmax-indmin+1,petab_child-pttab_child+1, 
    1912      &         s_parent,s_child,ds_parent,ds_child) 
    1913 C 
    19142027      endif  
    19152028C 
Note: See TracChangeset for help on using the changeset viewer.