Changeset 2671 for vendors


Ignore:
Timestamp:
2011-03-08T15:08:49+01:00 (10 years ago)
Author:
rblod
Message:

Load working_directory into vendors/AGRIF/current.

Location:
vendors/AGRIF/current
Files:
2 added
40 edited

Legend:

Unmodified
Added
Removed
  • vendors/AGRIF/current/AGRIF_FILES/modarrays.F

    r1901 r2671  
    11! 
    2 ! $Id: modarrays.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modarrays.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    126126C     Local variables 
    127127C 
    128       SELECT CASE (nbdim) 
    129       CASE (1) 
    130            lower = lbound(Variable % array1,indice) 
    131            upper = ubound(Variable % array1,indice) 
    132       CASE (2) 
    133            lower = lbound(Variable % array2,indice) 
    134            upper = ubound(Variable % array2,indice) 
    135       CASE (3) 
    136            lower = lbound(Variable % array3,indice) 
    137            upper = ubound(Variable % array3,indice) 
    138       CASE (4) 
    139            lower = lbound(Variable % array4,indice) 
    140            upper = ubound(Variable % array4,indice) 
    141       CASE (5) 
    142            lower = lbound(Variable % array5,indice) 
    143            upper = ubound(Variable % array5,indice) 
    144       CASE (6) 
    145            lower = lbound(Variable % array6,indice) 
    146            upper = ubound(Variable % array6,indice) 
    147       END SELECT 
    148 C 
     128 
     129      lower = Variable % lb(indice) 
     130      upper = Variable % ub(indice) 
    149131      return 
    150132C 
  • vendors/AGRIF/current/AGRIF_FILES/modbc.F

    r1901 r2671  
    11! 
    2 ! $Id: modbc.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modbc.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    8686C       
    8787C     Values of the grid variable 
    88       childtemp % var % array1 => tab   
     88      childtemp % var % parray1 => tab   
    8989C 
    9090C     Temporary results for the time interpolation before and after the space  
     
    167167C       
    168168C     Values of the grid variable 
    169       childtemp % var % array2 => tab   
     169      childtemp % var % parray2 => tab   
    170170C 
    171171C     Temporary results for the time interpolation before and after the space  
     
    247247C       
    248248C     Values of the grid variable 
    249       childtemp % var % array3 => tab 
     249      childtemp % var % parray3 => tab 
    250250C 
    251251C     Temporary results for the time interpolation before and after the space  
     
    328328C       
    329329C     Values of the grid variable 
    330       childtemp % var % array4 => tab   
     330      childtemp % var % parray4 => tab   
    331331C 
    332332C     Temporary results for the time interpolation before and after the space  
     
    409409C       
    410410C     Values of the grid variable 
    411       childtemp % var % array5 => tab   
     411      childtemp % var % parray5 => tab   
    412412C 
    413413C     Temporary results for the time interpolation before and after the space  
     
    491491C       
    492492C     Values of the grid variable 
    493       childtemp % var % array6 => tab   
     493      childtemp % var % parray6 => tab   
    494494C 
    495495C     Temporary results for the time interpolation before and after the space  
     
    814814       
    815815      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 
    816      &                     MPI_COMM_AGRIF,code)   
     816     &                     MPI_COMM_WORLD,code)   
    817817      
    818818      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)       
     
    10671067         do ir=bounds(1,1),bounds(1,2) 
    10681068            child%var%oldvalues2d(2,kindex) = 
    1069      &           child%var%array1(ir) 
     1069     &           child%var%parray1(ir) 
    10701070            kindex = kindex + 1 
    10711071         enddo        
     
    10771077           do ir=bounds(1,1),bounds(1,2) 
    10781078            child%var%oldvalues2d(2,kindex) = 
    1079      &           child%var%array2(ir,jr) 
     1079     &           child%var%parray2(ir,jr) 
    10801080            kindex = kindex + 1 
    10811081           enddo 
     
    10881088             do ir=bounds(1,1),bounds(1,2) 
    10891089            child%var%oldvalues2d(2,kindex) = 
    1090      &           child%var%array3(ir,jr,kr) 
     1090     &           child%var%parray3(ir,jr,kr) 
    10911091            kindex = kindex + 1 
    10921092             enddo 
     
    11011101               do ir=bounds(1,1),bounds(1,2) 
    11021102            child%var%oldvalues2d(2,kindex) = 
    1103      &           child%var%array4(ir,jr,kr,lr) 
     1103     &           child%var%parray4(ir,jr,kr,lr) 
    11041104            kindex = kindex + 1 
    11051105               enddo 
     
    11161116                 do ir=bounds(1,1),bounds(1,2) 
    11171117            child%var%oldvalues2d(2,kindex) = 
    1118      &           child%var%array5(ir,jr,kr,lr,mr) 
     1118     &           child%var%parray5(ir,jr,kr,lr,mr) 
    11191119            kindex = kindex + 1 
    11201120                 enddo 
     
    11331133                   do ir=bounds(1,1),bounds(1,2) 
    11341134            child%var%oldvalues2d(2,kindex) = 
    1135      &           child%var%array6(ir,jr,kr,lr,mr,nr) 
     1135     &           child%var%parray6(ir,jr,kr,lr,mr,nr) 
    11361136            kindex = kindex + 1 
    11371137                   enddo 
     
    11841184!CDIR ALTCODE 
    11851185         do ir=bounds(1,1),bounds(1,2) 
    1186                 child%var%array1(ir) = 
     1186                child%var%parray1(ir) = 
    11871187     &           c2t*child % var % oldvalues2d(1,kindex)    
    11881188     &         + c1t*child % var % oldvalues2d(2,kindex)     
     
    11951195!CDIR ALTCODE 
    11961196           do ir=bounds(1,1),bounds(1,2) 
    1197                 child%var%array2(ir,jr) = 
     1197                child%var%parray2(ir,jr) = 
    11981198     &           c2t*child % var % oldvalues2d(1,kindex)    
    11991199     &         + c1t*child % var % oldvalues2d(2,kindex)  
     
    12071207!CDIR ALTCODE 
    12081208             do ir=bounds(1,1),bounds(1,2) 
    1209                 child%var%array3(ir,jr,kr) = 
     1209                child%var%parray3(ir,jr,kr) = 
    12101210     &           c2t*child % var % oldvalues2d(1,kindex)    
    12111211     &         + c1t*child % var % oldvalues2d(2,kindex)  
     
    12211221!CDIR ALTCODE 
    12221222               do ir=bounds(1,1),bounds(1,2) 
    1223                 child%var%array4(ir,jr,kr,lr) = 
     1223                child%var%parray4(ir,jr,kr,lr) = 
    12241224     &           c2t*child % var % oldvalues2d(1,kindex)    
    12251225     &         + c1t*child % var % oldvalues2d(2,kindex)  
     
    12371237!CDIR ALTCODE 
    12381238                 do ir=bounds(1,1),bounds(1,2) 
    1239                 child%var%array5(ir,jr,kr,lr,mr) = 
     1239                child%var%parray5(ir,jr,kr,lr,mr) = 
    12401240     &           c2t*child % var % oldvalues2d(1,kindex)    
    12411241     &         + c1t*child % var % oldvalues2d(2,kindex)  
     
    12551255!CDIR ALTCODE 
    12561256                   do ir=bounds(1,1),bounds(1,2) 
    1257                 child%var%array6(ir,jr,kr,lr,mr,nr) = 
     1257                child%var%parray6(ir,jr,kr,lr,mr,nr) = 
    12581258     &           c2t*child % var % oldvalues2d(1,kindex)    
    12591259     &         + c1t*child % var % oldvalues2d(2,kindex)  
  • vendors/AGRIF/current/AGRIF_FILES/modbcfunction.F

    r1901 r2671  
    11! 
    2 ! $Id: modbcfunction.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modbcfunction.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    3535      Use Agrif_Update 
    3636      Use Agrif_fluxmod 
     37      Use Agrif_Save 
    3738C              
    3839      IMPLICIT NONE 
     
    6566     &                     Agrif_Init_variable1d, 
    6667     &                     Agrif_Init_variable2d, 
    67      &                     Agrif_Init_variable3d 
     68     &                     Agrif_Init_variable3d, 
     69     &                     Agrif_Init_variable4d 
    6870      end interface        
    6971C 
     
    7577     &                     Agrif_update_var4d, 
    7678     &                     Agrif_update_var5d 
    77       end interface        
     79      end interface       
     80       
     81      interface Agrif_Save_Forrestore 
     82         module procedure Agrif_Save_Forrestore0d,     
     83     &                    Agrif_Save_Forrestore2d,     
     84     &                    Agrif_Save_Forrestore3d,     
     85     &                    Agrif_Save_Forrestore4d 
     86      end interface 
    7887C 
    7988      Contains  
     
    255264      LOGICAL, OPTIONAL :: Interpolationshouldbemade 
    256265C 
    257       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     266      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    258267      TYPE(Agrif_PVariable),Pointer ::tabvars 
    259268       
     
    265274C      
    266275 
    267       if (tabvarsindic <=0) then 
    268       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
    269       else 
    270       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
     276      indic = tabvarsindic 
     277      if (tabvarsindic >=0) then 
     278        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     279          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     280        endif 
     281      endif 
     282       
     283      if (indic <=0) then 
     284      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     285      else 
     286      tabvars=>Agrif_Curgrid % tabvars(indic) 
    271287      endif   
    272288       
     
    307323      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3 
    308324C 
    309       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     325      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
     326      TYPE(Agrif_PVariable),Pointer ::tabvars 
     327       
     328     
     329C 
    310330C 
    311331C     Begin  
    312332C 
    313       Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp =  
     333C      
     334      indic = tabvarsindic 
     335      if (tabvarsindic >=0) then 
     336        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     337          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     338        endif 
     339      endif  
     340       
     341      if (indic <=0) then 
     342      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     343      else 
     344      tabvars=>Agrif_Mygrid % tabvars(indic) 
     345      endif       
     346C 
     347C     Begin  
     348C 
     349      tabvars % var % Typeinterp =  
    314350     &    Agrif_Constant 
    315351      IF (present(interp)) THEN 
    316       Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp =  
     352      tabvars % var % Typeinterp =  
    317353     &           interp 
    318354      ENDIF 
    319355      IF (present(interp1)) THEN 
    320       Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(1) =  
     356      tabvars % var % Typeinterp(1) =  
    321357     &           interp1 
    322358      ENDIF 
    323359      IF (present(interp2)) THEN 
    324       Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(2) =  
     360      tabvars % var % Typeinterp(2) =  
    325361     &           interp2 
    326362      ENDIF 
    327363      IF (present(interp3)) THEN 
    328       Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(3) =  
     364      tabvars % var % Typeinterp(3) =  
    329365     &           interp3 
    330366      ENDIF 
     
    353389      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22 
    354390C 
    355       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     391      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    356392      TYPE(Agrif_PVariable),Pointer ::tabvars 
    357393       
     
    363399C      
    364400 
    365       if (tabvarsindic <=0) then 
    366       tabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    367       else 
    368       tabvars=>Agrif_Mygrid % tabvars(tabvarsindic) 
     401      indic = tabvarsindic 
     402      if (tabvarsindic >=0) then 
     403        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     404          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     405        endif 
     406      endif  
     407       
     408      if (indic <=0) then 
     409      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     410      else 
     411      tabvars=>Agrif_Mygrid % tabvars(indic) 
    369412      endif  
    370413C 
     
    460503     &       update2, update3,update4,update5 
    461504C 
    462       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     505      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
     506      TYPE(Agrif_PVariable),Pointer :: roottabvars       
    463507C 
    464508C 
    465509C     Begin  
    466 C 
    467       Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate =  
     510 
     511      indic = tabvarsindic 
     512 
     513      if (tabvarsindic >=0) then 
     514        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     515          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     516        endif 
     517      endif  
     518       
     519      if (indic <=0) then 
     520      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)       
     521      else 
     522      roottabvars => Agrif_Mygrid % tabvars(indic) 
     523      endif 
     524       
     525C 
     526      roottabvars% var % typeupdate =  
    468527     &                   Agrif_Update_Copy 
    469528       
    470529      IF (present(update)) THEN 
    471         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate =  
     530        roottabvars% var % typeupdate =  
    472531     &           update 
    473532      ENDIF 
    474533      IF (present(update1)) THEN 
    475         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(1) =  
     534        roottabvars% var % typeupdate(1) =  
    476535     &           update1 
    477536      ENDIF   
    478537      IF (present(update2)) THEN 
    479         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(2) =  
     538        roottabvars% var % typeupdate(2) =  
    480539     &           update2 
    481540      ENDIF   
    482541      IF (present(update3)) THEN 
    483         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(3) =  
     542        roottabvars% var % typeupdate(3) =  
    484543     &           update3 
    485544      ENDIF  
    486545      IF (present(update4)) THEN 
    487         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(4) =  
     546        roottabvars% var % typeupdate(4) =  
    488547     &           update4 
    489548      ENDIF        
    490549      IF (present(update5)) THEN 
    491         Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(5) =  
     550        roottabvars% var % typeupdate(5) =  
    492551     &           update5 
    493552      ENDIF                   
     
    513572C     Arguments       
    514573C 
    515       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     574      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
    516575C 
    517576C     Begin  
    518577C 
    519 C 
    520       Agrif_Mygrid%tabvars(tabvarsindic)%var % restaure = .TRUE. 
     578      indic = tabvarsindic 
     579      if (tabvarsindic >=0) then 
     580        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     581          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     582        endif 
     583      endif   
     584C 
     585      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE. 
    521586C 
    522587      End Subroutine Agrif_Set_restore 
     
    530595 
    531596      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 
    532       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     597      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
    533598      External :: procname 
    534599      Optional ::  procname 
     
    536601      if (Agrif_Root()) Return 
    537602C       
     603      indic = tabvarsindic 
     604      if (tabvarsindic >=0) then 
     605        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     606          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     607        endif 
     608      endif  
     609       
    538610      if (present(procname)) then 
    539       CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic,procname) 
    540       CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.,procname) 
    541       else 
    542       CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic) 
    543       CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.) 
     611      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname) 
     612      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname) 
     613      else 
     614      CALL Agrif_Interp_variable(tabvarsindic0,indic) 
     615      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.) 
    544616      endif 
    545617 
     
    553625 
    554626      REAL, DIMENSION(:) :: q 
    555       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     627      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    556628      External :: procname 
    557629      Optional ::  procname 
     
    559631C 
    560632      if (Agrif_Root()) Return 
     633C       
     634      indic = tabvarsindic 
     635      if (tabvarsindic >=0) then 
     636        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     637          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     638        endif 
     639      endif       
    561640C 
    562641      if (present(procname)) then 
    563       CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
    564       CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
    565       else 
    566       CALL Agrif_Interp_variable(q,tabvarsindic) 
    567       CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     642      CALL Agrif_Interp_variable(q,indic,procname) 
     643      CALL Agrif_Bc_variable(q,indic,1.,procname) 
     644      else 
     645      CALL Agrif_Interp_variable(q,indic) 
     646      CALL Agrif_Bc_variable(q,indic,1.) 
    568647      endif 
    569648 
     
    579658      External :: procname 
    580659      Optional ::  procname 
     660      integer :: indic 
    581661 
    582662C 
    583663      if (Agrif_Root()) Return 
    584664C 
     665      indic = tabvarsindic 
     666      if (tabvarsindic >=0) then 
     667        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     668          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     669        endif 
     670      endif  
     671       
    585672      if (present(procname)) then 
    586       CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
    587       CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
    588       else 
    589       CALL Agrif_Interp_variable(q,tabvarsindic) 
    590       CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     673      CALL Agrif_Interp_variable(q,indic,procname) 
     674      CALL Agrif_Bc_variable(q,indic,1.,procname) 
     675      else 
     676      CALL Agrif_Interp_variable(q,indic) 
     677      CALL Agrif_Bc_variable(q,indic,1.) 
    591678      endif 
    592679 
     
    601688 
    602689      REAL,  DIMENSION(:,:,:) :: q 
    603       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     690      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
    604691      External :: procname 
    605692      Optional ::  procname 
    606693C 
    607694      if (Agrif_Root()) Return 
     695C       
     696      indic = tabvarsindic 
     697      if (tabvarsindic >=0) then 
     698        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     699          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     700        endif 
     701      endif       
    608702C 
    609703      if (present(procname)) then 
    610       CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
    611       CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
    612       else 
    613       CALL Agrif_Interp_variable(q,tabvarsindic) 
    614       CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     704      CALL Agrif_Interp_variable(q,indic,procname) 
     705      CALL Agrif_Bc_variable(q,indic,1.,procname) 
     706      else 
     707      CALL Agrif_Interp_variable(q,indic) 
     708      CALL Agrif_Bc_variable(q,indic,1.) 
    615709      endif 
    616710 
     
    625719 
    626720      REAL,  DIMENSION(:,:,:,:) :: q 
    627       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     721      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    628722      External :: procname 
    629723      Optional ::  procname 
    630724C 
    631725      if (Agrif_Root()) Return 
     726C       
     727      indic = tabvarsindic 
     728      if (tabvarsindic >=0) then 
     729        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     730          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     731        endif 
     732      endif        
    632733C 
    633734      if (present(procname)) then 
    634       CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
    635       CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
    636       else 
    637       CALL Agrif_Interp_variable(q,tabvarsindic) 
    638       CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     735      CALL Agrif_Interp_variable(q,indic,procname) 
     736      CALL Agrif_Bc_variable(q,indic,1.,procname) 
     737      else 
     738      CALL Agrif_Interp_variable(q,indic) 
     739      CALL Agrif_Bc_variable(q,indic,1.) 
    639740      endif 
    640741 
     
    798899      External :: procname 
    799900      Optional ::  procname 
    800       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     901      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    801902C         
    802903      REAL, OPTIONAL :: calledweight 
     
    808909C       
    809910      If (Agrif_Root()) Return 
     911C       
     912      indic = tabvarsindic 
     913      if (tabvarsindic >=0) then 
     914        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     915          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     916        endif 
     917      endif          
    810918       
    811919      if ( PRESENT(calledweight) ) then 
     
    817925      endif 
    818926       
    819       if (tabvarsindic <=0) then 
    820       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     927      if (indic <=0) then 
     928      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    821929      parenttabvars => tabvars%parent_var 
    822       roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    823       else 
    824       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
    825       parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic) 
    826       roottabvars => Agrif_Mygrid % tabvars(tabvarsindic) 
     930      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     931      else 
     932      tabvars=>Agrif_Curgrid % tabvars(indic) 
     933      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     934      roottabvars => Agrif_Mygrid % tabvars(indic) 
    827935      endif 
    828936             
     
    856964      External :: procname 
    857965      Optional ::  procname 
    858       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     966      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    859967C         
    860968      REAL, OPTIONAL :: calledweight 
     
    866974C       
    867975      If (Agrif_Root()) Return 
     976C       
     977      indic = tabvarsindic 
     978      if (tabvarsindic >=0) then 
     979        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     980          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     981        endif 
     982      endif        
    868983       
    869984      if ( PRESENT(calledweight) ) then 
     
    875990      endif 
    876991       
    877       if (tabvarsindic <=0) then 
    878       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     992      if (indic <=0) then 
     993      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    879994      parenttabvars => tabvars%parent_var 
    880       roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    881       else 
    882       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
    883       parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic) 
    884       roottabvars => Agrif_Mygrid % tabvars(tabvarsindic) 
     995      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     996      else 
     997      tabvars=>Agrif_Curgrid % tabvars(indic) 
     998      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     999      roottabvars => Agrif_Mygrid % tabvars(indic) 
    8851000      endif 
    8861001             
     
    9141029      External :: procname 
    9151030      Optional ::  procname 
    916       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1031      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    9171032C         
    9181033      REAL, OPTIONAL :: calledweight 
     
    9241039C       
    9251040      If (Agrif_Root()) Return 
     1041C       
     1042      indic = tabvarsindic 
     1043      if (tabvarsindic >=0) then 
     1044        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1045          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1046        endif 
     1047      endif        
    9261048       
    9271049      if ( PRESENT(calledweight) ) then 
     
    9331055      endif 
    9341056       
    935       if (tabvarsindic <=0) then 
    936       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     1057      if (indic <=0) then 
     1058      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    9371059      parenttabvars => tabvars%parent_var 
    938       roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    939       else 
    940       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
    941       parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic) 
    942       roottabvars => Agrif_Mygrid % tabvars(tabvarsindic) 
     1060      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1061      else 
     1062      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1063      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1064      roottabvars => Agrif_Mygrid % tabvars(indic) 
    9431065      endif 
    9441066             
     
    9721094      External :: procname 
    9731095      Optional ::  procname 
    974       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1096      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    9751097C         
    9761098      REAL, OPTIONAL :: calledweight 
     
    9831105      If (Agrif_Root()) Return 
    9841106       
     1107C       
     1108      indic = tabvarsindic 
     1109      if (tabvarsindic >=0) then 
     1110        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1111          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1112        endif 
     1113      endif       
     1114       
    9851115      if ( PRESENT(calledweight) ) then 
    9861116        weight=calledweight       
     
    9911121      endif 
    9921122       
    993       if (tabvarsindic <=0) then 
    994       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     1123      if (indic <=0) then 
     1124      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    9951125      parenttabvars => tabvars%parent_var 
    996       roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    997       else 
    998       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
    999       parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic) 
    1000       roottabvars => Agrif_Mygrid % tabvars(tabvarsindic) 
     1126      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1127      else 
     1128      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1129      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1130      roottabvars => Agrif_Mygrid % tabvars(indic) 
    10011131      endif 
    10021132             
     
    10301160      External :: procname 
    10311161      Optional ::  procname 
    1032       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1162      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    10331163C         
    10341164      REAL, OPTIONAL :: calledweight 
     
    10401170C       
    10411171      If (Agrif_Root()) Return 
     1172C       
     1173      indic = tabvarsindic 
     1174      if (tabvarsindic >=0) then 
     1175        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1176          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1177        endif 
     1178      endif       
    10421179       
    10431180      if ( PRESENT(calledweight) ) then 
     
    10491186      endif 
    10501187       
    1051       if (tabvarsindic <=0) then 
    1052       tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     1188      if (indic <=0) then 
     1189      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
    10531190      parenttabvars => tabvars%parent_var 
    1054       roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
    1055       else 
    1056       tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
    1057       parenttabvars => Agrif_Curgrid % parent % tabvars(tabvarsindic) 
    1058       roottabvars => Agrif_Mygrid % tabvars(tabvarsindic) 
     1191      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1192      else 
     1193      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1194      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1195      roottabvars => Agrif_Mygrid % tabvars(indic) 
    10591196      endif 
    10601197             
     
    10861223 
    10871224      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 
    1088       INTEGER :: tabvarsindic  ! indice of the variable in tabvars 
     1225      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars 
    10891226      INTEGER :: dimensio  ! indice of the variable in tabvars 
    10901227      External :: procname 
     
    10921229C       
    10931230      if (Agrif_Root()) Return 
     1231C       
     1232      indic = tabvarsindic 
     1233      if (tabvarsindic >=0) then 
     1234        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1235          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1236        endif 
     1237      endif        
    10941238C      
    1095       dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim  
     1239      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim  
    10961240C 
    10971241      if ( dimensio .EQ. 1 ) then 
    10981242       if (present(procname)) then 
    10991243       Call Agrif_Interp_1D( 
    1100      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1101      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1102      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1244     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1245     & Agrif_Curgrid % parent % tabvars(indic), 
     1246     & Agrif_Curgrid % tabvars(indic), 
    11031247     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,      
    1104      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1105      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1248     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1249     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    11061250       else 
    11071251       Call Agrif_Interp_1D( 
    1108      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1109      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1110      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1252     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1253     & Agrif_Curgrid % parent % tabvars(indic), 
     1254     & Agrif_Curgrid % tabvars(indic), 
    11111255     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,      
    1112      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1113      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1256     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1257     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    11141258       endif 
    11151259       endif 
     
    11181262      if (present(procname)) then 
    11191263       Call Agrif_Interp_2D( 
    1120      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1121      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1122      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1264     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1265     & Agrif_Curgrid % parent % tabvars(indic), 
     1266     & Agrif_Curgrid % tabvars(indic), 
    11231267     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,      
    1124      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1125      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1268     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1269     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    11261270      else 
    11271271       Call Agrif_Interp_2D( 
    1128      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1129      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1130      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1272     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1273     & Agrif_Curgrid % parent % tabvars(indic), 
     1274     & Agrif_Curgrid % tabvars(indic), 
    11311275     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,      
    1132      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1133      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1276     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1277     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    11341278      endif 
    11351279      endif 
     
    11381282      if (present(procname)) then 
    11391283       Call Agrif_Interp_3D( 
    1140      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1141      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1142      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1284     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1285     & Agrif_Curgrid % parent % tabvars(indic), 
     1286     & Agrif_Curgrid % tabvars(indic), 
    11431287     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,      
    1144      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1145      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1288     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1289     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    11461290      else 
    11471291       Call Agrif_Interp_3D( 
    1148      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1149      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1150      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1292     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1293     & Agrif_Curgrid % parent % tabvars(indic), 
     1294     & Agrif_Curgrid % tabvars(indic), 
    11511295     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,      
    1152      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1153      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1296     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1297     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    11541298      endif 
    11551299      endif 
     
    11581302      if (present(procname)) then 
    11591303       Call Agrif_Interp_4D( 
    1160      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1161      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1162      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1304     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1305     & Agrif_Curgrid % parent % tabvars(indic), 
     1306     & Agrif_Curgrid % tabvars(indic), 
    11631307     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,      
    1164      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1165      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1308     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1309     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    11661310      else 
    11671311       Call Agrif_Interp_4D( 
    1168      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1169      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1170      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1312     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1313     & Agrif_Curgrid % parent % tabvars(indic), 
     1314     & Agrif_Curgrid % tabvars(indic), 
    11711315     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,      
    1172      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1173      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1316     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1317     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    11741318      endif 
    11751319      endif 
     
    11781322      if (present(procname)) then 
    11791323       Call Agrif_Interp_5D( 
    1180      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1181      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1182      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1324     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1325     & Agrif_Curgrid % parent % tabvars(indic), 
     1326     & Agrif_Curgrid % tabvars(indic), 
    11831327     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,      
    1184      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1185      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1328     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1329     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    11861330      else 
    11871331       Call Agrif_Interp_5D( 
    1188      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1189      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1190      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1332     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1333     & Agrif_Curgrid % parent % tabvars(indic), 
     1334     & Agrif_Curgrid % tabvars(indic), 
    11911335     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,      
    1192      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1193      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1336     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1337     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    11941338       endif 
    11951339       endif 
     
    11981342      if (present(procname)) then 
    11991343       Call Agrif_Interp_6D( 
    1200      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1201      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1202      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1344     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1345     & Agrif_Curgrid % parent % tabvars(indic), 
     1346     & Agrif_Curgrid % tabvars(indic), 
    12031347     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,      
    1204      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1205      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1348     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1349     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 
    12061350      else 
    12071351       Call Agrif_Interp_6D( 
    1208      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1209      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1210      & Agrif_Curgrid % tabvars(tabvarsindic), 
     1352     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp, 
     1353     & Agrif_Curgrid % parent % tabvars(indic), 
     1354     & Agrif_Curgrid % tabvars(indic), 
    12111355     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,      
    1212      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1213      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1356     & Agrif_Mygrid % tabvars(indic) % var % restaure, 
     1357     & Agrif_Mygrid % tabvars(indic) %var % nbdim) 
    12141358      endif 
    12151359      endif 
     
    12251369 
    12261370      REAL, DIMENSION(:) :: q 
    1227       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1371      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    12281372      External :: procname 
    12291373      Optional ::  procname 
     1374      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
    12301375C 
    12311376      if (Agrif_Root()) Return 
    12321377C       
     1378C       
     1379      indic = tabvarsindic 
     1380      if (tabvarsindic >=0) then 
     1381        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1382          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1383        endif 
     1384      endif  
     1385       
     1386      if (indic <=0) then 
     1387      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1388      parenttabvars => tabvars%parent_var 
     1389      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1390      else 
     1391      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1392      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1393      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1394      endif 
     1395       
    12331396      if (present(procname)) then 
    12341397      Call Agrif_Interp_1D( 
    1235      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1236      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1237      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1238      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1239      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1398     & roottabvars % var %  TypeInterp, 
     1399     & parenttabvars, 
     1400     & tabvars,q, 
     1401     & roottabvars % var % restaure, 
     1402     & roottabvars %var % nbdim,procname) 
    12401403      else 
    12411404      Call Agrif_Interp_1D( 
    1242      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1243      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1244      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1245      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1246      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1405     & roottabvars % var %  TypeInterp, 
     1406     & parenttabvars, 
     1407     & tabvars,q, 
     1408     & roottabvars % var % restaure, 
     1409     & roottabvars %var % nbdim) 
     1410      
    12471411      endif 
    12481412      Return 
     
    12561420 
    12571421      REAL,  DIMENSION(:,:) :: q 
    1258       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1422      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    12591423      External :: procname 
    12601424      Optional ::  procname 
    1261  
    1262 C 
    1263        if (Agrif_Root()) Return 
    1264 C 
    1265        if (present(procname)) then 
    1266        Call Agrif_Interp_2D( 
    1267      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1268      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1269      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1270      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1271      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
    1272        else 
    1273        Call Agrif_Interp_2D( 
    1274      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1275      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1276      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1277      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1278      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1279        endif 
     1425      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
     1426C 
     1427      if (Agrif_Root()) Return 
     1428C       
     1429      indic = tabvarsindic 
     1430      if (tabvarsindic >=0) then 
     1431        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1432          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1433        endif 
     1434      endif  
     1435       
     1436      if (indic <=0) then 
     1437      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1438      parenttabvars => tabvars%parent_var 
     1439      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1440      if (tabvars%var%restaure) then 
     1441        if (agrif_curgrid%ngridstep == 0) then 
     1442          call AGRIF_CopyFromold_AllOneVar 
     1443     &            (Agrif_Curgrid,Agrif_OldMygrid,indic) 
     1444        endif 
     1445      endif 
     1446      else 
     1447      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1448      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1449      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1450      endif 
     1451 
     1452             
     1453      if (present(procname)) then 
     1454      Call Agrif_Interp_2D( 
     1455     & roottabvars % var %  TypeInterp, 
     1456     & parenttabvars, 
     1457     & tabvars,q, 
     1458     & roottabvars % var % restaure, 
     1459     & roottabvars %var % nbdim,procname) 
     1460      else 
     1461      Call Agrif_Interp_2D( 
     1462     & roottabvars % var %  TypeInterp, 
     1463     & parenttabvars, 
     1464     & tabvars,q, 
     1465     & roottabvars % var % restaure, 
     1466     & roottabvars %var % nbdim) 
     1467      
     1468      endif  
    12801469      Return 
    12811470      End Subroutine Agrif_Interp_var2d 
     
    12881477 
    12891478      REAL,  DIMENSION(:,:,:) :: q 
    1290       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1479      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    12911480      External :: procname 
    12921481      Optional ::  procname 
    1293  
     1482      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
    12941483C 
    12951484      if (Agrif_Root()) Return 
    1296 C 
     1485C       
     1486 
     1487      indic = tabvarsindic 
     1488      if (tabvarsindic >=0) then 
     1489        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1490          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1491        endif 
     1492      endif  
     1493       
     1494      if (indic <=0) then 
     1495      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1496      parenttabvars => tabvars%parent_var 
     1497      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1498      if (tabvars%var%restaure) then 
     1499        if (agrif_curgrid%ngridstep == 0) then 
     1500          call AGRIF_CopyFromold_AllOneVar 
     1501     &            (Agrif_Curgrid,Agrif_OldMygrid,indic) 
     1502        endif 
     1503      endif       
     1504      else 
     1505      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1506      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1507      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1508      endif 
     1509 
    12971510      if (present(procname)) then 
    12981511      Call Agrif_Interp_3D( 
    1299      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1300      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1301      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1302      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1303      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1512     & roottabvars % var %  TypeInterp, 
     1513     & parenttabvars, 
     1514     & tabvars,q, 
     1515     & roottabvars % var % restaure, 
     1516     & roottabvars %var % nbdim,procname) 
    13041517      else 
    13051518      Call Agrif_Interp_3D( 
    1306      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1307      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1308      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1309      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1310      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1311       endif 
     1519     & roottabvars % var %  TypeInterp, 
     1520     & parenttabvars, 
     1521     & tabvars,q, 
     1522     & roottabvars % var % restaure, 
     1523     & roottabvars %var % nbdim) 
     1524      
     1525      endif    
    13121526      Return 
    13131527      End Subroutine Agrif_Interp_var3d 
     
    13201534 
    13211535      REAL,  DIMENSION(:,:,:,:) :: q 
    1322       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1536      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    13231537      External :: procname 
    13241538      Optional ::  procname 
    1325  
     1539      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
    13261540C 
    13271541      if (Agrif_Root()) Return 
    1328 C 
     1542C       
     1543      indic = tabvarsindic 
     1544      if (tabvarsindic >=0) then 
     1545        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1546          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1547        endif 
     1548      endif  
     1549       
     1550      if (indic <=0) then 
     1551      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1552      parenttabvars => tabvars%parent_var 
     1553      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1554      if (tabvars%var%restaure) then 
     1555        if (agrif_curgrid%ngridstep == 0) then 
     1556          call AGRIF_CopyFromold_AllOneVar 
     1557     &            (Agrif_Curgrid,Agrif_OldMygrid,indic) 
     1558        endif 
     1559      endif       
     1560      else 
     1561      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1562      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1563      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1564      endif 
     1565             
    13291566      if (present(procname)) then 
    13301567      Call Agrif_Interp_4D( 
    1331      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1332      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1333      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1334      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1335      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1568     & roottabvars % var %  TypeInterp, 
     1569     & parenttabvars, 
     1570     & tabvars,q, 
     1571     & roottabvars % var % restaure, 
     1572     & roottabvars %var % nbdim,procname) 
    13361573      else 
    13371574      Call Agrif_Interp_4D( 
    1338      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1339      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1340      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1341      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1342      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1343       endif 
     1575     & roottabvars % var %  TypeInterp, 
     1576     & parenttabvars, 
     1577     & tabvars,q, 
     1578     & roottabvars % var % restaure, 
     1579     & roottabvars %var % nbdim) 
     1580      
     1581      endif       
     1582 
    13441583      Return 
    13451584      End Subroutine Agrif_Interp_var4d      
     
    13521591 
    13531592      REAL,  DIMENSION(:,:,:,:,:) :: q 
    1354       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1593      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 
    13551594      External :: procname 
    13561595      Optional ::  procname 
    1357  
     1596      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
    13581597C 
    13591598      if (Agrif_Root()) Return 
    1360 C 
     1599C       
     1600 
     1601      indic = tabvarsindic 
     1602      if (tabvarsindic >=0) then 
     1603        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1604          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1605        endif 
     1606      endif  
     1607       
     1608      if (indic <=0) then 
     1609      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1610      parenttabvars => tabvars%parent_var 
     1611      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     1612      else 
     1613      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1614      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1615      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1616      endif 
     1617       
    13611618      if (present(procname)) then 
    13621619      Call Agrif_Interp_5D( 
    1363      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1364      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1365      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1366      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1367      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1620     & roottabvars % var %  TypeInterp, 
     1621     & parenttabvars, 
     1622     & tabvars,q, 
     1623     & roottabvars % var % restaure, 
     1624     & roottabvars %var % nbdim,procname) 
    13681625      else 
    13691626      Call Agrif_Interp_5D( 
    1370      & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    1371      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1372      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1373      & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    1374      & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1627     & roottabvars % var %  TypeInterp, 
     1628     & parenttabvars, 
     1629     & tabvars,q, 
     1630     & roottabvars % var % restaure, 
     1631     & roottabvars %var % nbdim) 
     1632      
    13751633      endif 
    13761634      Return 
     
    15381796 
    15391797      REAL,  DIMENSION(:) :: q 
    1540       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1798      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
    15411799      External :: procname 
    15421800      Optional ::  procname       
     
    15441802      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
    15451803      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
     1804      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars    
    15461805C       
    15471806      if (Agrif_Root()) Return 
    15481807C      
     1808 
     1809      indic = tabvarsindic 
     1810      if (tabvarsindic >=0) then 
     1811        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1812          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1813        endif 
     1814      endif  
     1815       
     1816      if (indic <=0) then 
     1817      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1818      parenttabvars => tabvars%parent_var 
     1819      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)       
     1820      else 
     1821      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1822      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1823      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1824      endif 
     1825       
    15491826      IF (present(locupdate)) THEN 
    1550       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)  
     1827      tabvars%var % updateinf(1:1)  
    15511828     &      = locupdate(1) 
    1552       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)  
     1829      tabvars%var % updatesup(1:1)  
    15531830     &      = locupdate(2) 
    15541831      ELSE 
    1555       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)  
     1832      tabvars%var % updateinf(1:1)  
    15561833     &      = -99 
    1557       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)  
     1834      tabvars%var % updatesup(1:1)  
    15581835     &      = -99 
    15591836      ENDIF 
    15601837       
    15611838      IF (present(locupdate1)) THEN 
    1562       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1839      tabvars%var % updateinf(1)  
    15631840     &      = locupdate1(1) 
    1564       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1841      tabvars%var % updatesup(1)  
    15651842     &      = locupdate1(2) 
    15661843      ENDIF   
    15671844       
    15681845      IF (present(locupdate2)) THEN 
    1569       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1846      tabvars%var % updateinf(2)  
    15701847     &      = locupdate2(1) 
    1571       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1848      tabvars%var % updatesup(2)  
    15721849     &      = locupdate2(2) 
    15731850      ENDIF        
     
    15751852      IF (present(procname)) THEN 
    15761853      Call Agrif_Update_1D( 
    1577      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1578      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1579      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1580      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1581      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup, 
     1854     & roottabvars % var % typeupdate, 
     1855     & parenttabvars, 
     1856     & tabvars,q, 
     1857     & tabvars % var % updateinf, 
     1858     & tabvars % var % updatesup, 
    15821859     & procname) 
    1583       ELSE 
     1860      ELSE  
    15841861      Call Agrif_Update_1D( 
    1585      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1586      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1587      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1588      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1589      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)       
     1862     & roottabvars % var % typeupdate, 
     1863     & parenttabvars, 
     1864     & tabvars,q, 
     1865     & tabvars % var % updateinf, 
     1866     & tabvars % var % updatesup)        
    15901867      ENDIF 
    15911868 
     
    16071884      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
    16081885      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    1609       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1886      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
     1887      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars        
    16101888C       
    16111889      IF (Agrif_Root()) RETURN 
    16121890       
    16131891C  
     1892      indic = tabvarsindic 
     1893      if (tabvarsindic >=0) then 
     1894        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1895          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1896        endif 
     1897      endif  
     1898       
     1899      if (indic <=0) then 
     1900      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1901      parenttabvars => tabvars%parent_var 
     1902      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)       
     1903      else 
     1904      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1905      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1906      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1907      endif 
     1908       
    16141909      IF (present(locupdate)) THEN 
    1615       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)  
     1910      tabvars%var % updateinf(1:2)  
    16161911     &      = locupdate(1) 
    1617       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)  
     1912      tabvars%var % updatesup(1:2)  
    16181913     &      = locupdate(2) 
    16191914      ELSE 
    1620       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)  
     1915      tabvars%var % updateinf(1:2)  
    16211916     &      = -99 
    1622       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)  
     1917      tabvars%var % updatesup(1:2)  
    16231918     &      = -99 
    16241919      ENDIF 
    16251920       
    16261921      IF (present(locupdate1)) THEN 
    1627       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1922      tabvars%var % updateinf(1)  
    16281923     &      = locupdate1(1) 
    1629       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1924      tabvars%var % updatesup(1)  
    16301925     &      = locupdate1(2) 
    16311926      ENDIF   
    16321927       
    16331928      IF (present(locupdate2)) THEN 
    1634       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1929      tabvars%var % updateinf(2)  
    16351930     &      = locupdate2(1) 
    1636       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1931      tabvars%var % updatesup(2)  
    16371932     &      = locupdate2(2) 
    16381933      ENDIF 
     
    16401935      IF (present(procname)) THEN 
    16411936      Call Agrif_Update_2D( 
    1642      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1643      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1644      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1645      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1646      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup, 
     1937     & roottabvars % var % typeupdate, 
     1938     & parenttabvars, 
     1939     & tabvars,q, 
     1940     & tabvars % var % updateinf, 
     1941     & tabvars % var % updatesup, 
    16471942     & procname) 
    1648       ELSE 
     1943      ELSE  
    16491944      Call Agrif_Update_2D( 
    1650      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1651      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1652      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1653      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1654      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)       
     1945     & roottabvars % var % typeupdate, 
     1946     & parenttabvars, 
     1947     & tabvars,q, 
     1948     & tabvars % var % updateinf, 
     1949     & tabvars % var % updatesup)        
    16551950      ENDIF 
    16561951 
     
    16721967      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
    16731968      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    1674       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1969      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
     1970      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars        
    16751971C       
    16761972      IF (Agrif_Root()) RETURN  
    16771973C       
    1678  
     1974      indic = tabvarsindic 
     1975      if (tabvarsindic >=0) then 
     1976        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     1977          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     1978        endif 
     1979      endif  
     1980       
     1981      if (indic <=0) then 
     1982      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     1983      parenttabvars => tabvars%parent_var 
     1984      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)       
     1985      else 
     1986      tabvars=>Agrif_Curgrid % tabvars(indic) 
     1987      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     1988      roottabvars => Agrif_Mygrid % tabvars(indic) 
     1989      endif 
     1990       
    16791991      IF (present(locupdate)) THEN 
    1680       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)  
     1992      tabvars%var % updateinf(1:3)  
    16811993     &      = locupdate(1) 
    1682       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)  
     1994      tabvars%var % updatesup(1:3)  
    16831995     &      = locupdate(2) 
    16841996      ELSE 
    1685       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)  
     1997      tabvars%var % updateinf(1:3)  
    16861998     &      = -99 
    1687       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)  
     1999      tabvars%var % updatesup(1:3)  
    16882000     &      = -99 
    16892001      ENDIF       
    16902002       
    16912003      IF (present(locupdate1)) THEN 
    1692       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     2004      tabvars%var % updateinf(1)  
    16932005     &      = locupdate1(1) 
    1694       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     2006      tabvars%var % updatesup(1)  
    16952007     &      = locupdate1(2) 
    16962008      ENDIF   
    16972009       
    16982010      IF (present(locupdate2)) THEN 
    1699       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     2011      tabvars%var % updateinf(2)  
    17002012     &      = locupdate2(1) 
    1701       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     2013      tabvars%var % updatesup(2)  
    17022014     &      = locupdate2(2) 
    17032015      ENDIF 
     
    17052017      IF (present(procname)) THEN 
    17062018      Call Agrif_Update_3D( 
    1707      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1708      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1709      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1710      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1711      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup, 
     2019     & roottabvars % var % typeupdate, 
     2020     & parenttabvars, 
     2021     & tabvars,q, 
     2022     & tabvars % var % updateinf, 
     2023     & tabvars % var % updatesup, 
    17122024     & procname) 
    1713       ELSE 
     2025      ELSE  
    17142026      Call Agrif_Update_3D( 
    1715      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1716      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1717      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1718      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1719      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)       
     2027     & roottabvars % var % typeupdate, 
     2028     & parenttabvars, 
     2029     & tabvars,q, 
     2030     & tabvars % var % updateinf, 
     2031     & tabvars % var % updatesup)        
    17202032      ENDIF 
    17212033 
     
    17372049      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
    17382050      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    1739       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     2051      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
     2052      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars        
    17402053C       
    17412054      IF (Agrif_Root()) RETURN 
     2055      indic = tabvarsindic 
     2056      if (tabvarsindic >=0) then 
     2057        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     2058          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     2059        endif 
     2060      endif  
     2061       
     2062      if (indic <=0) then 
     2063      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     2064      parenttabvars => tabvars%parent_var 
     2065      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
     2066      else 
     2067      tabvars=>Agrif_Curgrid % tabvars(indic) 
     2068      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     2069      roottabvars => Agrif_Mygrid % tabvars(indic) 
     2070      endif       
    17422071C       
    17432072      IF (present(locupdate)) THEN 
    1744       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)  
     2073      tabvars%var % updateinf(1:4)  
    17452074     &      = locupdate(1) 
    1746       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)  
     2075      tabvars%var % updatesup(1:4)  
    17472076     &      = locupdate(2) 
    17482077      ELSE 
    1749       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)  
     2078      tabvars%var % updateinf(1:4)  
    17502079     &      = -99 
    1751       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)  
     2080      tabvars%var % updatesup(1:4)  
    17522081     &      = -99 
    17532082      ENDIF 
    17542083       
    17552084      IF (present(locupdate1)) THEN 
    1756       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     2085      tabvars%var % updateinf(1)  
    17572086     &      = locupdate1(1) 
    1758       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     2087      tabvars%var % updatesup(1)  
    17592088     &      = locupdate1(2) 
    17602089      ENDIF   
    17612090       
    17622091      IF (present(locupdate2)) THEN 
    1763       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     2092      tabvars%var % updateinf(2)  
    17642093     &      = locupdate2(1) 
    1765       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     2094      tabvars%var % updatesup(2)  
    17662095     &      = locupdate2(2) 
    17672096      ENDIF 
     
    17692098      IF (present(procname)) THEN 
    17702099      Call Agrif_Update_4D( 
    1771      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1772      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1773      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1774      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1775      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup, 
     2100     & roottabvars % var % typeupdate, 
     2101     & parenttabvars, 
     2102     & tabvars,q, 
     2103     & tabvars % var % updateinf, 
     2104     & tabvars % var % updatesup, 
    17762105     & procname) 
    1777       ELSE 
     2106      ELSE  
    17782107      Call Agrif_Update_4D( 
    1779      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1780      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1781      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1782      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1783      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)       
     2108     & roottabvars % var % typeupdate, 
     2109     & parenttabvars, 
     2110     & tabvars,q, 
     2111     & tabvars % var % updateinf, 
     2112     & tabvars % var % updatesup)        
    17842113      ENDIF 
    17852114 
     
    18012130      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
    18022131      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    1803       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     2132      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 
     2133      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars        
    18042134C 
    18052135      IF (Agrif_Root()) RETURN 
    1806 C       
     2136C      
     2137      indic = tabvarsindic 
     2138      if (tabvarsindic >=0) then 
     2139        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     2140          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     2141        endif 
     2142      endif  
     2143       
     2144      if (indic <=0) then 
     2145      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     2146      parenttabvars => tabvars%parent_var 
     2147      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)       
     2148      else 
     2149      tabvars=>Agrif_Curgrid % tabvars(indic) 
     2150      parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 
     2151      roottabvars => Agrif_Mygrid % tabvars(indic) 
     2152      endif 
     2153        
    18072154      IF (present(locupdate)) THEN 
    1808       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)  
     2155      tabvars%var % updateinf(1:5)  
    18092156     &      = locupdate(1) 
    1810       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)  
     2157      tabvars%var % updatesup(1:5)  
    18112158     &      = locupdate(2) 
    18122159      ELSE 
    1813       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)  
     2160      tabvars%var % updateinf(1:5)  
    18142161     &      = -99 
    1815       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)  
     2162      tabvars%var % updatesup(1:5)  
    18162163     &      = -99 
    18172164      ENDIF 
    18182165       
    18192166      IF (present(locupdate1)) THEN 
    1820       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     2167      tabvars%var % updateinf(1)  
    18212168     &      = locupdate1(1) 
    1822       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     2169      tabvars%var % updatesup(1)  
    18232170     &      = locupdate1(2) 
    18242171      ENDIF   
    18252172       
    18262173      IF (present(locupdate2)) THEN 
    1827       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     2174      tabvars%var % updateinf(2)  
    18282175     &      = locupdate2(1) 
    1829       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     2176      tabvars%var % updatesup(2)  
    18302177     &      = locupdate2(2) 
    18312178      ENDIF 
     
    18332180      IF (present(procname)) THEN 
    18342181      Call Agrif_Update_5D( 
    1835      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1836      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1837      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1838      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1839      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup, 
     2182     & roottabvars % var % typeupdate, 
     2183     & parenttabvars, 
     2184     & tabvars,q, 
     2185     & tabvars % var % updateinf, 
     2186     & tabvars % var % updatesup, 
    18402187     & procname) 
    1841       ELSE 
     2188      ELSE  
    18422189      Call Agrif_Update_5D( 
    1843      & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate, 
    1844      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    1845      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    1846      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf, 
    1847      & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)       
     2190     & roottabvars % var % typeupdate, 
     2191     & parenttabvars, 
     2192     & tabvars,q, 
     2193     & tabvars % var % updateinf, 
     2194     & tabvars % var % updatesup)        
    18482195      ENDIF 
    18492196 
     
    19522299      End Subroutine Agrif_Flux_Correction 
    19532300 
    1954       Subroutine Agrif_Declare_Variable(posvar,firstpoint, 
    1955      &    raf,lb,ub,varid) 
    1956       character*(80) :: variablename 
    1957       Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep 
    1958       INTEGER, DIMENSION(:) :: posvar 
    1959       INTEGER, DIMENSION(:) :: lb,ub 
    1960       INTEGER, DIMENSION(:) :: firstpoint 
    1961       CHARACTER(*) ,DIMENSION(:) :: raf         
    1962       TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var 
    1963       INTEGER :: dimensio 
    1964       INTEGER :: varid 
    1965              
    1966       if (agrif_root()) return 
    1967  
    1968       dimensio = SIZE(posvar) 
    1969 C 
    1970 C     
    1971       Allocate(newvariable) 
    1972       Allocate(newvariable%pvar) 
    1973       Allocate(newvariable%pvar%var) 
    1974       Allocate(newvariable%pvar%var%posvar(dimensio)) 
    1975       Allocate(newvariable%pvar%var%interptab(dimensio)) 
    1976       newvariable%pvar%var%variablename = variablename 
    1977       newvariable%pvar%var%interptab = raf 
    1978       newvariable%pvar%var%nbdim = dimensio 
    1979       newvariable%pvar%var%posvar = posvar 
    1980       newvariable%pvar%var%point(1:dimensio) = firstpoint 
    1981       newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio) 
    1982       newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio) 
    1983        
    1984       newvariable % nextvariable => Agrif_Curgrid%variables 
    1985        
    1986       Agrif_Curgrid%variables => newvariable 
    1987       Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1 
    1988        
    1989       varid = -Agrif_Curgrid%Nbvariables 
    1990        
    1991        if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables) 
    1992      &       then 
    1993       Allocate(newvariablep) 
    1994       Allocate(newvariablep%pvar) 
    1995       Allocate(newvariablep%pvar%var)       
    1996       Allocate(newvariablep%pvar%var%posvar(dimensio)) 
    1997       Allocate(newvariablep%pvar%var%interptab(dimensio)) 
    1998       newvariablep%pvar%var%variablename = variablename 
    1999       newvariablep%pvar%var%interptab = raf 
    2000       newvariablep%pvar%var%nbdim = dimensio 
    2001       newvariablep%pvar%var%posvar = posvar 
    2002       newvariablep%pvar%var%point(1:dimensio) = firstpoint 
    2003        
    2004       newvariablep % nextvariable => Agrif_Curgrid%parent%variables 
    2005        
    2006       Agrif_Curgrid%parent%variables => newvariablep        
    2007        
    2008       Agrif_Curgrid%parent%Nbvariables =  
    2009      &    Agrif_Curgrid%parent%Nbvariables + 1 
    2010       parent_var=>newvariablep%pvar 
    2011       else 
    2012       parent_var=>Agrif_Search_Variable 
    2013      &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables) 
    2014        endif 
    2015         
    2016        newvariable%pvar%parent_var=>parent_var 
    2017        
    2018       root_var=>Agrif_Search_Variable 
    2019      &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables) 
    2020       
    2021       newvariable%pvar%var%root_var=>root_var%var 
    2022        
    2023             
    2024       End Subroutine Agrif_Declare_Variable 
    2025  
    2026       FUNCTION Agrif_Search_Variable(grid,varid) 
    2027       integer :: varid 
    2028       Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable 
    2029       Type(Agrif_grid), Pointer :: grid 
    2030        
    2031       Type(Agrif_List_Variables), pointer :: parcours 
    2032       Logical :: foundvariable 
    2033       integer nb 
    2034        
    2035       foundvariable = .FALSE. 
    2036       parcours => grid%variables 
    2037        
    2038       do nb=1,varid-1 
    2039          parcours => parcours%nextvariable 
    2040       End Do 
    2041        
    2042       Agrif_Search_variable => parcours%pvar 
    2043        
    2044        
    2045       End Function Agrif_Search_variable 
     2301 
    20462302                               
    20472303      Subroutine Agrif_Declare_Profile_flux(profilename,posvar, 
     
    20712327       
    20722328      End Subroutine Agrif_Declare_Profile_flux 
    2073                
     2329 
     2330      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic) 
     2331      integer :: tabvarsindic0, tabvarsindic 
     2332      integer :: dimensio 
     2333       
     2334      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim 
     2335       
     2336      select case(dimensio) 
     2337      case(2) 
     2338          call Agrif_Save_ForRestore2D( 
     2339     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2, 
     2340     &      tabvarsindic) 
     2341      case(3) 
     2342          call Agrif_Save_ForRestore3D( 
     2343     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3, 
     2344     &      tabvarsindic) 
     2345      case(4) 
     2346          call Agrif_Save_ForRestore4D( 
     2347     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4, 
     2348     &      tabvarsindic)      
     2349      end select 
     2350 
     2351      Return 
     2352      End Subroutine Agrif_Save_ForRestore0D  
     2353       
     2354     
     2355       
     2356      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic) 
     2357      real,dimension(:,:) :: q 
     2358      integer :: tabvarsindic, indic 
     2359      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars     
     2360  
     2361       indic = tabvarsindic 
     2362      if (tabvarsindic >=0) then 
     2363        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     2364          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     2365        endif 
     2366      endif 
     2367       
     2368      if (indic <=0) then 
     2369      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     2370      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     2371      else 
     2372      tabvars=>Agrif_Curgrid % tabvars(indic) 
     2373      roottabvars => Agrif_Mygrid % tabvars(indic) 
     2374      endif       
     2375      if (.not.allocated(tabvars%var%array2)) then       
     2376      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1), 
     2377     &                            tabvars%var%lb(2):tabvars%var%ub(2))) 
     2378      endif 
     2379      tabvars%var%array2 = q 
     2380      roottabvars%var%restaure = .true. 
     2381       
     2382      Return 
     2383      End Subroutine Agrif_Save_ForRestore2D   
     2384       
     2385      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic) 
     2386      real,dimension(:,:,:) :: q 
     2387      integer :: tabvarsindic, indic 
     2388      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars     
     2389  
     2390       indic = tabvarsindic 
     2391      if (tabvarsindic >=0) then 
     2392        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     2393          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     2394        endif 
     2395      endif 
     2396       
     2397      if (indic <=0) then 
     2398      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     2399      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     2400      else 
     2401      tabvars=>Agrif_Curgrid % tabvars(indic) 
     2402      roottabvars => Agrif_Mygrid % tabvars(indic) 
     2403      endif       
     2404 
     2405      if (.not.allocated(tabvars%var%array3)) then 
     2406      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1), 
     2407     &                            tabvars%var%lb(2):tabvars%var%ub(2), 
     2408     &                            tabvars%var%lb(3):tabvars%var%ub(3))) 
     2409      endif 
     2410      tabvars%var%array3 = q 
     2411      roottabvars%var%restaure = .true. 
     2412       
     2413      Return 
     2414      End Subroutine Agrif_Save_ForRestore3D 
     2415       
     2416      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic) 
     2417      real,dimension(:,:,:,:) :: q 
     2418      integer :: tabvarsindic, indic 
     2419      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars     
     2420  
     2421       indic = tabvarsindic 
     2422      if (tabvarsindic >=0) then 
     2423        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 
     2424          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 
     2425        endif 
     2426      endif 
     2427       
     2428      if (indic <=0) then 
     2429      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 
     2430      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 
     2431      else 
     2432      tabvars=>Agrif_Curgrid % tabvars(indic) 
     2433      roottabvars => Agrif_Mygrid % tabvars(indic) 
     2434      endif 
     2435 
     2436      if (.not.allocated(tabvars%var%array4)) then          
     2437      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1), 
     2438     &                            tabvars%var%lb(2):tabvars%var%ub(2), 
     2439     &                            tabvars%var%lb(3):tabvars%var%ub(3), 
     2440     &                            tabvars%var%lb(4):tabvars%var%ub(4))) 
     2441      endif 
     2442      tabvars%var%array4 = q 
     2443      roottabvars%var%restaure = .true. 
     2444       
     2445      Return 
     2446      End Subroutine Agrif_Save_ForRestore4D                    
    20742447C 
    20752448      End module Agrif_bcfunction 
  • vendors/AGRIF/current/AGRIF_FILES/modcluster.F

    r1901 r2671  
    11! 
    2 ! $Id: modcluster.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modcluster.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    11661166C 
    11671167        newgrid % parent => g       
     1168 
     1169C       Level of the current grid 
     1170        newgrid % level = newgrid % parent % level + 1 
     1171        if (newgrid % level > Agrif_MaxLevelLoc) then 
     1172          Agrif_MaxLevelLoc = newgrid%level 
     1173        endif 
     1174 
    11681175C       
    11691176C       Grid pointed by newgrid is a fixed grid       
  • vendors/AGRIF/current/AGRIF_FILES/modcurgridfunctions.F

    r1901 r2671  
    11! 
    2 ! $Id: modcurgridfunctions.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modcurgridfunctions.F 774 2007-12-18 16:45:53Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    684684       
    685685C 
    686 C 
    687       AGRIF_saveCURGRID => AGRIF_CURGRID 
    688 C 
    689       Call AGRIF_INSTANCE(AGRIF_CURGRID%parent)             
     686       
     687      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid 
     688C 
     689      Call Agrif_Instance(Agrif_Curgrid%parent)             
    690690C 
    691691C 
     
    709709C 
    710710C 
    711       Call AGRIF_INSTANCE(AGRIF_saveCURGRID)             
     711      Call Agrif_Instance(Agrif_Curgrid%save_grid) 
    712712C 
    713713C 
     
    737737      INTEGER :: iii,out,iiimax 
    738738      Logical :: BEXIST 
    739       INTEGER,DIMENSION(1:10) :: ForbiddenUnit 
     739      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit 
    740740C 
    741741C 
     
    967967      MaxSearch = mymaxsearch 
    968968      end subroutine Agrif_Set_MaskMaxSearch 
     969       
     970C ***************************************************************** 
     971CCC  subroutine Agrif_Level 
     972C ***************************************************************** 
     973      Function Agrif_Level() 
     974      Integer :: Agrif_Level 
     975      
     976      Agrif_Level = Agrif_Curgrid % level 
     977      
     978      End Function Agrif_Level 
     979       
     980C ***************************************************************** 
     981CCC  subroutine Agrif_MaxLevel 
     982C ***************************************************************** 
     983      Function Agrif_MaxLevel() 
     984      Integer :: Agrif_MaxLevel 
     985      
     986      Agrif_MaxLevel = Agrif_MaxLevelLoc 
     987      
     988      End Function Agrif_MaxLevel       
    969989 
    970990      End Module Agrif_CurgridFunctions  
  • vendors/AGRIF/current/AGRIF_FILES/modinit.F

    r1901 r2671  
    135135         Agrif_Gr % tabvars(i) % var % nbdim = 0 
    136136C 
    137          if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
     137         if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then 
    138138             Agrif_Gr % tabvars(i) % var % nbdim = 1 
    139139             Agrif_Gr % tabvars(i) % var % lb(1:1) =  
     
    142142     &         ubound(Agrif_Gr%tabvars(i)%var%array1)      
    143143         endif 
    144          if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
     144         if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then 
    145145             Agrif_Gr % tabvars(i) % var % nbdim = 2 
    146146             Agrif_Gr % tabvars(i) % var % lb(1:2) =  
     
    149149     &         ubound(Agrif_Gr%tabvars(i)%var%array2) 
    150150         endif 
    151          if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
     151         if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then 
    152152             Agrif_Gr % tabvars(i) % var % nbdim = 3 
    153153             Agrif_Gr % tabvars(i) % var % lb(1:3) =  
     
    156156     &         ubound(Agrif_Gr%tabvars(i)%var%array3) 
    157157         endif 
    158          if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
     158         if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then 
    159159             Agrif_Gr % tabvars(i) % var % nbdim = 4 
    160160             Agrif_Gr % tabvars(i) % var % lb(1:4) =  
     
    163163     &         ubound(Agrif_Gr%tabvars(i)%var%array4) 
    164164         endif 
    165          if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
     165         if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then 
    166166             Agrif_Gr % tabvars(i) % var % nbdim = 5 
    167167             Agrif_Gr % tabvars(i) % var % lb(1:5) =  
     
    170170     &         ubound(Agrif_Gr%tabvars(i)%var%array5) 
    171171         endif 
    172          if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
     172         if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then 
    173173             Agrif_Gr % tabvars(i) % var % nbdim = 6 
    174174             Agrif_Gr % tabvars(i) % var % lb(1:6) =  
     
    178178         endif 
    179179C 
    180          if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 
    181              Agrif_Gr % tabvars(i) % var % nbdim = 1 
    182          endif 
    183          if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 
    184              Agrif_Gr % tabvars(i) % var % nbdim = 2 
    185          endif 
    186          if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 
    187              Agrif_Gr % tabvars(i) % var % nbdim = 3 
    188          endif 
    189          if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 
    190              Agrif_Gr % tabvars(i) % var % nbdim = 4 
    191          endif 
    192          if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 
    193              Agrif_Gr % tabvars(i) % var % nbdim = 5 
    194          endif 
    195          if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 
    196              Agrif_Gr % tabvars(i) % var % nbdim = 6 
    197          endif 
    198 C 
    199          if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 
    200              Agrif_Gr % tabvars(i) % var % nbdim = 1 
    201          endif 
    202          if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 
    203              Agrif_Gr % tabvars(i) % var % nbdim = 2 
    204          endif 
    205          if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 
    206              Agrif_Gr % tabvars(i) % var % nbdim = 3 
    207          endif 
    208          if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 
    209              Agrif_Gr % tabvars(i) % var % nbdim = 4 
    210          endif 
    211          if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 
    212              Agrif_Gr % tabvars(i) % var % nbdim = 5 
    213          endif 
    214          if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 
    215              Agrif_Gr % tabvars(i) % var % nbdim = 6 
    216          endif 
    217 C 
    218          if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
    219              Agrif_Gr % tabvars(i) % var % nbdim = 1 
    220          endif 
    221          if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
    222              Agrif_Gr % tabvars(i) % var % nbdim = 2 
    223          endif 
    224          if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
    225              Agrif_Gr % tabvars(i) % var % nbdim = 3 
    226          endif 
    227          if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
    228              Agrif_Gr % tabvars(i) % var % nbdim = 4 
    229          endif 
    230          if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
    231              Agrif_Gr % tabvars(i) % var % nbdim = 5 
    232          endif 
    233          if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
    234              Agrif_Gr % tabvars(i) % var % nbdim = 6 
    235          endif 
    236 C 
    237          if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 
    238              Agrif_Gr % tabvars(i) % var % nbdim = 1 
    239          endif 
    240          if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 
     180         if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then 
     181             Agrif_Gr % tabvars(i) % var % nbdim = 1 
     182         endif 
     183         if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then 
     184             Agrif_Gr % tabvars(i) % var % nbdim = 2 
     185         endif 
     186         if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then 
     187             Agrif_Gr % tabvars(i) % var % nbdim = 3 
     188         endif 
     189         if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then 
     190             Agrif_Gr % tabvars(i) % var % nbdim = 4 
     191         endif 
     192         if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then 
     193             Agrif_Gr % tabvars(i) % var % nbdim = 5 
     194         endif 
     195         if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then 
     196             Agrif_Gr % tabvars(i) % var % nbdim = 6 
     197         endif 
     198C 
     199         if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then 
     200             Agrif_Gr % tabvars(i) % var % nbdim = 1 
     201         endif 
     202         if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then 
     203             Agrif_Gr % tabvars(i) % var % nbdim = 2 
     204         endif 
     205         if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then 
     206             Agrif_Gr % tabvars(i) % var % nbdim = 3 
     207         endif 
     208         if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then 
     209             Agrif_Gr % tabvars(i) % var % nbdim = 4 
     210         endif 
     211         if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then 
     212             Agrif_Gr % tabvars(i) % var % nbdim = 5 
     213         endif 
     214         if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then 
     215             Agrif_Gr % tabvars(i) % var % nbdim = 6 
     216         endif 
     217C 
     218         if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
     219             Agrif_Gr % tabvars(i) % var % nbdim = 1 
     220         endif 
     221         if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
     222             Agrif_Gr % tabvars(i) % var % nbdim = 2 
     223         endif 
     224         if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
     225             Agrif_Gr % tabvars(i) % var % nbdim = 3 
     226         endif 
     227         if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
     228             Agrif_Gr % tabvars(i) % var % nbdim = 4 
     229         endif 
     230         if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
     231             Agrif_Gr % tabvars(i) % var % nbdim = 5 
     232         endif 
     233         if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
     234             Agrif_Gr % tabvars(i) % var % nbdim = 6 
     235         endif 
     236C 
     237         if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then 
     238             Agrif_Gr % tabvars(i) % var % nbdim = 1 
     239         endif 
     240         if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then 
    241241             Agrif_Gr % tabvars(i) % var % nbdim = 2 
    242242         endif 
  • vendors/AGRIF/current/AGRIF_FILES/modinterp.F

    r1901 r2671  
    11! 
    2 ! $Id: modinterp.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modinterp.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    8989C 
    9090C     Tab is the result of the interpolation 
    91       childtemp % var % array1 => tab  
     91      childtemp % var % parray1 => tab  
    9292       
    9393      childtemp % var % lb = child % var % lb 
     
    9797      if (torestore) then 
    9898C  
    99           childtemp % var % array1 = child % var % array1 
     99          childtemp % var % parray1 = child % var % array1 
    100100C           
    101101          childtemp % var % restore1D => child % var % restore1D 
     
    171171C 
    172172C     Tab is the result of the interpolation 
    173       childtemp % var % array2 => tab   
     173      childtemp % var % parray2 => tab   
    174174       
    175175      childtemp % var % lb = child % var % lb 
     
    179179      if (torestore) then       
    180180C  
    181           childtemp % var % array2 = child % var % array2           
     181          childtemp % var % parray2 = child % var % array2           
    182182C  
    183183          childtemp % var % restore2D => child % var % restore2D         
     
    255255C      
    256256C     Tab is the result of the interpolation  
    257       childtemp % var % array3 => tab  
     257      childtemp % var % parray3 => tab  
    258258       
    259259      childtemp % var % lb = child % var % lb 
     
    262262      if (torestore) then 
    263263C      
    264           childtemp % var % array3 = child % var % array3 
     264          childtemp % var % parray3 = child % var % array3 
    265265C 
    266266          childtemp % var % restore3D => child % var % restore3D 
     
    341341C       
    342342C     Tab is the result of the interpolation 
    343       childtemp % var % array4 => tab  
     343      childtemp % var % parray4 => tab  
    344344       
    345345      childtemp % var % lb = child % var % lb 
     
    349349      if (torestore) then 
    350350C  
    351           childtemp % var % array4 = child % var % array4 
     351          childtemp % var % parray4 = child % var % array4 
    352352C 
    353353          childtemp % var % restore4D => child % var % restore4D 
     
    428428C       
    429429C     Tab is the result of the interpolation 
    430       childtemp % var % array5 => tab   
     430      childtemp % var % parray5 => tab   
    431431       
    432432      childtemp % var % lb = child % var % lb 
     
    436436      if (torestore) then 
    437437C  
    438           childtemp % var % array5 = child % var % array5 
     438          childtemp % var % parray5 = child % var % array5 
    439439C 
    440440          childtemp % var % restore5D => child % var % restore5D 
     
    516516C       
    517517C     Tab is the result of the interpolation 
    518       childtemp % var % array6 => tab   
     518      childtemp % var % parray6 => tab   
    519519       
    520520      childtemp % var % lb = child % var % lb 
     
    524524      if (torestore) then 
    525525C  
    526           childtemp % var % array6 = child % var % array6 
     526          childtemp % var % parray6 = child % var % array6 
    527527C 
    528528          childtemp % var % restore6D => child % var % restore6D 
     
    573573C 
    574574CC    Declarations: 
    575 C       
     575C        
    576576c       
    577577C       
     
    835835 
    836836      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim) 
    837  
    838  
    839837 
    840838      IF (present(procname)) THEN 
     
    894892C 
    895893      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 
    896      &                   MPI_INTEGER,MPI_COMM_AGRIF,code) 
     894     &                   MPI_INTEGER,MPI_COMM_WORLD,code) 
    897895 
    898896      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var) 
     
    908906      memberin1(1) = memberin 
    909907      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 
    910      &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code) 
     908     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
    911909 
    912910       Call Get_External_Data_first(tab4t(:,:,1), 
     
    11611159           do i = pttruetab(1),cetruetab(1)          
    11621160            if (restore%var%restore1D(i) == 0) 
    1163      &            child % var % array1(i) =  
     1161     &            child % var % parray1(i) =  
    11641162     &            tempC % var % array1(i)     
    11651163          enddo 
     
    11681166             do i = pttruetab(1),cetruetab(1)  
    11691167              if (restore%var%restore2D(i,j) == 0)      
    1170      &              child % var % array2(i,j) =  
     1168     &              child % var % parray2(i,j) =  
    11711169     &              tempC % var % array2(i,j)     
    11721170              enddo 
     
    11771175             do i = pttruetab(1),cetruetab(1)  
    11781176              if (restore%var%restore3D(i,j,k) == 0) 
    1179      &                  child % var % array3(i,j,k) = 
     1177     &                  child % var % parray3(i,j,k) = 
    11801178     &                  tempC % var % array3(i,j,k)     
    11811179                  enddo 
     
    11881186             do i = pttruetab(1),cetruetab(1) 
    11891187                if (restore%var%restore4D(i,j,k,l) == 0) 
    1190      &                 child % var % array4(i,j,k,l) =  
     1188     &                 child % var % parray4(i,j,k,l) =  
    11911189     &                 tempC % var % array4(i,j,k,l)     
    11921190             enddo 
     
    12011199             do i = pttruetab(1),cetruetab(1) 
    12021200                if (restore%var%restore5D(i,j,k,l,m) == 0) 
    1203      &                  child % var % array5(i,j,k,l,m) =  
     1201     &                  child % var % parray5(i,j,k,l,m) =  
    12041202     &                  tempC % var % array5(i,j,k,l,m)     
    12051203             enddo 
     
    12161214             do i = pttruetab(1),cetruetab(1) 
    12171215                if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
    1218      &                      child % var % array6(i,j,k,l,m,n) =  
     1216     &                      child % var % parray6(i,j,k,l,m,n) =  
    12191217     &                      tempC % var % array6(i,j,k,l,m,n)     
    12201218             enddo 
     
    12341232          SELECT CASE (nbdim) 
    12351233          CASE (1) 
    1236             child%var%array1(childarray(1,1,2):childarray(1,2,2)) = 
     1234            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) = 
    12371235     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1)) 
    12381236          CASE (2) 
    1239             child%var%array2(childarray(1,1,2):childarray(1,2,2), 
     1237            child%var%parray2(childarray(1,1,2):childarray(1,2,2), 
    12401238     &                       childarray(2,1,2):childarray(2,2,2)) = 
    12411239     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1), 
    12421240     &                       childarray(2,1,1):childarray(2,2,1)) 
    12431241          CASE (3) 
    1244             child%var%array3(childarray(1,1,2):childarray(1,2,2), 
     1242            child%var%parray3(childarray(1,1,2):childarray(1,2,2), 
    12451243     &                       childarray(2,1,2):childarray(2,2,2), 
    12461244     &                       childarray(3,1,2):childarray(3,2,2)) = 
     
    12491247     &                       childarray(3,1,1):childarray(3,2,1)) 
    12501248          CASE (4) 
    1251             child%var%array4(childarray(1,1,2):childarray(1,2,2), 
     1249            child%var%parray4(childarray(1,1,2):childarray(1,2,2), 
    12521250     &                       childarray(2,1,2):childarray(2,2,2), 
    12531251     &                       childarray(3,1,2):childarray(3,2,2), 
     
    12581256     &                       childarray(4,1,1):childarray(4,2,1)) 
    12591257          CASE (5) 
    1260             child%var%array5(childarray(1,1,2):childarray(1,2,2), 
     1258            child%var%parray5(childarray(1,1,2):childarray(1,2,2), 
    12611259     &                       childarray(2,1,2):childarray(2,2,2), 
    12621260     &                       childarray(3,1,2):childarray(3,2,2), 
     
    12691267     &                       childarray(5,1,1):childarray(5,2,1)) 
    12701268          CASE (6) 
    1271             child%var%array6(childarray(1,1,2):childarray(1,2,2), 
     1269            child%var%parray6(childarray(1,1,2):childarray(1,2,2), 
    12721270     &                       childarray(2,1,2):childarray(2,2,2), 
    12731271     &                       childarray(3,1,2):childarray(3,2,2), 
  • vendors/AGRIF/current/AGRIF_FILES/modinterpbasic.F

    r1901 r2671  
    11! 
    2 ! $Id: modinterpbasic.F 898 2008-04-22 15:35:20Z rblod $ 
     2! $Id: modinterpbasic.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    113113           locind_parent_left = locind_parent_left + 1. 
    114114           globind_parent_right = globind_parent_right + 1. 
     115           ypos2 = ypos*invds+(i-1)*invds2            
    115116        endif 
    116117         
    117118        diff=(globind_parent_right - ypos2) 
    118          
    119119        y(i) = (diff*x(locind_parent_left) 
    120120     &        + (1.-diff)*x(locind_parent_left+1)) 
     
    170170      Real, Dimension(:,:), Allocatable :: coeffparent_tmp 
    171171      REAL    :: ypos,globind_parent_left,globind_parent_right 
    172       REAL    :: invds, invds2 
     172      REAL    :: invds, invds2, invds3 
    173173      REAL :: ypos2,diff 
    174174C 
     
    189189      invds = 1./ds_parent 
    190190      invds2 = ds_child/ds_parent 
     191      invds3 = 0.5/real(coeffraf) 
    191192 
    192193      ypos2 = ypos*invds 
     
    216217           locind_parent_left = locind_parent_left + 1 
    217218           globind_parent_right = globind_parent_right + 1. 
     219           ypos2 = ypos*invds+(i-1)*invds2 
    218220        endif 
    219          
     221 
    220222        diff=(globind_parent_right - ypos2) 
     223        diff = invds3*nint(2*coeffraf*diff) 
    221224        indparent(i,dir) = locind_parent_left 
     225 
    222226        coeffparent(i,dir) = diff 
    223227         
     
    238242C       
    239243       indparent(nc,dir) = locind_parent_left 
    240         
    241          coeffparent(nc,dir) = (globind_parent_left + ds_parent - ypos) 
     244       diff = (globind_parent_left + ds_parent - ypos) 
    242245     &       * invds 
    243       endif                                            
     246        diff = invds3*nint(2*coeffraf*diff) 
     247         coeffparent(nc,dir) = diff 
     248        endif                                            
    244249 
    245250      do i=2, np2 
     
    280285      INTEGER :: i,coeffraf,locind_parent_left 
    281286      REAL    :: ypos,globind_parent_left,globind_parent_right 
    282       REAL    :: invds, invds2 
     287      REAL    :: invds, invds2, invds3 
    283288      REAL :: ypos2,diff 
    284289C 
     
    305310      invds = 1./ds_parent 
    306311      invds2 = ds_child/ds_parent 
     312      invds3 = 0.5/real(coeffraf)       
    307313       
    308314      ypos2 = ypos*invds 
     
    323329           locind_parent_left = locind_parent_left + 1 
    324330           globind_parent_right = globind_parent_right + 1. 
     331           ypos2 = ypos*invds+(i-1)*invds2            
    325332        endif 
    326333         
    327334        diff=(globind_parent_right - ypos2) 
     335         
     336        diff = invds3*nint(2*coeffraf*diff) 
     337                 
    328338        indparent(i,1) = locind_parent_left 
     339 
    329340        coeffparent(i,1) = diff 
    330341        ypos2 = ypos2 + invds2 
     
    344355C       
    345356       indparent(nc,1) = locind_parent_left 
    346         
    347          coeffparent(nc,1) = (globind_parent_left + ds_parent - ypos) 
     357  
     358       diff = (globind_parent_left + ds_parent - ypos) 
    348359     &       * invds 
    349       endif                                           
     360        diff = invds3*nint(2*coeffraf*diff) 
     361         coeffparent(nc,1) = diff 
     362         endif                                           
    350363C            
    351364      Return 
     
    462475     &                        + (locind_parent_left - 1)*ds_parent  
    463476      
    464         deltax = invdsparent*(ypos-globind_parent_left) 
     477C        deltax = invdsparent*(ypos-globind_parent_left) 
     478        deltax = nint(coeffraf*deltax)/real(coeffraf) 
     479         
    465480        ypos = ypos + ds_child 
    466481         if (abs(deltax).LE.0.0001) then 
  • vendors/AGRIF/current/AGRIF_FILES/modlinktomodel.F

    r1901 r2671  
    3232        external Agrif_probdim_modtype_def 
    3333        external Agrif_clustering_def 
    34         external Agrif_comm_def 
    3534C     Interface                        
    3635      Interface 
  • vendors/AGRIF/current/AGRIF_FILES/modmask.F

    r1901 r2671  
    11! 
    2 ! $Id: modmask.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modmask.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
  • vendors/AGRIF/current/AGRIF_FILES/modmpp.F

    r1901 r2671  
    11! 
    2 ! $Id: modmpp.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modmpp.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    6767 
    6868         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall, 
    69      &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code) 
     69     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
    7070        ENDIF 
    7171         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) 
     
    207207 
    208208         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall, 
    209      &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code) 
     209     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
    210210        ENDIF 
    211211         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) 
     
    356356C 
    357357            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
    358      &                    MPI_COMM_AGRIF,code) 
     358     &                    MPI_COMM_WORLD,code) 
    359359C 
    360360            if (sendtoproc(k)) then 
     
    365365                Call MPI_SEND(iminmax_temp(:,:,k), 
    366366     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    367      &                        MPI_COMM_AGRIF,code) 
     367     &                        MPI_COMM_WORLD,code) 
    368368C 
    369369                datasize = 1 
     
    381381     &                        imin(1,k):imax(1,k)), 
    382382     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    383      &                        MPI_COMM_AGRIF,code) 
     383     &                        MPI_COMM_WORLD,code) 
    384384                CASE(2) 
    385385                   Call MPI_SEND(tempC%var%array2( 
     
    387387     &                        imin(2,k):imax(2,k)), 
    388388     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    389      &                        MPI_COMM_AGRIF,code) 
     389     &                        MPI_COMM_WORLD,code) 
    390390                CASE(3) 
    391391                 
     
    399399     &                        imin(4,k):imax(4,k)), 
    400400     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    401      &                        MPI_COMM_AGRIF,code) 
     401     &                        MPI_COMM_WORLD,code) 
    402402                CASE(5) 
    403403                   Call MPI_SEND(tempC%var%array5( 
     
    408408     &                        imin(5,k):imax(5,k)), 
    409409     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    410      &                        MPI_COMM_AGRIF,code) 
     410     &                        MPI_COMM_WORLD,code) 
    411411                CASE(6) 
    412412                   Call MPI_SEND(tempC%var%array6( 
     
    418418     &                        imin(6,k):imax(6,k)), 
    419419     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    420      &                        MPI_COMM_AGRIF,code) 
     420     &                        MPI_COMM_WORLD,code) 
    421421                END SELECT 
    422422C 
     
    432432C 
    433433            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
    434      &                    MPI_COMM_AGRIF,statut,code) 
     434     &                    MPI_COMM_WORLD,statut,code) 
    435435C 
    436436            recvfromproc(k) = res 
     
    441441                Call MPI_RECV(iminmax_temp(:,:,k), 
    442442     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    443      &                        MPI_COMM_AGRIF,statut,code) 
     443     &                        MPI_COMM_WORLD,statut,code) 
    444444 
    445445                imin_recv(:,k) = iminmax_temp(:,1,k) 
     
    462462              Call MPI_RECV(temprecv%var%array1, 
    463463     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    464      &               MPI_COMM_AGRIF,statut,code) 
     464     &               MPI_COMM_WORLD,statut,code) 
    465465            CASE(2) 
    466466              Call MPI_RECV(temprecv%var%array2, 
    467467     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    468      &               MPI_COMM_AGRIF,statut,code) 
     468     &               MPI_COMM_WORLD,statut,code) 
    469469            CASE(3) 
    470470              Call MPI_RECV(temprecv%var%array3, 
    471471     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    472      &               MPI_COMM_AGRIF,statut,code) 
     472     &               MPI_COMM_WORLD,statut,code) 
    473473 
    474474            CASE(4) 
    475475              Call MPI_RECV(temprecv%var%array4, 
    476476     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    477      &               MPI_COMM_AGRIF,statut,code) 
     477     &               MPI_COMM_WORLD,statut,code) 
    478478            CASE(5) 
    479479              Call MPI_RECV(temprecv%var%array5, 
    480480     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    481      &               MPI_COMM_AGRIF,statut,code) 
     481     &               MPI_COMM_WORLD,statut,code) 
    482482            CASE(6) 
    483483              Call MPI_RECV(temprecv%var%array6, 
    484484     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    485      &               MPI_COMM_AGRIF,statut,code) 
     485     &               MPI_COMM_WORLD,statut,code) 
    486486       END SELECT 
    487487                         
     
    503503             
    504504            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
    505      &                    MPI_COMM_AGRIF,code) 
     505     &                    MPI_COMM_WORLD,code) 
    506506C 
    507507            if (sendtoproc(k)) then 
     
    512512                Call MPI_SEND(iminmax_temp(:,:,k), 
    513513     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    514      &                        MPI_COMM_AGRIF,code) 
     514     &                        MPI_COMM_WORLD,code) 
    515515C 
    516516                SELECT CASE(nbdim) 
     
    521521     &                        imin(1,k):imax(1,k)), 
    522522     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    523      &                        MPI_COMM_AGRIF,code) 
     523     &                        MPI_COMM_WORLD,code) 
    524524                CASE(2) 
    525525                datasize=SIZE(tempC%var%array2( 
     
    530530     &                        imin(2,k):imax(2,k)), 
    531531     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    532      &                        MPI_COMM_AGRIF,code) 
     532     &                        MPI_COMM_WORLD,code) 
    533533                CASE(3) 
    534534                datasize=SIZE(tempC%var%array3( 
     
    541541     &                        imin(3,k):imax(3,k)), 
    542542     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    543      &                        MPI_COMM_AGRIF,code) 
     543     &                        MPI_COMM_WORLD,code) 
    544544                CASE(4) 
    545545                datasize=SIZE(tempC%var%array4( 
     
    554554     &                        imin(4,k):imax(4,k)), 
    555555     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    556      &                        MPI_COMM_AGRIF,code) 
     556     &                        MPI_COMM_WORLD,code) 
    557557                CASE(5) 
    558558                datasize=SIZE(tempC%var%array5( 
     
    569569     &                        imin(5,k):imax(5,k)), 
    570570     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    571      &                        MPI_COMM_AGRIF,code) 
     571     &                        MPI_COMM_WORLD,code) 
    572572                CASE(6) 
    573573                datasize=SIZE(tempC%var%array6( 
     
    586586     &                        imin(6,k):imax(6,k)), 
    587587     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    588      &                        MPI_COMM_AGRIF,code) 
     588     &                        MPI_COMM_WORLD,code) 
    589589                END SELECT 
    590590C 
     
    600600C 
    601601            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
    602      &                    MPI_COMM_AGRIF,statut,code) 
     602     &                    MPI_COMM_WORLD,statut,code) 
    603603C 
    604604            recvfromproc(k) = res 
     
    609609                Call MPI_RECV(iminmax_temp(:,:,k), 
    610610     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    611      &                        MPI_COMM_AGRIF,statut,code) 
     611     &                        MPI_COMM_WORLD,statut,code) 
    612612 
    613613C                imin_recv(:,k) = iminmax_temp(:,1,k) 
     
    629629              Call MPI_RECV(temprecv%var%array1, 
    630630     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    631      &               MPI_COMM_AGRIF,statut,code) 
     631     &               MPI_COMM_WORLD,statut,code) 
    632632            CASE(2) 
    633633              datasize=SIZE(temprecv%var%array2) 
    634634              Call MPI_RECV(temprecv%var%array2, 
    635635     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    636      &               MPI_COMM_AGRIF,statut,code) 
     636     &               MPI_COMM_WORLD,statut,code) 
    637637            CASE(3) 
    638638              datasize=SIZE(temprecv%var%array3) 
    639639              Call MPI_RECV(temprecv%var%array3, 
    640640     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    641      &               MPI_COMM_AGRIF,statut,code) 
     641     &               MPI_COMM_WORLD,statut,code) 
    642642 
    643643            CASE(4) 
     
    645645              Call MPI_RECV(temprecv%var%array4, 
    646646     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    647      &               MPI_COMM_AGRIF,statut,code) 
     647     &               MPI_COMM_WORLD,statut,code) 
    648648            CASE(5) 
    649649              datasize=SIZE(temprecv%var%array5) 
    650650              Call MPI_RECV(temprecv%var%array5, 
    651651     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    652      &               MPI_COMM_AGRIF,statut,code) 
     652     &               MPI_COMM_WORLD,statut,code) 
    653653            CASE(6) 
    654654              datasize=SIZE(temprecv%var%array6) 
    655655              Call MPI_RECV(temprecv%var%array6, 
    656656     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    657      &               MPI_COMM_AGRIF,statut,code) 
     657     &               MPI_COMM_WORLD,statut,code) 
    658658          END SELECT 
    659659             
     
    693693C 
    694694            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
    695      &                    MPI_COMM_AGRIF,code) 
     695     &                    MPI_COMM_WORLD,code) 
    696696C 
    697697            if (sendtoproc(k)) then 
     
    702702                Call MPI_SEND(iminmax_temp(:,:,k), 
    703703     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    704      &                        MPI_COMM_AGRIF,code) 
     704     &                        MPI_COMM_WORLD,code) 
    705705C 
    706706            endif 
     
    715715C 
    716716            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
    717      &                    MPI_COMM_AGRIF,statut,code) 
     717     &                    MPI_COMM_WORLD,statut,code) 
    718718C 
    719719            recvfromproc(k) = res 
     
    724724                Call MPI_RECV(iminmax_temp(:,:,k), 
    725725     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    726      &                        MPI_COMM_AGRIF,statut,code) 
     726     &                        MPI_COMM_WORLD,statut,code) 
    727727 
    728728                imin_recv(:,k) = iminmax_temp(:,1,k) 
     
    739739             
    740740            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 
    741      &                    MPI_COMM_AGRIF,code) 
     741     &                    MPI_COMM_WORLD,code) 
    742742C 
    743743            if (sendtoproc(k)) then 
     
    748748                Call MPI_SEND(iminmax_temp(:,:,k), 
    749749     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    750      &                        MPI_COMM_AGRIF,code) 
     750     &                        MPI_COMM_WORLD,code) 
    751751C 
    752752            endif 
     
    761761C 
    762762            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 
    763      &                    MPI_COMM_AGRIF,statut,code) 
     763     &                    MPI_COMM_WORLD,statut,code) 
    764764C 
    765765            recvfromproc(k) = res 
     
    770770                Call MPI_RECV(iminmax_temp(:,:,k), 
    771771     &                        2*nbdim,MPI_INTEGER,k,etiquette, 
    772      &                        MPI_COMM_AGRIF,statut,code) 
     772     &                        MPI_COMM_WORLD,statut,code) 
    773773 
    774774                imin_recv(:,k) = iminmax_temp(:,1,k) 
     
    842842     &                        imin(1,k):imax(1,k)), 
    843843     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    844      &                        MPI_COMM_AGRIF,code) 
     844     &                        MPI_COMM_WORLD,code) 
    845845                CASE(2)                
    846846                   Call MPI_SEND(tempC%var%array2( 
     
    848848     &                        imin(2,k):imax(2,k)), 
    849849     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    850      &                        MPI_COMM_AGRIF,code) 
     850     &                        MPI_COMM_WORLD,code) 
    851851                CASE(3) 
    852852      
     
    860860     &                        imin(4,k):imax(4,k)), 
    861861     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    862      &                        MPI_COMM_AGRIF,code) 
     862     &                        MPI_COMM_WORLD,code) 
    863863                CASE(5) 
    864864                   Call MPI_SEND(tempC%var%array5( 
     
    869869     &                        imin(5,k):imax(5,k)), 
    870870     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    871      &                        MPI_COMM_AGRIF,code) 
     871     &                        MPI_COMM_WORLD,code) 
    872872                CASE(6) 
    873873                   Call MPI_SEND(tempC%var%array6( 
     
    879879     &                        imin(6,k):imax(6,k)), 
    880880     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    881      &                        MPI_COMM_AGRIF,code) 
     881     &                        MPI_COMM_WORLD,code) 
    882882                END SELECT 
    883883C 
     
    910910              Call MPI_RECV(temprecv%var%array1, 
    911911     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    912      &               MPI_COMM_AGRIF,statut,code) 
     912     &               MPI_COMM_WORLD,statut,code) 
    913913            CASE(2)            
    914914              Call MPI_RECV(temprecv%var%array2, 
    915915     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    916      &               MPI_COMM_AGRIF,statut,code) 
     916     &               MPI_COMM_WORLD,statut,code) 
    917917            CASE(3)        
    918918              Call MPI_RECV(temprecv%var%array3, 
    919919     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    920      &               MPI_COMM_AGRIF,statut,code) 
     920     &               MPI_COMM_WORLD,statut,code) 
    921921 
    922922            CASE(4) 
    923923              Call MPI_RECV(temprecv%var%array4, 
    924924     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    925      &               MPI_COMM_AGRIF,statut,code) 
     925     &               MPI_COMM_WORLD,statut,code) 
    926926            CASE(5) 
    927927              Call MPI_RECV(temprecv%var%array5, 
    928928     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    929      &               MPI_COMM_AGRIF,statut,code) 
     929     &               MPI_COMM_WORLD,statut,code) 
    930930            CASE(6) 
    931931              Call MPI_RECV(temprecv%var%array6, 
    932932     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    933      &               MPI_COMM_AGRIF,statut,code) 
     933     &               MPI_COMM_WORLD,statut,code) 
    934934       END SELECT 
    935935                         
     
    958958     &                        imin(1,k):imax(1,k)), 
    959959     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    960      &                        MPI_COMM_AGRIF,code) 
     960     &                        MPI_COMM_WORLD,code) 
    961961                CASE(2)                 
    962962                datasize=SIZE(tempC%var%array2( 
     
    967967     &                        imin(2,k):imax(2,k)), 
    968968     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    969      &                        MPI_COMM_AGRIF,code) 
     969     &                        MPI_COMM_WORLD,code) 
    970970                CASE(3) 
    971971                datasize=SIZE(tempC%var%array3( 
     
    978978     &                        imin(3,k):imax(3,k)), 
    979979     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    980      &                        MPI_COMM_AGRIF,code) 
     980     &                        MPI_COMM_WORLD,code) 
    981981                CASE(4) 
    982982                datasize=SIZE(tempC%var%array4( 
     
    991991     &                        imin(4,k):imax(4,k)), 
    992992     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    993      &                        MPI_COMM_AGRIF,code) 
     993     &                        MPI_COMM_WORLD,code) 
    994994                CASE(5) 
    995995                datasize=SIZE(tempC%var%array5( 
     
    10061006     &                        imin(5,k):imax(5,k)), 
    10071007     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1008      &                        MPI_COMM_AGRIF,code) 
     1008     &                        MPI_COMM_WORLD,code) 
    10091009                CASE(6) 
    10101010                datasize=SIZE(tempC%var%array6( 
     
    10231023     &                        imin(6,k):imax(6,k)), 
    10241024     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1025      &                        MPI_COMM_AGRIF,code) 
     1025     &                        MPI_COMM_WORLD,code) 
    10261026                END SELECT 
    10271027C 
     
    10471047              Call MPI_RECV(temprecv%var%array1, 
    10481048     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1049      &               MPI_COMM_AGRIF,statut,code) 
     1049     &               MPI_COMM_WORLD,statut,code) 
    10501050            CASE(2)            
    10511051              datasize=SIZE(temprecv%var%array2) 
    10521052              Call MPI_RECV(temprecv%var%array2, 
    10531053     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1054      &               MPI_COMM_AGRIF,statut,code) 
     1054     &               MPI_COMM_WORLD,statut,code) 
    10551055            CASE(3)            
    10561056              datasize=SIZE(temprecv%var%array3) 
    10571057              Call MPI_RECV(temprecv%var%array3, 
    10581058     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1059      &               MPI_COMM_AGRIF,statut,code) 
     1059     &               MPI_COMM_WORLD,statut,code) 
    10601060 
    10611061            CASE(4) 
     
    10631063              Call MPI_RECV(temprecv%var%array4, 
    10641064     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1065      &               MPI_COMM_AGRIF,statut,code) 
     1065     &               MPI_COMM_WORLD,statut,code) 
    10661066            CASE(5) 
    10671067              datasize=SIZE(temprecv%var%array5) 
    10681068              Call MPI_RECV(temprecv%var%array5, 
    10691069     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1070      &               MPI_COMM_AGRIF,statut,code) 
     1070     &               MPI_COMM_WORLD,statut,code) 
    10711071            CASE(6) 
    10721072              datasize=SIZE(temprecv%var%array6) 
    10731073              Call MPI_RECV(temprecv%var%array6, 
    10741074     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1075      &               MPI_COMM_AGRIF,statut,code) 
     1075     &               MPI_COMM_WORLD,statut,code) 
    10761076          END SELECT 
    10771077             
     
    11081108     &                        imin(3):imax(3)), 
    11091109     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette, 
    1110      &                        MPI_COMM_AGRIF,code) 
     1110     &                        MPI_COMM_WORLD,code) 
    11111111      
    11121112         End Subroutine Agrif_Send_3Darray 
  • vendors/AGRIF/current/AGRIF_FILES/modsauv.F

    r1901 r2671  
    11! 
    2 ! $Id: modsauv.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modsauv.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    3535      Use Agrif_Link 
    3636      Use Agrif_Arrays 
     37      Use Agrif_Variables 
    3738C 
    3839      IMPLICIT NONE 
     
    4243C 
    4344C 
     45      Subroutine Agrif_Deallocate_Arrays(Var) 
     46      type(Agrif_Variable), pointer :: Var 
     47       
     48            if (ALLOCATED(var%array1)) then 
     49               Deallocate(var%array1) 
     50            endif 
     51            if (ALLOCATED(var%array2)) then 
     52               Deallocate(var%array2) 
     53            endif 
     54            if (ALLOCATED(var%array3)) then 
     55               Deallocate(var%array3) 
     56            endif 
     57            if (ALLOCATED(var%array4)) then 
     58               Deallocate(var%array4) 
     59            endif 
     60            if (ALLOCATED(var%array5)) then 
     61               Deallocate(var%array5) 
     62            endif 
     63            if (ALLOCATED(var%array6)) then 
     64               Deallocate(var%array6) 
     65            endif 
     66C 
     67            if (ALLOCATED(var%darray1)) then 
     68               Deallocate(var%darray1) 
     69            endif 
     70            if (ALLOCATED(var%darray2)) then 
     71               Deallocate(var%darray2) 
     72            endif 
     73            if (ALLOCATED(var%darray3)) then 
     74               Deallocate(var%darray3) 
     75            endif 
     76            if (ALLOCATED(var%darray4)) then 
     77               Deallocate(var%darray4) 
     78            endif 
     79            if (ALLOCATED(var%darray5)) then 
     80               Deallocate(var%darray5) 
     81            endif 
     82            if (ALLOCATED(var%darray6)) then 
     83               Deallocate(var%darray6) 
     84            endif 
     85C 
     86            if (ALLOCATED(var%larray1)) then 
     87               Deallocate(var%larray1) 
     88            endif 
     89            if (ALLOCATED(var%larray2)) then 
     90               Deallocate(var%larray2) 
     91            endif 
     92            if (ALLOCATED(var%larray3)) then 
     93               Deallocate(var%larray3) 
     94            endif 
     95            if (ALLOCATED(var%larray4)) then 
     96               Deallocate(var%larray4) 
     97            endif 
     98            if (ALLOCATED(var%larray5)) then 
     99               Deallocate(var%larray5) 
     100            endif 
     101            if (ALLOCATED(var%larray6)) then 
     102               Deallocate(var%larray6) 
     103            endif 
     104C 
     105            if (ALLOCATED(var%iarray1)) then 
     106               Deallocate(var%iarray1) 
     107            endif 
     108            if (ALLOCATED(var%iarray2)) then 
     109               Deallocate(var%iarray2) 
     110            endif 
     111            if (ALLOCATED(var%iarray3)) then 
     112               Deallocate(var%iarray3) 
     113            endif 
     114            if (ALLOCATED(var%iarray4)) then 
     115               Deallocate(var%iarray4) 
     116            endif 
     117            if (ALLOCATED(var%iarray5)) then 
     118               Deallocate(var%iarray5) 
     119            endif 
     120            if (ALLOCATED(var%iarray6)) then 
     121               Deallocate(var%iarray6) 
     122            endif 
     123C 
     124            if (ALLOCATED(var%carray1)) then 
     125               Deallocate(var%carray1) 
     126            endif 
     127            if (ALLOCATED(var%carray2)) then 
     128               Deallocate(var%carray2) 
     129            endif 
     130C 
     131            if (associated(var%oldvalues2D)) then 
     132               Deallocate(var%oldvalues2D) 
     133            endif 
     134            if (associated(var%interpIndex)) then 
     135               Deallocate(var%interpIndex) 
     136            endif 
     137             
     138            if (associated(var%posvar)) then 
     139               Deallocate(var%posvar) 
     140            endif      
     141             
     142            if (associated(var%interptab)) then 
     143               Deallocate(var%interptab) 
     144            endif 
     145             
     146      Return 
     147      End Subroutine Agrif_Deallocate_Arrays     
    44148C 
    45149C     ************************************************************************** 
     
    62166      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid 
    63167      INTEGER i  
     168      Type(Agrif_List_Variables), pointer :: parcours       
    64169C 
    65170C    
     
    67172         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 
    68173C  
    69             if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
    70                Deallocate(Agrif_Gr%tabvars(i)%var%array1) 
    71             endif 
    72             if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
    73                Deallocate(Agrif_Gr%tabvars(i)%var%array2) 
    74             endif 
    75             if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
    76                Deallocate(Agrif_Gr%tabvars(i)%var%array3) 
    77             endif 
    78             if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
    79                Deallocate(Agrif_Gr%tabvars(i)%var%array4) 
    80             endif 
    81             if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
    82                Deallocate(Agrif_Gr%tabvars(i)%var%array5) 
    83             endif 
    84             if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
    85                Deallocate(Agrif_Gr%tabvars(i)%var%array6) 
    86             endif 
    87 C 
    88             if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 
    89                Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 
    90             endif 
    91             if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 
    92                Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 
    93             endif 
    94             if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 
    95                Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 
    96             endif 
    97             if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 
    98                Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 
    99             endif 
    100             if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 
    101                Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 
    102             endif 
    103             if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 
    104                Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 
    105             endif 
    106 C 
    107             if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 
    108                Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 
    109             endif 
    110             if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 
    111                Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 
    112             endif 
    113             if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 
    114                Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 
    115             endif 
    116             if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 
    117                Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 
    118             endif 
    119             if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 
    120                Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 
    121             endif 
    122             if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 
    123                Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 
    124             endif 
    125 C 
    126             if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
    127                Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 
    128             endif 
    129             if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
    130                Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 
    131             endif 
    132             if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
    133                Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 
    134             endif 
    135             if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
    136                Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 
    137             endif 
    138             if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
    139                Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 
    140             endif 
    141             if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
    142                Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 
    143             endif 
    144 C 
    145             if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 
    146                Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 
    147             endif 
    148             if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 
    149                Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 
    150             endif 
    151 C 
    152             if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 
    153                Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 
    154             endif 
    155             if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 
    156                Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 
    157             endif 
     174            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 
    158175             
    159             if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 
    160                Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 
    161             endif      
    162              
    163             if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 
    164                Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    165             endif   
    166              
    167        endif 
     176          endif 
    168177            
    169178C 
    170        if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then 
    171          Call Agrif_Free_list_interp 
     179         if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then 
     180           Call Agrif_Free_list_interp 
    172181     &                          (Agrif_Gr%tabvars(i)%var%list_interp) 
    173        endif                              
     182         endif                              
    174183C 
    175184       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 
     
    177186C  
    178187        endif 
     188      enddo 
     189       
     190      parcours => Agrif_Gr%variables 
     191     
     192      do i=1,Agrif_Gr%NbVariables 
     193       if (.NOT. parcours%pvar%var%root_var%restaure) then 
     194        call Agrif_Deallocate_Arrays(parcours%pvar%var) 
     195       endif 
     196        if (associated(parcours%pvar%var%list_interp)) then 
     197           Call Agrif_Free_list_interp 
     198     &                          (parcours%pvar%var%list_interp) 
     199         endif                              
     200C 
     201       if ( .NOT. parcours%pvar%var%root_var % restaure) then 
     202            Deallocate(parcours%pvar%var) 
     203C  
     204        endif 
     205        parcours => parcours%nextvariable 
    179206      enddo 
    180207C 
     
    231258      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid 
    232259      INTEGER i 
     260      Type(Agrif_List_Variables), pointer :: parcours, rootparcours 
    233261C 
    234262C       
    235263      do i = 1 , AGRIF_NbVariables 
    236264         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then 
    237 C  
    238             if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
    239                Deallocate(Agrif_Gr%tabvars(i)%var%array1) 
    240             endif 
    241             if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
    242                Deallocate(Agrif_Gr%tabvars(i)%var%array2) 
    243             endif 
    244             if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
    245                Deallocate(Agrif_Gr%tabvars(i)%var%array3) 
    246             endif 
    247             if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
    248                Deallocate(Agrif_Gr%tabvars(i)%var%array4) 
    249             endif 
    250             if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
    251                Deallocate(Agrif_Gr%tabvars(i)%var%array5) 
    252             endif 
    253             if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
    254                Deallocate(Agrif_Gr%tabvars(i)%var%array6) 
    255             endif 
    256 ! 
    257             if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 
    258                Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 
    259             endif 
    260             if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 
    261                Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 
    262             endif 
    263             if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 
    264                Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 
    265             endif 
    266             if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 
    267                Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 
    268             endif 
    269             if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 
    270                Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 
    271             endif 
    272             if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 
    273                Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 
    274             endif 
    275 ! 
    276             if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 
    277                Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 
    278             endif 
    279             if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 
    280                Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 
    281             endif 
    282             if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 
    283                Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 
    284             endif 
    285             if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 
    286                Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 
    287             endif 
    288             if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 
    289                Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 
    290             endif 
    291             if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 
    292                Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 
    293             endif 
    294 ! 
    295             if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
    296                Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 
    297             endif 
    298             if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
    299                Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 
    300             endif 
    301             if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
    302                Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 
    303             endif 
    304             if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
    305                Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 
    306             endif 
    307             if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
    308                Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 
    309             endif 
    310             if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
    311                Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 
    312             endif 
    313 ! 
    314             if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 
    315                Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 
    316             endif 
    317             if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 
    318                Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 
    319             endif 
    320 ! 
    321             if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 
    322                Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 
    323             endif 
    324             if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 
    325                Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 
    326             endif 
    327              
    328             if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 
    329                Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 
    330             endif      
    331              
    332             if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 
    333                Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    334             endif                   
    335 ! 
     265          
     266         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 
     267         ! 
    336268            Deallocate(Agrif_Gr%tabvars(i)%var) 
    337269!  
    338270         endif 
    339271      enddo 
     272       
     273      parcours => Agrif_Gr%variables 
     274      rootparcours=>Agrif_Mygrid%variables 
     275     
     276      do i=1,Agrif_Gr%NbVariables 
     277       if (rootparcours%pvar%var%restaure) then 
     278        call Agrif_Deallocate_Arrays(parcours%pvar%var) 
     279       
     280            Deallocate(parcours%pvar%var) 
     281C  
     282        endif 
     283        parcours => parcours%nextvariable 
     284        rootparcours => rootparcours%nextvariable         
     285      enddo 
     286             
    340287C 
    341288C       
     
    464411C       
    465412      End Subroutine Agrif_CopyFromold 
     413       
     414CC    ************************************************************************** 
     415CCC   Subroutine AGRIF_CopyFromold_AllOneVar 
     416C     ************************************************************************** 
     417C 
     418      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids, 
     419     &   indic) 
     420C 
     421CCC   Description: 
     422CCC   Routine called in the Agrif_Init_Hierarchy procedure  
     423C       (Agrif_Clustering module).  
     424C 
     425CC    Method:         
     426C 
     427C     Declarations: 
     428C 
     429       
     430C       
     431C     Pointer argument     
     432      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid 
     433      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids 
     434      integer :: indic 
     435C 
     436C     Local pointer 
     437      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive  
     438                                             ! procedure  
     439      REAL g_eps,eps,oldgrid_eps 
     440      INTEGER :: out 
     441      INTEGER :: iii 
     442C 
     443      out = 0 
     444C                                                                            
     445      parcours => oldchildgrids   
     446C 
     447      do while (associated(parcours)) 
     448C  
     449        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then 
     450C         
     451            g_eps = huge(1.) 
     452            oldgrid_eps = huge(1.) 
     453            do iii = 1 , Agrif_Probdim 
     454               g_eps = min(g_eps,g % Agrif_d(iii)) 
     455               oldgrid_eps = min(oldgrid_eps, 
     456     &                       parcours % gr % Agrif_d(iii)) 
     457            enddo 
     458C 
     459            eps = min(g_eps,oldgrid_eps)/100.                   
     460C 
     461            do iii = 1 , Agrif_Probdim 
     462 
     463               if (g % Agrif_d(iii) .LT.  
     464     &             (parcours % gr % Agrif_d(iii) - eps)) then 
     465C             
     466                   parcours => parcours % next 
     467C             
     468                   out = 1 
     469C    
     470                   Exit 
     471C              
     472               endif 
     473C       
     474            enddo 
     475        if ( out .EQ. 1 ) Cycle 
     476C 
     477            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic) 
     478C 
     479        endif 
     480C                      
     481        Call Agrif_CopyFromold_AllOneVar 
     482     &             (g, parcours % gr % child_grids,indic) 
     483C         
     484        parcours => parcours % next 
     485C         
     486      enddo 
     487C 
     488C      
     489      Return       
     490C 
     491C 
     492      End Subroutine AGRIF_CopyFromold_AllOneVar 
     493C 
     494C 
     495C       
     496C     ************************************************************************** 
     497CCC   Subroutine Agrif_CopyFromoldOneVar 
     498C     ************************************************************************** 
     499C       
     500      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr, 
     501     &    indic) 
     502C 
     503CCC   Description: 
     504CCC   Call to the Agrif_Copy procedure. 
     505C 
     506CC    Method: 
     507CC             
     508C 
     509C     Declarations: 
     510C 
     511       
     512C       
     513C     Pointer argument     
     514      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid 
     515      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid 
     516      INTEGER :: indic 
     517      INTEGER :: i 
     518      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars       
     519C 
     520C       
     521      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic) 
     522      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic) 
     523 
     524      Call Agrif_Nbdim_Allocation(tabvars%var, 
     525     &  tabvars%var%lb,tabvars%var%ub, 
     526     &  tabvars%var%nbdim) 
     527      
     528      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr, 
     529     &           tabvars,oldtabvars) 
     530 
     531 
     532C       
     533C             
     534      Return 
     535C 
     536C       
     537      End Subroutine Agrif_CopyFromoldOneVar       
     538       
    466539C 
    467540C 
     
    753826         enddo 
    754827      CASE (2) 
     828 
    755829        i0 = ind_gmin(1) 
    756830        do i = ind_newmin(1),ind_newmax(1) 
  • vendors/AGRIF/current/AGRIF_FILES/modtypes.F

    r1901 r2671  
    3737      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10 
    3838                   
    39 C     MPI Communicator 
    40       INTEGER :: mpi_comm_agrif 
    4139C 
    4240C     ************************************************************************** 
     
    125123           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids  
    126124           ! List of the grid variables    
    127            TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars      
     125           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars   
     126           ! pointer on the save grid  
     127           TYPE(Agrif_grid)                    ,Pointer :: save_grid                 
    128128C 
    129129           ! Global x,y and z position 
     
    169169           INTEGER                                 :: NbVariables = 0 
    170170           Type(Agrif_Flux), Pointer               :: fluxes => NULL() 
     171           INTEGER                                 :: level 
     172           ! level of the grid in the hierarchy 
    171173      End TYPE Agrif_grid 
    172174C 
     
    198200C        Arrays containing the values of the grid variables (REAL) 
    199201         REAL                                    :: array0  
    200          REAL   , DIMENSION(:)          ,Pointer :: array1    => NULL() 
    201          REAL   , DIMENSION(:,:)        ,Pointer :: array2    => NULL() 
    202          REAL   , DIMENSION(:,:,:)      ,Pointer :: array3    => NULL() 
    203          REAL   , DIMENSION(:,:,:,:)    ,Pointer :: array4    => NULL() 
    204          REAL   , DIMENSION(:,:,:,:,:)  ,Pointer :: array5    => NULL() 
    205          REAL   , DIMENSION(:,:,:,:,:,:),Pointer :: array6    => NULL() 
     202         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1     
     203         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2     
     204         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3     
     205         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4     
     206         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5     
     207         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6   
     208          
     209         REAL   , DIMENSION(:)          ,POINTER :: parray1     
     210         REAL   , DIMENSION(:,:)        ,POINTER :: parray2     
     211         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3     
     212         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4     
     213         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5     
     214         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6 
     215          
    206216C        Arrays containing the values of the grid variables (REAL*8) 
    207217         REAL*8                                 :: darray0 
    208          REAL*8, DIMENSION(:)          ,Pointer :: darray1   => NULL() 
    209          REAL*8, DIMENSION(:,:)        ,Pointer :: darray2   => NULL() 
    210          REAL*8, DIMENSION(:,:,:)      ,Pointer :: darray3   => NULL() 
    211          REAL*8, DIMENSION(:,:,:,:)    ,Pointer :: darray4   => NULL() 
    212          REAL*8, DIMENSION(:,:,:,:,:)  ,Pointer :: darray5   => NULL() 
    213          REAL*8, DIMENSION(:,:,:,:,:,:),Pointer :: darray6   => NULL() 
     218         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1    
     219         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2    
     220         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3    
     221         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4    
     222         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5    
     223         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6    
    214224C        Arrays containing the values of the grid variables (REAL*4) 
    215225         REAL*4                                 :: sarray0 
    216          REAL*4, DIMENSION(:)          ,Pointer :: sarray1   => NULL() 
    217          REAL*4, DIMENSION(:,:)        ,Pointer :: sarray2   => NULL() 
    218          REAL*4, DIMENSION(:,:,:)      ,Pointer :: sarray3   => NULL() 
    219          REAL*4, DIMENSION(:,:,:,:)    ,Pointer :: sarray4   => NULL() 
    220          REAL*4, DIMENSION(:,:,:,:,:)  ,Pointer :: sarray5   => NULL() 
    221          REAL*4, DIMENSION(:,:,:,:,:,:),Pointer :: sarray6   => NULL() 
     226         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1    
     227         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2    
     228         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3    
     229         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4    
     230         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5    
     231         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6    
    222232C        Arrays containing the values of the grid variables (LOGICAL) 
    223233         LOGICAL                                 :: larray0 
    224          LOGICAL, DIMENSION(:)          ,Pointer :: larray1   => NULL() 
    225          LOGICAL, DIMENSION(:,:)        ,Pointer :: larray2   => NULL() 
    226          LOGICAL, DIMENSION(:,:,:)      ,Pointer :: larray3   => NULL() 
    227          LOGICAL, DIMENSION(:,:,:,:)    ,Pointer :: larray4   => NULL() 
    228          LOGICAL, DIMENSION(:,:,:,:,:)  ,Pointer :: larray5   => NULL() 
    229          LOGICAL, DIMENSION(:,:,:,:,:,:),Pointer :: larray6   => NULL() 
     234         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1    
     235         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2    
     236         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3    
     237         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4    
     238         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5    
     239         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6    
    230240C         Arrays containing the values of the grid variables (INTEGER)    
    231241         INTEGER                                 :: iarray0 
    232          INTEGER, DIMENSION(:)          ,Pointer :: iarray1   => NULL() 
    233          INTEGER, DIMENSION(:,:)        ,Pointer :: iarray2   => NULL() 
    234          INTEGER, DIMENSION(:,:,:)      ,Pointer :: iarray3   => NULL() 
    235          INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: iarray4   => NULL() 
    236          INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: iarray5   => NULL() 
    237          INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: iarray6   => NULL() 
     242         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1    
     243         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2    
     244         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3    
     245         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4    
     246         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5    
     247         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6    
    238248C 
    239249         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL() 
     
    245255C    
    246256         CHARACTER(2050)                          :: carray0 
    247          CHARACTER(200), DIMENSION(:)    ,Pointer :: carray1   => NULL() 
    248          CHARACTER(200), DIMENSION(:,:)  ,Pointer :: carray2   => NULL() 
     257         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1 
     258         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2 
    249259C 
    250260         ! Array used for the time interpolation 
     
    375385      REAL                  :: Agrif_SpecialValueFineGrid 
    376386C   clustering PARAMETERs 
    377       INTEGER               :: Agrif_Regridding 
     387      INTEGER               :: Agrif_Regridding = 10 
    378388      INTEGER               :: Agrif_Minwidth 
    379389      REAL                  :: Agrif_Efficiency = 0.7 
     
    406416      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid  
    407417      !    else only AMR mode 
    408       INTEGER               :: Agrif_USE_FIXED_GRIDS          
     418      INTEGER               :: Agrif_USE_FIXED_GRIDS 
     419      INTEGER               :: Agrif_Maxlevelloc 
    409420C 
    410421#ifdef AGRIF_MPI 
    411422      INTEGER :: Agrif_Nbprocs  ! Number of processors 
    412423      INTEGER :: Agrif_ProcRank ! Rank of the current processor  
    413       INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_AGRIF 
     424      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_WORLD 
    414425      INTEGER :: Agrif_MPIPREC 
    415426#endif 
  • vendors/AGRIF/current/AGRIF_FILES/modupdate.F

    r1901 r2671  
    11! 
    2 ! $Id: modupdate.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modupdate.F 779 2007-12-22 17:04:17Z rblod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
     
    7272      External :: procname 
    7373      Optional ::  procname       
    74       REAL, DIMENSION(lbound(child%var%array1,1): 
    75      &                ubound(child%var%array1,1)), Target :: tab  ! Results 
     74      REAL, DIMENSION( 
     75     &         child%var%lb(1):child%var%ub(1) 
     76     &         ), Target :: tab    ! Result 
    7677C 
    7778C 
     
    8687C       
    8788C     Values on the current grid used for the update 
    88       childtemp % var % array1 => tab 
     89C      childtemp % var % array1 => tab 
    8990       
    9091      childtemp % var % lb = child % var % lb 
     
    139140                                                           
    140141      REAL, DIMENSION( 
    141      &      lbound(child%var%array2,1):ubound(child%var%array2,1), 
    142      &      lbound(child%var%array2,2):ubound(child%var%array2,2)), 
    143      &      Target :: tab  ! Results 
     142     &         child%var%lb(1):child%var%ub(1), 
     143     &         child%var%lb(2):child%var%ub(2) 
     144     &    ), Target :: tab    ! Result 
    144145C 
    145146C 
     
    154155C       
    155156C     Values on the current grid used for the update 
    156       childtemp % var % array2 => tab  
     157C      childtemp % var % array2 => tab  
    157158       
    158159      childtemp % var % lb = child % var % lb 
     
    203204                                                        
    204205      REAL, DIMENSION( 
    205      &      lbound(child%var%array3,1):ubound(child%var%array3,1), 
    206      &      lbound(child%var%array3,2):ubound(child%var%array3,2), 
    207      &      lbound(child%var%array3,3):ubound(child%var%array3,3)), 
    208      &      Target :: tab  ! Results     
     206     &         child%var%lb(1):child%var%ub(1), 
     207     &         child%var%lb(2):child%var%ub(2), 
     208     &         child%var%lb(3):child%var%ub(3) 
     209     &      ), Target :: tab  ! Results   
    209210C 
    210211C 
     
    219220C       
    220221C     Values on the current grid used for the update 
    221       childtemp % var % array3 => tab      
     222C      childtemp % var % array3 => tab      
    222223       
    223224      childtemp % var % lb = child % var % lb 
     
    268269      Optional ::  procname         
    269270      REAL, DIMENSION( 
    270      &      lbound(child%var%array4,1):ubound(child%var%array4,1), 
    271      &      lbound(child%var%array4,2):ubound(child%var%array4,2), 
    272      &      lbound(child%var%array4,3):ubound(child%var%array4,3), 
    273      &      lbound(child%var%array4,4):ubound(child%var%array4,4)), 
    274      &      Target :: tab  ! Results 
     271     &         child%var%lb(1):child%var%ub(1), 
     272     &         child%var%lb(2):child%var%ub(2), 
     273     &         child%var%lb(3):child%var%ub(3), 
     274     &         child%var%lb(4):child%var%ub(4) 
     275     &      ), Target :: tab  ! Results 
    275276C 
    276277C 
     
    285286C       
    286287C     Values on the current grid used for the update 
    287       childtemp % var % array4 => tab      
     288C      childtemp % var % array4 => tab      
    288289       
    289290      childtemp % var % lb = child % var % lb 
     
    336337               
    337338      REAL, DIMENSION( 
    338      &      lbound(child%var%array5,1):ubound(child%var%array5,1), 
    339      &      lbound(child%var%array5,2):ubound(child%var%array5,2), 
    340      &      lbound(child%var%array5,3):ubound(child%var%array5,3), 
    341      &      lbound(child%var%array5,4):ubound(child%var%array5,4), 
    342      &      lbound(child%var%array5,5):ubound(child%var%array5,5)), 
    343      &      Target :: tab  ! Results 
     339     &         child%var%lb(1):child%var%ub(1), 
     340     &         child%var%lb(2):child%var%ub(2), 
     341     &         child%var%lb(3):child%var%ub(3), 
     342     &         child%var%lb(4):child%var%ub(4), 
     343     &         child%var%lb(5):child%var%ub(5) 
     344     &      ),  Target :: tab  ! Results 
    344345C 
    345346C 
     
    354355C       
    355356C     Values on the current grid used for the update 
    356       childtemp % var % array5 => tab       
     357C      childtemp % var % array5 => tab       
    357358       
    358359      childtemp % var % lb = child % var % lb 
     
    401402                                              ! are done on the fine grid        
    402403      REAL, DIMENSION( 
    403      &      lbound(child%var%array6,1):ubound(child%var%array6,1), 
    404      &      lbound(child%var%array6,2):ubound(child%var%array6,2), 
    405      &      lbound(child%var%array6,3):ubound(child%var%array6,3), 
    406      &      lbound(child%var%array6,4):ubound(child%var%array6,4), 
    407      &      lbound(child%var%array6,5):ubound(child%var%array6,5), 
    408      &      lbound(child%var%array6,6):ubound(child%var%array6,6)), 
    409      &      Target :: tab  ! Results 
     404     &         child%var%lb(1):child%var%ub(1), 
     405     &         child%var%lb(2):child%var%ub(2), 
     406     &         child%var%lb(3):child%var%ub(3), 
     407     &         child%var%lb(4):child%var%ub(4), 
     408     &         child%var%lb(5):child%var%ub(5), 
     409     &         child%var%lb(6):child%var%ub(6) 
     410     &      ),  Target :: tab  ! Results 
    410411C 
    411412C 
     
    420421C       
    421422C     Values on the current grid used for the update 
    422       childtemp % var % array6 => tab       
     423C      childtemp % var % array6 => tab       
    423424       
    424425      childtemp % var % lb = child % var % lb 
     
    522523          case('N') ! No space DIMENSION       
    523524C 
    524             select case (nbdim)  
    525 C       
    526               case(1) 
    527                 nbtab_Child(n) = SIZE(child % var % array1,n) - 1 
    528               case(2) 
    529                 nbtab_Child(n) = SIZE(child % var % array2,n) - 1 
    530               case(3) 
    531                 nbtab_Child(n) = SIZE(child % var % array3,n) - 1 
    532               case(4) 
    533                 nbtab_Child(n) = SIZE(child % var % array4,n) - 1 
    534               case(5) 
    535                 nbtab_Child(n) = SIZE(child % var % array5,n) - 1   
    536               case(6) 
    537                 nbtab_Child(n) = SIZE(child % var % array6,n) - 1  
    538 C 
    539             end select 
     525             
     526            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n) 
    540527C 
    541528C           No interpolation but only a copy of the values of the grid variable       
     
    560547      endif 
    561548      enddo 
    562       
     549 
    563550       IF (present(procname)) THEN 
    564551 
     
    716703          indtab(i,1,1) = indtab(i,1,1) - coeffraf 
    717704          indtab(i,1,2) = indtab(i,1,2) - 1 
    718           IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) 
    719      &                            .AND.(mod(coeffraf,2) == 1)) THEN 
    720             indtab(i,1,1) = indtab(i,1,1) - 1 
    721             indtab(i,1,2) = indtab(i,1,2) + 1 
     705C at this point, indices are OK for an average           
     706          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN 
     707            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2 
     708            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2 
    722709          ENDIF 
    723710        ENDIF 
     
    757744       
    758745      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 
    759      &                     MPI_COMM_AGRIF,code) 
     746     &                     MPI_COMM_WORLD,code) 
    760747 
    761748      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)       
     
    763750#endif  
    764751C 
    765  
    766752      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), 
    767753     &     lubglob(1:nbdim,1)) 
     
    771757C 
    772758C 
    773  
    774759           IF (present(procname)) THEN 
    775760              Call Agrif_UpdatenD               
     
    790775     &              posvartab_child,loctab_Child, 
    791776     &              nbdim)            
    792            ENDIF 
     777           ENDIF         
    793778C 
    794779C       
     
    899884          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1 
    900885          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
    901             indtab(i,1,1) = indtab(i,1,1) - 1 
    902             indtab(i,1,2) = indtab(i,1,2) + 1 
    903             indtab(i,2,1) = indtab(i,2,1) - 1 
    904             indtab(i,2,2) = indtab(i,2,2) + 1 
     886            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2 
     887            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2 
     888            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2 
     889            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2 
    905890          ENDIF           
    906891        ENDIF 
     
    925910       
    926911      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 
    927      &                     MPI_COMM_AGRIF,code)   
     912     &                     MPI_COMM_WORLD,code)   
    928913      
    929914      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)       
     
    12091194 
    12101195      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim) 
    1211  
    1212  
    12131196 
    12141197      IF (present(procname)) THEN 
     
    12871270C 
    12881271      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 
    1289      &                   MPI_INTEGER,MPI_COMM_AGRIF,code) 
     1272     &                   MPI_INTEGER,MPI_COMM_WORLD,code) 
    12901273 
    12911274      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var) 
     
    13001283      memberin1(1) = memberin 
    13011284      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 
    1302      &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code) 
     1285     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
    13031286  
    13041287       Call Get_External_Data_first(tab4t(:,:,1), 
     
    14191402C 
    14201403      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 
    1421      &                   MPI_INTEGER,MPI_COMM_AGRIF,code) 
     1404     &                   MPI_INTEGER,MPI_COMM_WORLD,code) 
    14221405 
    14231406      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var) 
     
    14321415      memberin1(1) = member 
    14331416      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2, 
    1434      &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code) 
     1417     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code) 
    14351418  
    14361419      Call Get_External_Data_first(tab5t(:,:,1), 
     
    17421725      REAL :: positionmin,positionmax 
    17431726      INTEGER :: imin,imax 
     1727      INTEGER :: coeffraf 
    17441728#endif 
    17451729C 
     
    17701754          ENDIF 
    17711755        ELSE 
    1772         positionmin = positionmin - ds_Parent(i)/2. 
    1773         IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
    1774           positionmin = positionmin - ds_Child(i) 
    1775         ENDIF 
     1756          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN 
     1757            positionmin = positionmin - ds_Parent(i)/2. 
     1758          ELSE 
     1759          coeffraf = nint(ds_Parent(i)/ds_Child(i)) 
     1760          if (mod(coeffraf,2) == 1) then 
     1761            positionmin = positionmin - (ds_Parent(i)-ds_Child(i)) 
     1762          else 
     1763            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))-ds_Child(i)/2. 
     1764          endif 
     1765          ENDIF 
    17761766        ENDIF 
    17771767        ENDIF 
     
    17941784          ENDIF 
    17951785        ELSE 
    1796         positionmax = positionmax  + ds_Parent(i)/2. 
    1797         IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 
    1798           positionmax = positionmax + ds_Child(i) 
    1799         ENDIF         
     1786          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN         
     1787            positionmax = positionmax  + ds_Parent(i)/2. 
     1788          ELSE 
     1789          coeffraf = nint(ds_Parent(i)/ds_Child(i)) 
     1790          if (mod(coeffraf,2) == 1) then 
     1791            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
     1792          else 
     1793            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) + ds_Child(i)/2. 
     1794          endif 
     1795 
     1796          ENDIF         
    18001797        ENDIF 
    18011798        ENDIF 
  • vendors/AGRIF/current/AGRIF_FILES/modupdatebasic.F

    r1901 r2671  
    571571      INTEGER :: i1,i2 
    572572      REAL :: invsumweight 
    573       REAL :: weights(-(coeffraf-1):coeffraf-1) 
     573      REAL :: weights(-(coeffraf):coeffraf) 
    574574       
    575575C 
     
    594594       ENDIF 
    595595C 
    596               
    597        it1 = -(coeffraf-1) 
    598        i1 = -(coeffraf-1)+locind_child_left+diffmod 
    599        i2 = 2*coeffraf - 2 
    600596        
    601       invsumweight=1./coeffraf**2 
    602       do i=-(coeffraf-1),0 
    603         weights(i) = invsumweight*(coeffraf + i) 
    604       enddo 
    605       do i=1,coeffraf-1 
    606         weights(i) = invsumweight*(coeffraf - i) 
    607       enddo 
     597      if (diffmod == 1) THEN 
     598        invsumweight=1./(2.*coeffraf**2) 
     599        do i=-coeffraf,-1 
     600          weights(i) = invsumweight*(2*(coeffraf+i)+1) 
     601        enddo 
     602        do i=0,coeffraf-1 
     603          weights(i)=weights(-(i+1)) 
     604        enddo 
     605        it1 = -coeffraf 
     606        i1 = -(coeffraf-1)+locind_child_left 
     607        i2 = 2*coeffraf - 1 
     608      else 
     609        invsumweight=1./coeffraf**2 
     610        do i=-(coeffraf-1),0 
     611          weights(i) = invsumweight*(coeffraf + i) 
     612        enddo 
     613        do i=1,coeffraf-1 
     614          weights(i) = invsumweight*(coeffraf - i) 
     615        enddo 
     616        it1 = -(coeffraf-1) 
     617        i1 = -(coeffraf-1)+locind_child_left 
     618        i2 = 2*coeffraf - 2 
     619      endif 
    608620 
    609621      sumweight = 0                     
     
    638650      enddo     
    639651C 
     652 
    640653      Return  
    641654C             
  • vendors/AGRIF/current/AGRIF_FILES/modutil.F

    r1901 r2671  
    11! 
    2 ! $Id: modutil.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modutil.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     Agrif (Adaptive Grid Refinement In Fortran) 
     
    6363C 
    6464#ifdef AGRIF_MPI 
    65       Logical      :: mpi_was_called 
    66       Integer      :: code, ierr 
     65      Integer      :: code 
    6766#include "mpif.h" 
    6867C 
    6968C 
    70       Call Agrif_comm_def(mpi_comm_agrif) 
    71  
    72       CALL mpi_initialized ( mpi_was_called, code ) 
    73       IF( code /= MPI_SUCCESS ) THEN 
    74          WRITE(*, *) ': Error in routine mpi_initialized' 
    75          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    76       ENDIF 
    77  
    78       IF( .NOT. mpi_was_called ) THEN  
    79          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_agrif, code) 
    80          IF( code /= MPI_SUCCESS ) THEN 
    81             WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup' 
    82             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    83          ENDIF 
    84       ENDIF 
    85  
    8669      If (Agrif_Mygrid % ngridstep == 0) Then 
    87           Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code) 
    88           Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code) 
    89           Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code) 
     70          Call MPI_COMM_SIZE(MPI_COMM_WORLD,Agrif_Nbprocs,code) 
     71          Call MPI_COMM_RANK(MPI_COMM_WORLD,Agrif_ProcRank,code) 
     72          Call MPI_COMM_GROUP(MPI_COMM_WORLD,Agrif_Group,code) 
    9073      endif 
    9174#endif 
     
    234217C 
    235218      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then 
     219C 
     220      Call Agrif_Save_All(Agrif_oldmygrid)       
    236221C       
    237222      Call Agrif_Free_before_All(Agrif_oldmygrid) 
     
    322307C     Detection (Agrif_detect is a user s routine) 
    323308C       
     309      
    324310      do iii = 1 , Agrif_Probdim 
    325311         size(iii) = g%nb(iii) + 1 
     
    440426C 
    441427      End Subroutine Agrif_Free_before_All 
     428C     ************************************************************************** 
     429CCC   Subroutine Agrif_Save_All 
     430C     ************************************************************************** 
     431C 
     432      Recursive Subroutine Agrif_Save_All(g) 
     433C 
     434CCC   Description: 
     435C 
     436CC    Method:         
     437C 
     438C     Declarations: 
     439C 
     440C     Pointer argument     
     441      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid 
     442C 
     443C     Local pointer 
     444      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive  
     445                                             ! procedure       
     446C 
     447C 
     448      parcours => g         
     449C       
     450      Do while (associated(parcours))      
     451        If (.not. parcours%gr%fixed) Then 
     452            Call Agrif_Instance(parcours%gr) 
     453            Call Agrif_Before_Regridding() 
     454            parcours % gr % oldgrid = .TRUE.         
     455        endif 
     456C 
     457        Call Agrif_Save_All (parcours % gr % child_grids) 
     458 
     459        parcours => parcours % next              
     460      enddo 
     461C      
     462      Return       
     463C 
     464C 
     465      End Subroutine Agrif_Save_All       
    442466C 
    443467C 
     
    710734C     The root coarse grid is a fixed grid 
    711735      Agrif_Mygrid % fixed = .TRUE. 
     736C     Level of the root grid 
     737      Agrif_Mygrid % level = 0 
     738C     Maximum level in the hierarchy 
     739      Agrif_MaxLevelLoc = 0 
     740       
    712741C       
    713742C     Number of the grid pointed by Agrif_Mygrid (root coarse grid) 
     
    724753      Call Agrif_Set_numberofcells(Agrif_Mygrid) 
    725754C       
    726       Call Agrif_Instance (Agrif_Mygrid)         
     755      Call Agrif_Instance (Agrif_Mygrid)       
     756C 
     757      Call Agrif_Set_numberofcells(Agrif_Mygrid)           
    727758C              
    728759C     Allocation of the array containing the values of the grid variables 
    729760      Call Agrif_Allocation (Agrif_Mygrid) 
    730761C         
    731       Call Agrif_initialisations(Agrif_Mygrid) 
     762      Call Agrif_initialisations(Agrif_Mygrid)     
    732763C       
    733764      nullify(Agrif_Mygrid % child_grids) 
     
    759790C 
    760791      do nb = 1, Agrif_NbVariables 
    761           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array1) )  
     792          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) )  
    762793     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1) 
    763           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array2) )  
     794          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) )  
    764795     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2) 
    765           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array3) )  
     796          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) )  
    766797     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3) 
    767           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array4) )  
     798          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) )  
    768799     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4) 
    769           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array5) )  
     800          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) )  
    770801     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5) 
    771           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array6) )  
     802          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) )  
    772803     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6) 
    773804C 
    774           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray1) )  
     805          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) )  
    775806     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1) 
    776           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray2) )  
     807          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) )  
    777808     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2) 
    778           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray3) )  
     809          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) )  
    779810     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3) 
    780           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray4) )  
     811          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) )  
    781812     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4) 
    782           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray5) )  
     813          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) )  
    783814     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5) 
    784           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray6) )  
     815          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) )  
    785816     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6) 
    786817C 
    787           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray1) )  
     818          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) )  
    788819     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1) 
    789           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray2) )  
     820          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) )  
    790821     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2) 
    791           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray3) )  
     822          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) )  
    792823     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3) 
    793           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray4) )  
     824          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) )  
    794825     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4) 
    795           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray5) )  
     826          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) )  
    796827     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5) 
    797           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray6) )  
     828          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) )  
    798829     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6) 
    799830C 
    800           if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray1) )  
     831          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) )  
    801832     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1) 
    802           if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray2) )  
     833          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) )  
    803834     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2) 
    804835      enddo 
  • vendors/AGRIF/current/LIB/DiversListe.c

    r1901 r2671  
    348348/*                                                                            */ 
    349349/******************************************************************************/ 
    350 void Add_NameOfCommon_1(char *nom) 
     350void Add_NameOfCommon_1(char *nom,char *cursubroutinename) 
    351351{ 
    352352   listnom *newnom; 
     
    362362         newnom=(listnom *) malloc (sizeof (listnom)); 
    363363         strcpy(newnom->o_nom,nom); 
     364         strcpy(newnom->o_subroutinename,cursubroutinename); 
    364365         Save_Length(nom,23); 
    365366         newnom->suiv = List_NameOfCommon; 
     
    524525     /* Creation of the string for the dimension of this variable             */ 
    525526     dimsempty = 1; 
     527 
    526528     if ( d ) 
    527529     { 
     
    542544        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1; 
    543545     } 
    544      strcpy(newvar->var->v_readedlistdimension,listdimension); 
    545      Save_Length(listdimension,15); 
     546 
     547/*     strcpy(newvar->var->v_readedlistdimension,listdimension); 
     548     Save_Length(listdimension,15);*/ 
    546549     /*                                                                       */ 
    547550     newvar->suiv = NULL; 
  • vendors/AGRIF/current/LIB/Makefile.lex

    r1901 r2671  
    11# Compilation: 
    2 CC    = cc -O -g 
     2CC    = cc -O -g -Wall 
    33LEX      = flex 
    44 
    55# option de flex et pas de lex 
    66LEXFLAGS=-i 
    7 YACC = byacc -t -v 
     7YACC = byacc -t -v -g 
     8YACC = bison -t -v -g 
    89 
    910 
     
    3839convert.tab.c : convert.y decl.h 
    3940   $(YACC) convert.y 
    40    mv -f y.tab.c convert.tab.c 
     41#  mv -f y.tab.c convert.tab.c 
    4142fortran.tab.c : fortran.y decl.h 
    4243   $(YACC) -p fortran fortran.y 
    43    mv -f y.tab.c fortran.tab.c 
     44#  mv -f y.tab.c fortran.tab.c 
     45#  mv -f y.output fortran.output 
     46#  mv -f y.dot fortran.dot 
    4447convert.yy.c : convert.lex 
    4548   $(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex 
  • vendors/AGRIF/current/LIB/SubLoopCreation.c

    r1901 r2671  
    6161      /* we should add the use agrif_uti l if it is necessary                 */ 
    6262      WriteHeadofSubroutineLoop(); 
    63       WriteUsemoduleDeclaration(); 
     63      WriteUsemoduleDeclaration(subroutinename); 
    6464      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    6565                                                       "      IMPLICIT NONE\n"); 
     
    6969      /*    from pointer) in the new subroutine                               */ 
    7070      if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n"); 
     71 
    7172      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(); 
    7273      if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n"); 
     
    9596   { 
    9697      AddUseAgrifUtil_0(fortranout); 
    97       WriteUsemoduleDeclaration(); 
     98      WriteUsemoduleDeclaration(subroutinename); 
    9899      WriteIncludeDeclaration(); 
    99100      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
     
    103104      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n"); 
    104105      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 
     106      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");       
    105107      WriteArgumentDeclaration_beforecall(); 
    106108/*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout); 
     
    127129/*                                                                            */ 
    128130/******************************************************************************/ 
    129 void WriteVariablelist_subloop(FILE *outputfile) 
     131void WriteVariablelist_subloop(FILE *outputfile,char *ligne) 
    130132{ 
    131133   listvar *parcours; 
    132    char ligne[LONG_C]; 
    133134   int compteur; 
    134135 
     
    146147      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    147148      { 
    148          if ( didvariableadded == 0 ) 
    149          { 
    150             strcpy(ligne,""); 
    151          } 
    152          else 
    153          { 
    154             if ( compteur == 0 ) strcpy(ligne,""); 
     149         if ( didvariableadded == 1 ) 
     150         { 
    155151            strcat(ligne,","); 
    156152         } 
    157153         strcat(ligne,parcours->var->v_nomvar); 
    158154         didvariableadded = 1; 
    159          compteur = compteur + 1; 
    160          if ( compteur == 3 ) 
    161          { 
    162             if ( retour77 == 0 ) 
    163             { 
    164                strcat(ligne," &"); 
    165                fprintf(outputfile,"\n      %s",ligne); 
    166             } 
    167             else fprintf(outputfile,"\n     & %s",ligne); 
    168             compteur = 0; 
    169          } 
    170155      } 
    171156      parcours = parcours -> suiv; 
     
    176161      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    177162      { 
    178          if ( didvariableadded == 0 ) 
    179          { 
    180             strcpy(ligne,""); 
    181          } 
    182          else 
    183          { 
    184             if ( compteur == 0 ) strcpy(ligne,""); 
     163         if ( didvariableadded == 1 ) 
     164         { 
    185165            strcat(ligne,","); 
    186166         } 
    187167         strcat(ligne,parcours->var->v_nomvar); 
    188168         didvariableadded = 1; 
    189          compteur = compteur + 1; 
    190          if ( compteur == 3 ) 
    191          { 
    192             if ( retour77 == 0 ) 
    193             { 
    194                strcat(ligne," &"); 
    195                fprintf(outputfile,"\n      %s",ligne); 
    196             } 
    197             else fprintf(outputfile,"\n     & %s",ligne); 
    198             compteur = 0; 
    199          } 
    200169      } 
    201170      parcours = parcours -> suiv; 
    202    } 
    203    if ( compteur != 3 && compteur != 0 ) 
    204    { 
    205       if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne); 
    206       else fprintf(outputfile,"\n     & %s ",ligne); 
    207171   } 
    208172   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n"); 
     
    224188/*                                                                            */ 
    225189/******************************************************************************/ 
    226 void WriteVariablelist_subloop_Call(FILE *outputfile) 
     190void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne) 
    227191{ 
    228192   listvar *parcours; 
    229    char ligne[LONG_40M]; 
    230193   char ligne2[10]; 
    231194   int i; 
    232195   int compteur ; 
    233196 
    234    strcpy(ligne,""); 
    235     
    236197   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n"); 
    237198   parcours = List_UsedInSubroutine_Var; 
     
    243204      /*    in the output file                                                */ 
    244205      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    245           (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    246            parcours->var->v_pointerdeclare == 0 
     206           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 
    247207         ) 
    248208      { 
    249          if ( didvariableadded == 0 ) 
    250          { 
    251             if ( retour77 == 1 ) strcpy(ligne,"\n     & "); 
    252             else strcpy(ligne,"\n      "); 
    253          } 
    254          else 
    255          { 
    256             if ( compteur == 0 ) 
    257             { 
    258                if ( retour77 == 1 ) strcpy(ligne,"\n     & "); 
    259                else strcpy(ligne,"\n      "); 
    260             } 
     209         if ( didvariableadded == 1 ) 
     210         { 
    261211            strcat(ligne," , "); 
    262212         } 
     
    266216         /* the name of the variable                                          */ 
    267217         if (  SubloopScalar != 0 && 
    268                (IsVarAllocatable_0(parcours->var->v_nomvar) == 0 && 
    269                parcours->var->v_pointerdeclare == 0 ) && 
     218               ( 
     219               (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) && 
    270220               parcours->var->v_nbdim != 0 ) 
    271221         { 
     
    306256   } 
    307257    
    308    Save_Length(ligne,41); 
    309    tofich(outputfile,ligne,0); 
     258//   Save_Length(ligne,41); 
     259//   tofich(outputfile,ligne,0); 
    310260   /* Now we should replace the last ", &" by " &"                            */ 
    311261/*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); 
     
    330280/*                                                                            */ 
    331281/******************************************************************************/ 
    332 void WriteVariablelist_subloop_Def(FILE *outputfile) 
     282void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne) 
    333283{ 
    334284   listvar *parcours; 
    335285/*   char ligne[LONG_40M];*/ 
    336    char *ligne; 
    337286   int compteur; 
    338287 
    339 /*   strcpy(ligne," ");*/ 
    340  
    341    ligne=(char *)malloc(LONG_40M*sizeof(char)); 
    342     
    343288   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n"); 
    344289   parcours = List_UsedInSubroutine_Var; 
     
    350295      /*    in the output file                                                */ 
    351296      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    352           (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    353            parcours->var->v_pointerdeclare == 0 
     297           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 
    354298         ) 
    355299      { 
    356          if ( didvariableadded == 0 ) 
    357          { 
    358             if ( retour77 == 1 ) strcpy(ligne,"\n     &"); 
    359             else strcpy(ligne,"\n      "); 
    360          } 
    361          else 
    362          { 
    363             if ( compteur == 0 ) 
    364             { 
    365                if ( retour77 == 1 ) strcpy(ligne,"\n     & "); 
    366                else strcpy(ligne,"\n      "); 
    367             } 
     300         if ( didvariableadded == 1 ) 
     301         { 
    368302            strcat(ligne,","); 
    369303         } 
    370304         strcat(ligne,parcours->var->v_nomvar); 
    371          compteur = compteur + 1; 
    372305         didvariableadded = 1; 
    373 /*         if ( compteur == 3 ) 
    374          { 
    375             if ( retour77 == 0 ) 
    376             { 
    377                strcat(ligne," &"); 
    378                fprintf(outputfile,"\n      %s",ligne); 
    379             } 
    380             else fprintf(outputfile,"\n     & %s",ligne); 
    381             compteur = 0; 
    382          }*/ 
    383306      } 
    384307      parcours = parcours -> suiv; 
     
    390313   }*/ 
    391314   Save_Length(ligne,41); 
    392    tofich(outputfile,ligne,0); 
     315 //  tofich(outputfile,ligne,0); 
    393316 
    394317   /* Now we should replace the last ", &" by " &"                            */ 
     
    396319   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    397320   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n"); 
    398    strcpy(ligne,""); 
    399321    
    400    free(ligne); 
    401322} 
    402323 
     
    419340void WriteHeadofSubroutineLoop() 
    420341{ 
    421    char ligne[LONG_C]; 
     342   char ligne[LONG_40M]; 
    422343   FILE * subloop; 
    423344 
     
    428349   subloop = associate(ligne); 
    429350   /*                                                                         */ 
    430    if ( retour77 == 0 ) sprintf(ligne,"      subroutine Sub_Loop_%s( &" 
    431                                                                ,subroutinename); 
    432    else sprintf(ligne,"      subroutine Sub_Loop_%s( ",subroutinename); 
    433    fprintf(subloop,ligne); 
     351   if (isrecursive)  
     352   { 
     353   sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename); 
     354   } 
     355   else 
     356   { 
     357   sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename); 
     358   } 
    434359   /*                                                                         */ 
    435    WriteVariablelist_subloop(subloop); 
    436    WriteVariablelist_subloop_Def(subloop); 
     360   WriteVariablelist_subloop(subloop,ligne); 
     361   WriteVariablelist_subloop_Def(subloop,ligne); 
    437362   /*                                                                         */ 
    438    sprintf(ligne,")"); 
    439    fprintf(subloop,ligne); 
     363     strcat(ligne,")"); 
     364   tofich(subloop,ligne,1); 
    440365   /* if USE agrif_Uti l should be add                                        */ 
    441366   AddUseAgrifUtil_0(subloop); 
     
    461386void closeandcallsubloopandincludeit_0(int suborfun) 
    462387{ 
    463    char ligne[LONG_C]; 
     388   char ligne[LONG_40M]; 
    464389 
    465390   if ( firstpass == 0 ) 
    466391   { 
     392 
    467393   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 
    468394   if ( IsTabvarsUseInArgument_0() == 1 ) 
     
    484410                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n"); 
    485411      /* Now we add the call af the new subroutine                            */ 
    486       if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &" 
    487                                                                ,subroutinename); 
    488       else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
    489       fprintf(fortranout,ligne); 
     412      sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
    490413      /* Write the list of the local variables used in this new subroutine    */ 
    491       WriteVariablelist_subloop(fortranout); 
     414      WriteVariablelist_subloop(fortranout,ligne); 
    492415      /* Write the list of the global tables used in this new subroutine      */ 
    493416      /*    in doloop                                                         */ 
    494       WriteVariablelist_subloop_Call(fortranout); 
     417      WriteVariablelist_subloop_Call(fortranout,ligne); 
    495418      /* Close the parenthesis of the new subroutine called                   */ 
    496       sprintf(ligne,")"); 
    497       fprintf(fortranout,ligne); 
     419       strcat(ligne,")"); 
     420       
     421      tofich(fortranout,ligne,1); 
     422 
    498423      /* We should close the original subroutine                              */ 
    499424      if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s" 
     
    520445void closeandcallsubloop_contains_0() 
    521446{ 
    522    char ligne[LONG_C]; 
     447   char ligne[LONG_40M]; 
    523448 
    524449   if ( firstpass == 0 ) 
     
    548473      fprintf(fortranout,ligne); 
    549474      /* Write the list of the local variables used in this new subroutine    */ 
    550       WriteVariablelist_subloop(fortranout); 
     475      WriteVariablelist_subloop(fortranout,ligne); 
    551476      /* Write the list of the global tables used in this new subroutine      */ 
    552477      /*    in doloop                                                         */ 
    553       WriteVariablelist_subloop_Call(fortranout); 
     478      WriteVariablelist_subloop_Call(fortranout,ligne); 
    554479      /* Close the parenthesis of the new subroutine called                   */ 
    555480      sprintf(ligne,")"); 
  • vendors/AGRIF/current/LIB/UtilAgrif.c

    r1901 r2671  
    6767   else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1; 
    6868   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1; 
     69   else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1; 
    6970   else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1; 
    7071   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1; 
     
    107108   listvar *newvar; 
    108109   int out; 
     110    
     111   printf("ICI ident = %s\n",ident); 
    109112    
    110113   if ( firstpass == 0 ) 
     
    117120         else newvar=newvar->suiv; 
    118121      } 
    119  
     122       printf("out1 = %d\n",out); 
    120123      if ( out == 0 ) 
    121124      { 
     
    127130         } 
    128131      } 
     132      if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return; 
     133 
    129134      if ( out == 0 ) 
    130135      { 
     
    147152      } 
    148153 
    149       if ( out == 1 ) 
    150       { 
     154      if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 
     155      { 
     156      printf("ICIC3\n"); 
    151157         /* remove the variable                                               */ 
    152158         RemoveWordCUR_0(fortranout,(long)(-lengthname), 
     
    183189               else newvar=newvar->suiv; 
    184190            } 
    185             if ( out == 1 ) 
     191            if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 
    186192            { 
     193            printf("ICICIC4 %s\n",newvar->var->v_typevar); 
    187194               /* remove the variable                                         */ 
    188195               RemoveWordCUR_0(fortranout,(long)(-lengthname), 
  • vendors/AGRIF/current/LIB/UtilCharacter.c

    r1901 r2671  
    284284      ) 
    285285   { 
    286       printf("--- in UtilCharacter we do not found the \n"); 
     286   /*   printf("--- in UtilCharacter we do not found the \n"); 
    287287      printf("---  variable %s, the module where this \n",nom); 
    288288      printf("---  variable has been defined has not been\n"); 
    289       printf("---  found.\n"); 
     289      printf("---  found.\n");*/ 
    290290   } 
    291291} 
     
    320320         ) 
    321321      { 
     322 
    322323         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) 
    323324         { 
     
    330331         sprintf(chartmp,"%c",nom[i]); 
    331332         strcat(toprinttmp,chartmp); 
     333 
    332334      } 
    333335      /*                                                                      */ 
  • vendors/AGRIF/current/LIB/UtilFortran.c

    r1901 r2671  
    9797        /* Now we should give the definition of the variable in the           */ 
    9898        /* table List_UsedInSubroutine_Var                                    */ 
     99        printf("QDKFLSDFKSLDF\n"); 
    99100        strcpy(curvar->var->v_typevar,newvar->var->v_typevar); 
    100101        strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar); 
     
    102103        curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven; 
    103104        curvar->var->v_allocatable = newvar->var->v_allocatable; 
     105        curvar->var->v_target = newvar->var->v_target; 
    104106        curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare; 
    105107        curvar->var->v_indicetabvars = newvar->var->v_indicetabvars; 
     
    133135        ) 
    134136     { 
     137        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile); 
    135138        CopyRecord(curvar->var,newvar->var); 
    136139        present = 1; 
     
    535538                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename);  
    536539                tofich(module_declar,ligne,1); 
     540                sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename);  
     541                tofich(module_declar,ligne,1); 
     542                sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename);  
     543                tofich(module_declar,ligne,1); 
    537544        } 
    538545   } 
  • vendors/AGRIF/current/LIB/UtilListe.c

    r1901 r2671  
    7272   var->v_optionaldeclare     = 0 ; 
    7373   var->v_allocatable         = 0 ; 
     74   var->v_target              = 0 ; 
    7475   var->v_dimsempty           = 0 ; 
    7576   var->v_dimension = (listdim *)NULL; 
     
    152153   } 
    153154   /* Si cette variable est declaree en save                                  */ 
    154    if (SaveDeclare == 1 ) curvar->v_save = 1; 
     155   if (SaveDeclare == 1 ) { 
     156   curvar->v_save = 1; 
     157   } 
     158 
    155159   /* Si cette variable est v_allocatable                                     */ 
    156160   if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; 
     161    
     162   /* Si cette variable est v_targer                                     */ 
     163   if (Targetdeclare == 1 ) curvar->v_target=1; 
    157164   /* if INTENT spec has been given                                           */ 
    158165   if ( strcasecmp(IntentSpec,"") ) 
     
    202209      tmpvar->v_save=parcours->var->v_save; 
    203210      tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter; 
     211      printf("QLKDF\n"); 
    204212      tmpvar->v_indicetabvars=parcours->var->v_indicetabvars; 
    205213      strcpy(tmpvar->v_modulename,parcours->var->v_modulename); 
     
    220228      tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare; 
    221229      tmpvar->v_allocatable=parcours->var->v_allocatable; 
     230      tmpvar->v_target=parcours->var->v_target; 
    222231      strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec); 
    223232      tmpvar->v_dimsempty=parcours->var->v_dimsempty; 
     
    511520} 
    512521 
    513 listname *Insertname(listname *lin,char *nom) 
     522listname *Insertname(listname *lin,char *nom, int sens) 
    514523{ 
    515524   listname *newvar ; 
     
    526535   else 
    527536   { 
     537      if (sens == 0) 
     538      { 
    528539      tmpvar = lin ; 
    529540      while (tmpvar->suiv) 
     
    532543      } 
    533544      tmpvar -> suiv = newvar; 
     545      } 
     546      else 
     547      { 
     548      newvar->suiv = lin; 
     549      lin = newvar; 
     550      } 
    534551   } 
    535552   return lin; 
     553} 
     554 
     555listname *concat_listname(listname *l1, listname *l2) 
     556{ 
     557   listname *tmpvar; 
     558 
     559   tmpvar = l1; 
     560   while (tmpvar->suiv) 
     561   { 
     562    tmpvar = tmpvar->suiv; 
     563   } 
     564    
     565   tmpvar->suiv = l2; 
     566    
     567   return l1; 
     568} 
     569 
     570void *createstringfromlistname(char *ligne, listname *lin) 
     571{ 
     572listname *tmpvar; 
     573 
     574strcpy(ligne,""); 
     575tmpvar = lin; 
     576while(tmpvar) 
     577{ 
     578  strcat(ligne,tmpvar->n_name); 
     579  if (tmpvar->suiv) strcat(ligne,","); 
     580  tmpvar=tmpvar->suiv; 
     581} 
    536582} 
    537583 
     
    618664 
    619665} 
     666 
     667void Init_List_Data_Var() 
     668{ 
     669listvar *parcours; 
     670 
     671parcours = List_Data_Var_Cur; 
     672 
     673if (List_Data_Var_Cur) 
     674{ 
     675while (parcours) 
     676{ 
     677 List_Data_Var_Cur = List_Data_Var_Cur->suiv; 
     678 free(parcours); 
     679 parcours = List_Data_Var_Cur; 
     680} 
     681} 
     682 
     683List_Data_Var_Cur = NULL; 
     684 
     685} 
  • vendors/AGRIF/current/LIB/WorkWithParameterlist.c

    r1901 r2671  
    4949   if ( firstpass == 1 ) 
    5050   { 
    51       if ( VariableIsParameter == 1 ) List_GlobalParameter_Var =