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 662 for trunk/AGRIF/AGRIF_FILES/modupdate.F – NEMO

Ignore:
Timestamp:
2007-05-25T17:58:52+02:00 (17 years ago)
Author:
opalod
Message:

RB: update Agrif internal routines with a new update scheme and performance improvment

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/AGRIF_FILES/modupdate.F

    r396 r662  
    8585C       
    8686C     Values on the current grid used for the update 
    87       childtemp % var % array1 => tab       
     87      childtemp % var % array1 => tab      
     88       
     89C      childtemp % var % list_update => child%var%list_update 
     90              
    8891C 
    8992      
    … …  
    9699      ENDIF      
    97100C       
     101C      child % var % list_update => childtemp%var%list_update 
     102       
    98103      deallocate(childtemp % var) 
    99104C 
    … …  
    146151C     Values on the current grid used for the update 
    147152      childtemp % var % array2 => tab       
     153       
     154C      childtemp % var % list_update => child%var%list_update       
    148155C 
    149156      IF (present(procname)) THEN 
    … …  
    155162      ENDIF 
    156163C       
     164C      child % var % list_update => childtemp%var%list_update 
     165       
    157166      deallocate(childtemp % var) 
    158167C 
    … …  
    204213C     Values on the current grid used for the update 
    205214      childtemp % var % array3 => tab      
     215       
     216C      childtemp % var % list_update => child%var%list_update       
    206217C 
    207218      IF (present(procname)) THEN 
    … …  
    213224      ENDIF 
    214225C       
     226C      child % var % list_update => childtemp%var%list_update 
     227       
    215228      DEALLOCATE(childtemp % var) 
    216229C 
    … …  
    262275C     Values on the current grid used for the update 
    263276      childtemp % var % array4 => tab      
     277       
     278C      childtemp % var % list_update => child%var%list_update 
     279             
    264280C 
    265281      IF (present(procname)) THEN 
    … …  
    270286     &     (TypeUpdate,parent,child,deb,fin) 
    271287      ENDIF 
     288 
     289C      child % var % list_update => childtemp%var%list_update       
    272290C 
    273291      deallocate(childtemp % var) 
    … …  
    322340C     Values on the current grid used for the update 
    323341      childtemp % var % array5 => tab       
     342       
     343C      childtemp % var % list_update => child%var%list_update       
    324344C 
    325345      IF (present(procname)) THEN 
    … …  
    330350     &     (TypeUpdate,parent,child,deb,fin) 
    331351      ENDIF 
     352       
     353C      child % var % list_update => childtemp%var%list_update 
     354             
    332355C       
    333356      deallocate(childtemp % var) 
    … …  
    380403C     Values on the current grid used for the update 
    381404      childtemp % var % array6 => tab       
     405C      childtemp % var % list_update => child%var%list_update 
    382406C 
    383407      Call Agrif_UpdateVariable 
    384408     &     (TypeUpdate,parent,child,deb,fin) 
     409      
     410C      child % var % list_update => childtemp%var%list_update 
     411            
    385412C       
    386413      deallocate(childtemp % var) 
    … …  
    658685 
    659686        IF (posvartab_child(i) == 1) THEN 
    660           IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
     687          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     688            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1) 
     689            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)         
     690          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
    661691            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2 
    662692            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2 
    … …  
    665695          indtab(i,1,1) = indtab(i,1,1) - coeffraf 
    666696          indtab(i,1,2) = indtab(i,1,2) - 1 
     697          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) 
     698     &                            .AND.(mod(coeffraf,2) == 1)) THEN 
     699            indtab(i,1,1) = indtab(i,1,1) - 1 
     700            indtab(i,1,2) = indtab(i,1,2) + 1 
     701          ENDIF 
    667702        ENDIF 
    668703        IF (loctab_child(i) == -3) THEN 
    … …  
    832867 
    833868        IF (posvartab_child(i) == 1) THEN 
    834           IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
     869          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     870            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1) 
     871            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)         
     872          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
    835873            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2 
    836874            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2 
    … …  
    840878          indtab(i,1,2) = indtab(i,1,2) - 1 
    841879          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1 
     880          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     881            indtab(i,1,1) = indtab(i,1,1) - 1 
     882            indtab(i,1,2) = indtab(i,1,2) + 1 
     883            indtab(i,2,1) = indtab(i,2,1) - 1 
     884            indtab(i,2,2) = indtab(i,2,2) + 1 
     885          ENDIF           
    842886        ENDIF 
    843887      ENDDO 
    … …  
    952996     &              ds_Child(1:nbdim),ds_Parent(1:nbdim), 
    953997     &              posvartab_Child,loctab_Child, 
    954      &              nbdim,procname) 
     998     &              nbdim,procname,nb,ndir) 
    955999           ELSE 
    9561000              Call Agrif_UpdatenD               
    … …  
    9851029     &                          ds_Child,ds_Parent, 
    9861030     &                          posvartab_Child,loctab_Child, 
    987      &                          nbdim,procname)   
     1031     &                          nbdim,procname,nb,ndir)   
    9881032C 
    9891033C     Description: 
    … …  
    10301074      External :: procname 
    10311075      Optional ::  procname 
     1076      Integer :: nb,ndir 
     1077      Optional :: nb,ndir 
     1078       
    10321079C 
    10331080C     Local pointers 
    1034       TYPE(AGRIF_PVARIABLE)      :: tempP      ! Temporary parent grid variable 
    1035       TYPE(AGRIF_PVARIABLE)      :: tempC      ! Temporary child grid variable 
     1081      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable 
     1082      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable 
    10361083C 
    10371084C     Local scalars 
    … …  
    10471094      INTEGER,DIMENSION(nbdim,2,2) :: childarray 
    10481095      INTEGER,DIMENSION(nbdim,2,2) :: parentarray 
    1049       TYPE(AGRIF_PVARIABLE)      :: tempCextend,tempPextend ! Temporary child 
    1050                                                             !    grid 
     1096      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child 
     1097      INTEGER :: nbin, ndirin 
    10511098C 
    10521099#ifdef AGRIF_MPI 
    … …  
    10571104      INTEGER,DIMENSION(nbdim,4)           :: tab3 
    10581105      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 
    1059       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t 
    1060 ccccccccccccccc      TYPE(AGRIF_PVARIABLE)                :: childvalues 
     1106      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 
     1107      LOGICAL :: find_list_update 
     1108      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 
     1109      LOGICAL, DIMENSION(1) :: memberin1       
    10611110C 
    10621111#endif 
    … …  
    11191168#endif 
    11201169 
    1121  
     1170       IF (present(procname)) THEN 
     1171       IF (.Not.present(nb)) THEN 
     1172       nbin=0 
     1173       ndirin=0 
     1174       ELSE 
     1175       nbin = nb 
     1176       ndirin = ndir 
     1177       ENDIF 
     1178       ENDIF 
     1179        
    11221180      IF (memberin) THEN 
    1123       allocate(tempC%var) 
     1181      IF (.not.associated(tempC%var)) allocate(tempC%var) 
    11241182 
    11251183C 
    … …  
    11361194          CALL procname(tempC%var%array1, 
    11371195     &                          childarray(1,1,2),childarray(1,2,2), 
    1138      &                                   .TRUE.) 
     1196     &                                   .TRUE.,nbin,ndirin) 
    11391197        CASE(2) 
    11401198          CALL procname(tempC%var%array2, 
    11411199     &                          childarray(1,1,2),childarray(1,2,2), 
    11421200     &                          childarray(2,1,2),childarray(2,2,2), 
    1143      &                                   .TRUE.) 
     1201     &                                   .TRUE.,nbin,ndirin) 
    11441202        CASE(3) 
    11451203          CALL procname(tempC%var%array3, 
    … …  
    11471205     &                          childarray(2,1,2),childarray(2,2,2), 
    11481206     &                          childarray(3,1,2),childarray(3,2,2), 
    1149      &                                   .TRUE.) 
     1207     &                                   .TRUE.,nbin,ndirin) 
    11501208        CASE(4) 
    11511209          CALL procname(tempC%var%array4, 
    … …  
    11541212     &                          childarray(3,1,2),childarray(3,2,2), 
    11551213     &                          childarray(4,1,2),childarray(4,2,2), 
    1156      &                                   .TRUE.) 
     1214     &                                   .TRUE.,nbin,ndirin) 
    11571215        CASE(5) 
    11581216          CALL procname(tempC%var%array5, 
    … …  
    11621220     &                          childarray(4,1,2),childarray(4,2,2), 
    11631221     &                          childarray(5,1,2),childarray(5,2,2), 
    1164      &                                   .TRUE.) 
     1222     &                                   .TRUE.,nbin,ndirin) 
    11651223        CASE(6) 
    11661224          CALL procname(tempC%var%array6, 
    … …  
    11711229     &                          childarray(5,1,2),childarray(5,2,2), 
    11721230     &                          childarray(6,1,2),childarray(6,2,2), 
    1173      &                                   .TRUE.) 
     1231     &                                   .TRUE.,nbin,ndirin) 
    11741232        END SELECT 
    11751233      ELSE 
    … …  
    11891247C     tab2 contains the necessary limits of the parent grid for each processor 
    11901248 
     1249      IF (Associated(child%var%list_update)) THEN 
     1250      Call Agrif_Find_list_update(child%var%list_update,pttab,petab, 
     1251     &                          pttab_Child,pttab_Parent,nbdim, 
     1252     &       find_list_update,tab4t,tab5t,memberinall,memberinall2) 
     1253      ELSE 
     1254      find_list_update = .FALSE. 
     1255      ENDIF 
     1256       
     1257      if (.not.find_list_update) then       
    11911258      tab3(:,1) = pttruetab(:) 
    11921259      tab3(:,2) = cetruetab(:) 
    … …  
    11981265     &                   MPI_INTEGER,MPI_COMM_WORLD,code) 
    11991266 
    1200       Allocate(tempCextend%var) 
     1267      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var) 
    12011268      DO k=0,Agrif_Nbprocs-1 
    12021269       do j=1,4 
    … …  
    12061273       enddo 
    12071274      enddo 
     1275       
     1276      memberin1(1) = memberin 
     1277      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 
     1278     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
     1279            
     1280      endif 
     1281       
    12081282      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1), 
    12091283     &            tab4t(:,:,2), 
    1210      &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin) 
     1284     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin, 
     1285     &            memberinall) 
    12111286 
    12121287#else 
    … …  
    12211296      IF (memberin) THEN 
    12221297 
    1223       allocate(tempP%var) 
     1298      IF (.not.associated(tempP%var)) allocate(tempP%var) 
    12241299      Call Agrif_nbdim_allocation(tempP%var, 
    12251300     &                 indmin,indmax,nbdim) 
    … …  
    12761351 
    12771352      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim) 
    1278       Deallocate(tempCextend%var) 
     1353C      Deallocate(tempCextend%var) 
    12791354 
    12801355      ENDIF 
    … …  
    13011376      Call Agrif_ParentGrid_to_ChildGrid() 
    13021377 
     1378      if (.not.find_list_update) then 
    13031379      tab3(:,1) = indmin(:) 
    13041380      tab3(:,2) = indmax(:) 
    … …  
    13091385     &                   MPI_INTEGER,MPI_COMM_WORLD,code) 
    13101386 
    1311       Allocate(tempPextend%var) 
     1387      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var) 
    13121388      DO k=0,Agrif_Nbprocs-1 
    13131389       do j=1,4 
    13141390         do i=1,nbdim 
    1315          tab4t(i,k,j) = tab4(i,j,k) 
     1391         tab5t(i,k,j) = tab4(i,j,k) 
    13161392         enddo 
    13171393       enddo 
    13181394      enddo 
    1319       Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1), 
    1320      &            tab4t(:,:,2), 
    1321      &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,member) 
     1395  
     1396      memberin1(1) = member 
     1397      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2, 
     1398     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
     1399      
     1400      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab, 
     1401     &                          pttab_Child,pttab_Parent,nbdim 
     1402     &   ,tab4t,tab5t,memberinall,memberinall2)  
     1403           
     1404      endif 
     1405       
     1406      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1), 
     1407     &            tab5t(:,:,2), 
     1408     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member, 
     1409     &            memberinall2) 
    13221410 
    13231411#else 
    … …  
    14071495     &                      parentarray(1,1,1):parentarray(1,2,1)), 
    14081496     &                      parentarray(1,1,2),parentarray(1,2,2), 
    1409      &                                   .FALSE. 
     1497     &                                   .FALSE.,nbin,ndirin 
    14101498     &                      ) 
    14111499            CASE(2) 
    … …  
    14161504     &                      parentarray(1,1,2),parentarray(1,2,2), 
    14171505     &                      parentarray(2,1,2),parentarray(2,2,2), 
    1418      &                                   .FALSE. 
     1506     &                                   .FALSE.,nbin,ndirin 
    14191507     &                      ) 
    14201508            CASE(3) 
    … …  
    14271515     &                      parentarray(2,1,2),parentarray(2,2,2), 
    14281516     &                      parentarray(3,1,2),parentarray(3,2,2), 
    1429      &                                   .FALSE. 
     1517     &                                   .FALSE.,nbin,ndirin 
    14301518     &                      ) 
    14311519            CASE(4) 
    … …  
    14401528     &                      parentarray(3,1,2),parentarray(3,2,2), 
    14411529     &                      parentarray(4,1,2),parentarray(4,2,2), 
    1442      &                                   .FALSE. 
     1530     &                                   .FALSE.,nbin,ndirin 
    14431531     &                      ) 
    14441532            CASE(5) 
    … …  
    14551543     &                      parentarray(4,1,2),parentarray(4,2,2), 
    14561544     &                      parentarray(5,1,2),parentarray(5,2,2), 
    1457      &                                   .FALSE. 
     1545     &                                   .FALSE.,nbin,ndirin 
    14581546     &                      ) 
    14591547            CASE(6) 
    … …  
    14721560     &                      parentarray(5,1,2),parentarray(5,2,2), 
    14731561     &                      parentarray(6,1,2),parentarray(6,2,2), 
    1474      &                                   .FALSE. 
     1562     &                                   .FALSE.,nbin,ndirin 
    14751563     &                      ) 
    14761564            END SELECT 
    … …  
    15451633      Call Agrif_nbdim_deallocation(tempP%var,nbdim) 
    15461634      Call Agrif_nbdim_deallocation(tempC%var,nbdim) 
    1547       Deallocate(tempC % var) 
     1635!      Deallocate(tempC % var) 
    15481636#endif 
    1549       Deallocate(tempP % var) 
     1637!      Deallocate(tempP % var) 
    15501638      ENDIF 
    15511639#ifdef AGRIF_MPI 
    1552       Deallocate(tempPextend%var) 
    1553       IF (.Not.memberin) Deallocate(tempCextend%var) 
     1640!      Deallocate(tempPextend%var) 
     1641!      IF (.Not.memberin) Deallocate(tempCextend%var) 
    15541642#endif 
    15551643 
    … …  
    16281716        IF (loctab_Child(i) .NE. -3) THEN 
    16291717        IF (posvartab_child(i) == 1) THEN 
    1630           IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
    1631         positionmin = positionmin - ds_Parent(i)/2. 
     1718          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN 
     1719          positionmin = positionmin - ds_Parent(i)/2. 
     1720          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     1721          positionmin = positionmin - (ds_Parent(i)-ds_Child(i)) 
    16321722          ENDIF 
    16331723        ELSE 
    16341724        positionmin = positionmin - ds_Parent(i)/2. 
     1725        IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     1726          positionmin = positionmin - ds_Child(i) 
     1727        ENDIF 
    16351728        ENDIF 
    16361729        ENDIF 
    … …  
    16471740        IF (loctab_Child(i) .NE. -3) THEN 
    16481741        IF (posvartab_child(i) == 1) THEN 
    1649           IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN 
     1742          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN 
    16501743        positionmax = positionmax  + ds_Parent(i)/2. 
     1744          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     1745          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i)) 
    16511746          ENDIF 
    16521747        ELSE 
    16531748        positionmax = positionmax  + ds_Parent(i)/2. 
     1749        IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
     1750          positionmax = positionmax + ds_Child(i) 
     1751        ENDIF         
    16541752        ENDIF 
    16551753        ENDIF 
    … …  
    16841782C 
    16851783C 
    1686 C     ************************************************************************** 
    1687 CCC   Subroutine Agrif_Update_1D_Recursive 
    1688 C     ************************************************************************** 
    1689 C 
    1690       Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC, 
    1691      &                                     indmin,indmax, 
    1692      &                                     pttab_child,petab_child, 
    1693      &                                     s_child,s_parent, 
    1694      &                                     ds_child,ds_parent,nbdim) 
    1695 C 
    1696 CCC   Description: 
    1697 CCC   Subroutine to update a 1D grid variable on the parent grid. 
    1698 C 
    1699 CC    Method: 
    1700 C 
    1701 C     Declarations: 
    1702 C 
    1703        
    1704 C 
    1705 C     Arguments 
    1706       INTEGER                   :: nbdim 
    1707       INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average) 
    1708       INTEGER, DIMENSION(nbdim) :: indmin,indmax 
    1709       INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child 
    1710       REAL, DIMENSION(nbdim)    :: s_child,s_parent 
    1711       REAL, DIMENSION(nbdim)    :: ds_child,ds_parent 
    1712       REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP 
    1713       REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC 
    1714 C 
    1715 C 
    1716       Call Agrif_UpdateBase(TypeUpdate(1), 
    1717      &                  tempP(indmin(nbdim):indmax(nbdim)), 
    1718      &                  tempC(pttab_child(nbdim):petab_child(nbdim)), 
    1719      &                  indmin(nbdim),indmax(nbdim),            
    1720      &                  pttab_child(nbdim),petab_child(nbdim), 
    1721      &                  s_parent(nbdim),s_child(nbdim), 
    1722      &                  ds_parent(nbdim),ds_child(nbdim)) 
    1723 C 
    1724       Return 
    1725 C 
    1726 C 
    1727       End Subroutine Agrif_Update_1D_recursive 
     1784 
    17281785C 
    17291786C 
    … …  
    17341791C 
    17351792      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC, 
    1736      &                                     indmin,indmax,    
     1793     &                                     indmin,indmax, 
    17371794     &                                     pttab_child,petab_child, 
    17381795     &                                     s_child,s_parent, 
    … …  
    17571814      REAL, DIMENSION(indmin(1):indmax(1), 
    17581815     &                indmin(2):indmax(2))           :: tempP 
    1759       REAL, DIMENSION(pttab_child(1):petab_child(1), 
    1760      &                pttab_child(2):petab_child(2)) :: tempC 
     1816C      REAL, DIMENSION(pttab_child(1):petab_child(1), 
     1817C     &                pttab_child(2):petab_child(2)) :: tempC 
     1818      
     1819      REAL, DIMENSION(:,:) :: tempC      
    17611820C 
    17621821C     Local variables       
    1763       REAL, DIMENSION(:,:), Allocatable :: tabtemp 
     1822      REAL, DIMENSION(indmin(1):indmax(1), 
     1823     &                 pttab_child(2):petab_child(2)) :: tabtemp 
    17641824      INTEGER :: i,j 
    1765 C 
    1766 C 
    1767       Allocate(tabtemp(indmin(1):indmax(1), 
    1768      &                 pttab_child(2):petab_child(2))) 
     1825      INTEGER :: coeffraf,locind_child_left 
    17691826C 
    17701827      do j = pttab_child(nbdim),petab_child(nbdim) 
    17711828C 
    1772         Call Agrif_Update_1D_recursive(TypeUpdate,     
    1773      &         tabtemp(indmin(nbdim-1):indmax(nbdim-1),j), 
    1774      &         tempC(pttab_child(nbdim-1):petab_child(nbdim-1),j), 
     1829        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),     
     1830     &         tabtemp(:,j), 
     1831     &         tempC(:,j-pttab_child(nbdim)+1), 
    17751832     &         indmin(1:nbdim-1),indmax(1:nbdim-1), 
    17761833     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1), 
    … …  
    17791836C 
    17801837      enddo 
     1838       
     1839      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     1840     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    17811841C 
    17821842      do i = indmin(1),indmax(1) 
    17831843C 
    17841844        Call Agrif_UpdateBase(TypeUpdate(2), 
    1785      &           tempP(i,indmin(nbdim):indmax(nbdim)), 
    1786      &          tabtemp(i,pttab_child(nbdim):petab_child(nbdim)), 
     1845     &           tempP(i,:), 
     1846     &          tabtemp(i,:), 
    17871847     &           indmin(nbdim),indmax(nbdim), 
    17881848     &           pttab_child(nbdim),petab_child(nbdim), 
    17891849     &           s_parent(nbdim),s_child(nbdim), 
    1790      &           ds_parent(nbdim),ds_child(nbdim)) 
     1850     &           ds_parent(nbdim),ds_child(nbdim), 
     1851     &                  coeffraf,locind_child_left) 
    17911852C         
    17921853      enddo 
    1793 C 
    1794       Deallocate(tabtemp) 
    17951854C 
    17961855      Return 
    … …  
    18351894C 
    18361895C     Local variables       
    1837       REAL, DIMENSION(:,:,:), Allocatable :: tabtemp 
     1896      REAL, DIMENSION(indmin(1):indmax(1), 
     1897     &                 indmin(2):indmax(2),  
     1898     &                 pttab_child(3):petab_child(3)) :: tabtemp 
    18381899      INTEGER :: i,j,k 
    1839 C 
    1840 C 
    1841       Allocate(tabtemp(indmin(1):indmax(1), 
    1842      &                 indmin(2):indmax(2),  
    1843      &                 pttab_child(3):petab_child(3))) 
     1900      INTEGER :: coeffraf,locind_child_left 
     1901      INTEGER :: kdeb 
     1902C 
    18441903C 
    18451904      do k = pttab_child(nbdim),petab_child(nbdim) 
    18461905C 
    1847         Call Agrif_Update_2D_recursive(TypeUpdate,     
    1848      &         tabtemp(indmin(nbdim-2):indmax(nbdim-2), 
    1849      &                 indmin(nbdim-1):indmax(nbdim-1),k), 
    1850      &         tempC(pttab_child(nbdim-2):petab_child(nbdim-2), 
    1851      &               pttab_child(nbdim-1):petab_child(nbdim-1),k), 
     1906        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),     
     1907     &         tabtemp(:,:,k), 
     1908     &         tempC(:,:,k), 
    18521909     &         indmin(1:nbdim-1),indmax(1:nbdim-1), 
    18531910     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1), 
    … …  
    18571914      enddo 
    18581915C 
    1859 C 
     1916      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     1917     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
     1918       
     1919      IF (coeffraf == 1) THEN 
     1920       
     1921      kdeb = pttab_child(3)+locind_child_left-2 
     1922      do k=indmin(3),indmax(3) 
     1923      kdeb = kdeb + 1 
    18601924      do j = indmin(2),indmax(2) 
    1861 C 
    18621925        do i = indmin(1),indmax(1) 
     1926        tempP(i,j,k) = tabtemp(i,j,kdeb) 
     1927      enddo 
     1928      enddo 
     1929      enddo 
     1930               
     1931      ELSE 
     1932C 
     1933      do j = indmin(2),indmax(2) 
     1934C 
     1935        do i = indmin(1),indmax(1) 
    18631936C 
    18641937          Call Agrif_UpdateBase(TypeUpdate(3), 
    1865      &           tempP(i,j,indmin(nbdim):indmax(nbdim)), 
    1866      &          tabtemp(i,j,pttab_child(nbdim):petab_child(nbdim)), 
     1938     &           tempP(i,j,:), 
     1939     &          tabtemp(i,j,:), 
    18671940     &           indmin(nbdim),indmax(nbdim), 
    18681941     &           pttab_child(nbdim),petab_child(nbdim), 
    18691942     &           s_parent(nbdim),s_child(nbdim), 
    1870      &           ds_parent(nbdim),ds_child(nbdim)) 
     1943     &           ds_parent(nbdim),ds_child(nbdim), 
     1944     &                  coeffraf,locind_child_left) 
    18711945C 
    18721946        enddo  
    18731947C         
    18741948      enddo 
    1875 C 
    1876       Deallocate(tabtemp) 
     1949      ENDIF 
    18771950C 
    18781951      Return 
    … …  
    19211994      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp 
    19221995      INTEGER :: i,j,k,l 
     1996      INTEGER :: coeffraf,locind_child_left 
    19231997C 
    19241998C 
    … …  
    19302004      do l = pttab_child(nbdim),petab_child(nbdim) 
    19312005C 
    1932         Call Agrif_Update_3D_recursive(TypeUpdate,     
     2006        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),     
    19332007     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3), 
    19342008     &                 indmin(nbdim-2):indmax(nbdim-2), 
    … …  
    19432017C 
    19442018      enddo 
     2019       
     2020      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     2021     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    19452022C 
    19462023      do k = indmin(3),indmax(3) 
    … …  
    19562033     &           pttab_child(nbdim),petab_child(nbdim), 
    19572034     &           s_parent(nbdim),s_child(nbdim), 
    1958      &           ds_parent(nbdim),ds_child(nbdim)) 
     2035     &           ds_parent(nbdim),ds_child(nbdim), 
     2036     &                  coeffraf,locind_child_left) 
    19592037C 
    19602038          enddo  
    … …  
    20132091      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp 
    20142092      INTEGER :: i,j,k,l,m 
     2093      INTEGER :: coeffraf,locind_child_left 
    20152094C 
    20162095C 
    … …  
    20232102      do m = pttab_child(nbdim),petab_child(nbdim) 
    20242103C 
    2025         Call Agrif_Update_4D_recursive(TypeUpdate,     
     2104        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),     
    20262105     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4), 
    20272106     &                 indmin(nbdim-3):indmax(nbdim-3), 
    … …  
    20382117C 
    20392118      enddo 
     2119       
     2120      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     2121     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    20402122C 
    20412123      do l = indmin(4),indmax(4) 
    … …  
    20542136     &           pttab_child(nbdim),petab_child(nbdim), 
    20552137     &           s_parent(nbdim),s_child(nbdim), 
    2056      &           ds_parent(nbdim),ds_child(nbdim)) 
     2138     &           ds_parent(nbdim),ds_child(nbdim), 
     2139     &                  coeffraf,locind_child_left) 
    20572140C 
    20582141            enddo 
    … …  
    21162199      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp 
    21172200      INTEGER :: i,j,k,l,m,n 
     2201      INTEGER :: coeffraf,locind_child_left 
    21182202C 
    21192203C 
    … …  
    21272211      do n = pttab_child(nbdim),petab_child(nbdim) 
    21282212C 
    2129         Call Agrif_Update_5D_recursive(TypeUpdate,     
     2213        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),     
    21302214     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5), 
    21312215     &                 indmin(nbdim-4):indmax(nbdim-4), 
    … …  
    21442228C 
    21452229      enddo 
     2230       
     2231      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     2232     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
    21462233C 
    21472234      do m = indmin(5),indmax(5) 
    … …  
    21612248     &           pttab_child(nbdim),petab_child(nbdim), 
    21622249     &           s_parent(nbdim),s_child(nbdim), 
    2163      &           ds_parent(nbdim),ds_child(nbdim)) 
     2250     &           ds_parent(nbdim),ds_child(nbdim), 
     2251     &                  coeffraf,locind_child_left) 
    21642252C 
    21652253            enddo 
    … …  
    21882276     &                            parenttab,childtab, 
    21892277     &                            indmin,indmax,pttab_child,petab_child, 
    2190      &                            s_parent,s_child,ds_parent,ds_child) 
     2278     &                            s_parent,s_child,ds_parent,ds_child, 
     2279     &                            coeffraf,locind_child_left) 
    21912280C 
    21922281CCC   Description: 
    … …  
    22062295      REAL,DIMENSION(pttab_child:petab_child) :: childtab       
    22072296      REAL    :: s_parent,s_child 
    2208       REAL    :: ds_parent,ds_child        
     2297      REAL    :: ds_parent,ds_child       
     2298      INTEGER :: coeffraf,locind_child_left 
    22092299C 
    22102300C 
    22112301      if (TypeUpdate == AGRIF_Update_copy) then 
    22122302C              
    2213           Call copy1D 
     2303          Call agrif_copy1D 
    22142304     &       (parenttab,childtab, 
    22152305     &          indmax-indmin+1,petab_child-pttab_child+1, 
    … …  
    22282318     &       (parenttab,childtab, 
    22292319     &          indmax-indmin+1,petab_child-pttab_child+1, 
    2230      &          s_parent,s_child,ds_parent,ds_child) 
     2320     &          s_parent,s_child,ds_parent,ds_child, 
     2321     &          coeffraf,locind_child_left) 
    22312322C 
    22322323      endif  
    … …  
    22382329C 
    22392330C 
     2331 
     2332      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child, 
     2333     &  ds_parent,ds_child,coeffraf,locind_child_left) 
     2334      real :: s_parent,s_child,ds_parent,ds_child 
     2335      integer :: coeffraf,locind_child_left 
     2336      
     2337      coeffraf = nint(ds_parent/ds_child) 
     2338      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child) 
     2339       
     2340      End Subroutine Agrif_Compute_nbdim_update 
     2341  
     2342#if defined AGRIF_MPI       
     2343      Subroutine Agrif_Find_list_update(list_update,pttab,petab, 
     2344     &                          pttab_Child,pttab_Parent,nbdim, 
     2345     &     find_list_update,tab4t,tab5t,memberinall,memberinall2)      
     2346      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 
     2347      INTEGER :: nbdim 
     2348      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent 
     2349      LOGICAL :: find_list_update 
     2350      Type(Agrif_List_Interp_loc), Pointer :: parcours 
     2351      INTEGER :: i 
     2352C 
     2353      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 
     2354      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2 
     2355                     
     2356      find_list_update = .FALSE. 
     2357       
     2358      parcours => list_update 
     2359       
     2360      Find_loop :   Do While (associated(parcours)) 
     2361        Do i=1,nbdim 
     2362          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR. 
     2363     &        (petab(i) /= parcours%interp_loc%petab(i)).OR. 
     2364     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR. 
     2365     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i))) 
     2366     &               THEN 
     2367            parcours=>parcours%suiv 
     2368            Cycle Find_loop 
     2369          ENDIF 
     2370        EndDo 
     2371         
     2372        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:4) 
     2373        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1) 
     2374         
     2375        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:4) 
     2376        memberinall2 =  
     2377     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1) 
     2378         
     2379        find_list_update = .TRUE.    
     2380        Exit Find_loop 
     2381      End Do Find_loop   
     2382                               
     2383      End Subroutine Agrif_Find_list_update   
     2384       
     2385      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab, 
     2386     &                          pttab_Child,pttab_Parent,nbdim 
     2387     &      ,tab4t,tab5t,memberinall,memberinall2) 
     2388           
     2389      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update 
     2390      INTEGER :: nbdim 
     2391      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent 
     2392      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t, tab5t 
     2393      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 
     2394 
     2395      Type(Agrif_List_Interp_loc), Pointer :: parcours 
     2396             
     2397       Allocate(parcours) 
     2398      Allocate(parcours%interp_loc) 
     2399       
     2400      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim) 
     2401      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim) 
     2402      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim) 
     2403      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim) 
     2404      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,4)) 
     2405      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)) 
     2406       
     2407      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,4)) 
     2408      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)) 
     2409             
     2410      parcours%interp_loc%tab4t=tab4t    
     2411      parcours%interp_loc%memberinall=memberinall 
     2412  
     2413      parcours%interp_loc%tab5t=tab5t    
     2414      parcours%interp_loc%memberinall2=memberinall2 
     2415             
     2416      parcours%suiv => list_update 
     2417       
     2418      list_update => parcours 
     2419       
     2420      End Subroutine Agrif_Addto_list_update 
     2421#endif 
     2422            
    22402423      End Module Agrif_Update 
    22412424 
    2242  
    2243  
    2244        
     2425C     ************************************************************************** 
     2426CCC   Subroutine Agrif_Update_1D_Recursive 
     2427C     ************************************************************************** 
     2428C 
     2429      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC, 
     2430     &                                     indmin,indmax, 
     2431     &                                     pttab_child,petab_child, 
     2432     &                                     s_child,s_parent, 
     2433     &                                     ds_child,ds_parent,nbdim) 
     2434C 
     2435CCC   Description: 
     2436CCC   Subroutine to update a 1D grid variable on the parent grid. 
     2437C 
     2438CC    Method: 
     2439C 
     2440C     Declarations: 
     2441C 
     2442       
     2443C 
     2444C     Arguments 
     2445      USE Agrif_Update 
     2446      INTEGER                   :: nbdim 
     2447      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average) 
     2448      INTEGER, DIMENSION(nbdim) :: indmin,indmax 
     2449      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child 
     2450      REAL, DIMENSION(nbdim)    :: s_child,s_parent 
     2451      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent 
     2452      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP 
     2453      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC 
     2454      INTEGER :: coeffraf,locind_child_left 
     2455C 
     2456C 
     2457      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim), 
     2458     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left) 
     2459       
     2460      Call Agrif_UpdateBase(TypeUpdate(1), 
     2461     &                  tempP(indmin(nbdim):indmax(nbdim)), 
     2462     &                  tempC(pttab_child(nbdim):petab_child(nbdim)), 
     2463     &                  indmin(nbdim),indmax(nbdim),            
     2464     &                  pttab_child(nbdim),petab_child(nbdim), 
     2465     &                  s_parent(nbdim),s_child(nbdim), 
     2466     &                  ds_parent(nbdim),ds_child(nbdim), 
     2467     &                  coeffraf,locind_child_left) 
     2468C 
     2469      Return 
     2470C 
     2471C 
     2472      End Subroutine Agrif_Update_1D_recursive       
Note: See TracChangeset for help on using the changeset viewer.