Changeset 1200


Ignore:
Timestamp:
2008-09-24T15:05:20+02:00 (12 years ago)
Author:
rblod
Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

Location:
trunk
Files:
3 added
44 edited

Legend:

Unmodified
Added
Removed
  • trunk/AGRIF/AGRIF_FILES/modarrays.F

    r662 r1200  
    176176C     Local variables        
    177177C 
    178       SELECT CASE (nbdim) 
    179       CASE (1) 
    180            lower = lbound(Variable % array1) 
    181            upper = ubound(Variable % array1) 
    182       CASE (2) 
    183            lower = lbound(Variable % array2) 
    184            upper = ubound(Variable % array2) 
    185       CASE (3) 
    186            lower = lbound(Variable % array3) 
    187            upper = ubound(Variable % array3) 
    188       CASE (4) 
    189            lower = lbound(Variable % array4) 
    190            upper = ubound(Variable % array4) 
    191       CASE (5) 
    192            lower = lbound(Variable % array5) 
    193            upper = ubound(Variable % array5) 
    194       CASE (6) 
    195            lower = lbound(Variable % array6) 
    196            upper = ubound(Variable % array6) 
    197       END SELECT 
    198 C 
     178      lower = Variable % lb(1:nbdim) 
     179      upper = Variable % ub(1:nbdim) 
    199180      return 
    200181C 
     
    552533C 
    553534 
    554 #ifdef AGRIF_MPI 
    555535C     ************************************************************************** 
    556536CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi 
     
    581561      CASE (1) 
    582562             Where (Variable1 % array1( 
    583      &           bound1(lower(1),1,2):bound1(upper(1),1,2))  
     563     &           bound1(1,1,2):bound1(1,2,2))  
    584564     &            == Value) 
    585              Variable2 % array1(lower(1):upper(1)) 
     565             Variable2 % array1(bound1(1,1,1):bound1(1,2,1)) 
    586566     &                        = Value 
    587567C       
     
    589569      CASE (2) 
    590570             Where (Variable1 % array2( 
    591      &           bound1(lower(1),1,2):bound1(upper(1),1,2), 
    592      &           bound1(lower(2),2,2):bound1(upper(2),2,2))  
     571     &           bound1(1,1,2):bound1(1,2,2), 
     572     &           bound1(2,1,2):bound1(2,2,2))  
    593573     &            == Value) 
    594              Variable2 % array2(lower(1):upper(1), 
    595      &                          lower(2):upper(2)) 
     574             Variable2 % array2(bound1(1,1,1):bound1(1,2,1), 
     575     &                       bound1(2,1,1):bound1(2,2,1)) 
    596576     &                        = Value 
    597577C       
     
    599579      CASE (3) 
    600580             Where (Variable1 % array3( 
    601      &           bound1(lower(1),1,2):bound1(upper(1),1,2), 
    602      &           bound1(lower(2),2,2):bound1(upper(2),2,2),  
    603      &           bound1(lower(3),3,2):bound1(upper(3),3,2))  
     581     &           bound1(1,1,2):bound1(1,2,2), 
     582     &                       bound1(2,1,2):bound1(2,2,2), 
     583     &                       bound1(3,1,2):bound1(3,2,2))  
    604584     &            == Value) 
    605              Variable2 % array3(lower(1):upper(1), 
    606      &                          lower(2):upper(2), 
    607      &                          lower(3):upper(3)) 
     585             Variable2 % array3(bound1(1,1,1):bound1(1,2,1), 
     586     &                       bound1(2,1,1):bound1(2,2,1), 
     587     &                       bound1(3,1,1):bound1(3,2,1)) 
    608588     &                         = Value 
    609589C       
     
    611591      CASE (4) 
    612592             Where (Variable1 % array4( 
    613      &           bound1(lower(1),1,2):bound1(upper(1),1,2), 
    614      &           bound1(lower(2),2,2):bound1(upper(2),2,2),  
    615      &           bound1(lower(3),3,2):bound1(upper(3),3,2), 
    616      &           bound1(lower(4),4,2):bound1(upper(4),4,2))  
     593     &           bound1(1,1,2):bound1(1,2,2), 
     594     &                       bound1(2,1,2):bound1(2,2,2), 
     595     &                       bound1(3,1,2):bound1(3,2,2), 
     596     &                       bound1(4,1,2):bound1(4,2,2))  
    617597     &            == Value) 
    618              Variable2 % array4(lower(1):upper(1), 
    619      &                          lower(2):upper(2), 
    620      &                          lower(3):upper(3), 
    621      &                          lower(4):upper(4)) 
     598             Variable2 % array4(bound1(1,1,1):bound1(1,2,1), 
     599     &                       bound1(2,1,1):bound1(2,2,1), 
     600     &                       bound1(3,1,1):bound1(3,2,1), 
     601     &                       bound1(4,1,1):bound1(4,2,1)) 
    622602     &                        = Value 
    623603C       
     
    625605      CASE (5) 
    626606             Where (Variable1 % array5( 
    627      &           bound1(lower(1),1,2):bound1(upper(1),1,2), 
    628      &           bound1(lower(2),2,2):bound1(upper(2),2,2), 
    629      &           bound1(lower(3),3,2):bound1(upper(3),3,2), 
    630      &           bound1(lower(4),4,2):bound1(upper(4),4,2), 
    631      &           bound1(lower(5),5,2):bound1(upper(5),5,2))  
     607     &           bound1(1,1,2):bound1(1,2,2), 
     608     &                       bound1(2,1,2):bound1(2,2,2), 
     609     &                       bound1(3,1,2):bound1(3,2,2), 
     610     &                       bound1(4,1,2):bound1(4,2,2), 
     611     &                       bound1(5,1,2):bound1(5,2,2))  
    632612     &            == Value) 
    633              Variable2 % array5(lower(1):upper(1), 
    634      &                          lower(2):upper(2), 
    635      &                          lower(3):upper(3), 
    636      &                          lower(4):upper(4), 
    637      &                          lower(5):upper(5)) 
     613             Variable2 % array5(bound1(1,1,1):bound1(1,2,1), 
     614     &                       bound1(2,1,1):bound1(2,2,1), 
     615     &                       bound1(3,1,1):bound1(3,2,1), 
     616     &                       bound1(4,1,1):bound1(4,2,1), 
     617     &                       bound1(5,1,1):bound1(5,2,1)) 
    638618     &                        = Value 
    639619C       
     
    641621      CASE (6) 
    642622             Where (Variable1 % array6( 
    643      &           bound1(lower(1),1,2):bound1(upper(1),1,2), 
    644      &           bound1(lower(2),2,2):bound1(upper(2),2,2), 
    645      &           bound1(lower(2),3,2):bound1(upper(3),3,2), 
    646      &           bound1(lower(4),4,2):bound1(upper(4),4,2), 
    647      &           bound1(lower(5),5,2):bound1(upper(5),5,2), 
    648      &           bound1(lower(6),6,2):bound1(upper(6),6,2))  
     623     &           bound1(1,1,2):bound1(1,2,2), 
     624     &                       bound1(2,1,2):bound1(2,2,2), 
     625     &                       bound1(3,1,2):bound1(3,2,2), 
     626     &                       bound1(4,1,2):bound1(4,2,2), 
     627     &                       bound1(5,1,2):bound1(5,2,2), 
     628     &                       bound1(6,1,2):bound1(6,2,2))  
    649629     &            == Value) 
    650              Variable2 % array6(lower(1):upper(1), 
    651      &                          lower(2):upper(2), 
    652      &                          lower(3):upper(3), 
    653      &                          lower(4):upper(4), 
    654      &                          lower(5):upper(5), 
    655      &                          lower(6):upper(6)) 
     630             Variable2 % array6(bound1(1,1,1):bound1(1,2,1), 
     631     &                       bound1(2,1,1):bound1(2,2,1), 
     632     &                       bound1(3,1,1):bound1(3,2,1), 
     633     &                       bound1(4,1,1):bound1(4,2,1), 
     634     &                       bound1(5,1,1):bound1(5,2,1), 
     635     &                       bound1(6,1,1):bound1(6,2,1)) 
    656636     &                        = Value 
    657637C       
     
    662642C 
    663643      End Subroutine GiveAgrif_SpecialValueToTab_mpi     
    664 #else 
     644 
    665645C     ************************************************************************** 
    666646CCC   Subroutine GiveAgrif_SpecialValueToTab 
     
    771751C 
    772752      End Subroutine GiveAgrif_SpecialValueToTab    
    773 #endif 
     753 
    774754C 
    775755C 
  • trunk/AGRIF/AGRIF_FILES/modbc.F

    r898 r1200  
    4141C 
    4242C 
     43       
    4344C 
    4445C     ************************************************************************** 
     
    4748C  
    4849      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin, 
    49      &                              weight,pweight)             
     50     &                              weight,pweight,procname) 
    5051C 
    5152CCC   Description: 
    5253CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D  
    53 CCC   grid variable. 
    54 C 
    55 C     Declarations: 
    56 C       
    57        
    58 C 
    59 C     Arguments       
    60       INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation 
    61                                             ! (linear,...) 
    62       TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid 
    63       TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid 
    64       TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child  
    65                                             ! grid 
    66       INTEGER :: deb,fin                    ! Positions of the  interpolations  
    67       REAL, DIMENSION( 
    68      &    lbound(child%var%array1,1):ubound(child%var%array1,1) 
    69      &    ), Target :: tab ! Values of the grid variable 
    70       LOGICAL :: pweight                    ! Indicates if weight is used for   
    71                                             ! the temporal interpolation  
    72       REAL :: weight                        ! Coefficient for the time  
    73                                             ! interpolation 
    74 C 
    75 C 
    76 C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
    77 C     variable.   
    78 C 
    79       allocate(childtemp % var)   
    80 C 
    81       childtemp % var % root_var => child % var % root_var 
    82 C       
    83 C     Values of the grid variable 
    84       childtemp % var % array1 => tab   
    85 C 
    86 C     Temporary results for the time interpolation before and after the space  
    87 C     interpolation  
    88       childtemp % var % oldvalues2D => child % var % oldvalues2D 
    89 C  
    90 C     Index indicating if a space interpolation is necessary 
    91       childtemp % var % interpIndex => child % var % interpIndex        
    92       childtemp % var % Interpolationshouldbemade =  
    93      &                 child % var % Interpolationshouldbemade   
    94       childtemp % var % list_interp => child % var% list_interp           
    95 C 
    96 C     Call to the procedure for the calculations of the boundary conditions 
    97       Call Agrif_CorrectVariable 
    98      &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight) 
    99 C 
    100       child % var % oldvalues2D => childtemp % var % oldvalues2D 
    101       child % var % list_interp => childtemp % var %list_interp       
    102 C       
    103       deallocate(childtemp % var) 
    104 C 
    105 C        
    106       End Subroutine Agrif_Interp_bc_1D 
    107 C 
    108 C 
    109 C 
    110 C     ************************************************************************** 
    111 CCC   Subroutine Agrif_Interp_bc_2d 
    112 C     ************************************************************************** 
    113 C  
    114       Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin, 
    115      &                              weight,pweight,procname) 
    116 C 
    117 CCC   Description: 
    118 CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D  
    11954CCC   grid variable. 
    12055C 
     
    13570                                            ! done on the fine grid  
    13671      REAL, DIMENSION( 
    137      &         lbound(child%var%array2,1): ubound(child%var%array2,1), 
    138      &         lbound(child%var%array2,2): ubound(child%var%array2,2)),  
    139      &         Target :: tab ! Values of the grid variable 
     72     &         child%var%lb(1):child%var%ub(1)  
     73     &    ), Target :: tab ! Values of the grid variable 
    14074      LOGICAL :: pweight                    ! Indicates if weight is used for   
    14175                                            ! the temporal interpolation  
     
    15286C       
    15387C     Values of the grid variable 
    154       childtemp % var % array2 => tab   
     88      childtemp % var % array1 => tab   
    15589C 
    15690C     Temporary results for the time interpolation before and after the space  
     
    16296      childtemp % var % Interpolationshouldbemade =  
    16397     &                 child % var % Interpolationshouldbemade    
    164       childtemp % var % list_interp => child % var% list_interp     
     98      childtemp % var % list_interp => child % var% list_interp  
     99       
     100      childtemp % var% lb = child % var % lb 
     101      childtemp % var% ub = child % var % ub          
     102C 
     103C     Call to the procedure for the calculations of the boundary conditions 
     104      IF (present(procname)) THEN 
     105      Call Agrif_CorrectVariable 
     106     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname) 
     107      ELSE 
     108      Call Agrif_CorrectVariable 
     109     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight) 
     110      ENDIF 
     111 
     112C    
     113      child % var % oldvalues2D => childtemp % var % oldvalues2D 
     114      child % var % list_interp => childtemp % var %list_interp 
     115C          
     116      deallocate(childtemp % var) 
     117C 
     118C        
     119      End Subroutine Agrif_Interp_bc_1D 
     120C 
     121       
     122C 
     123C 
     124C 
     125C     ************************************************************************** 
     126CCC   Subroutine Agrif_Interp_bc_2d 
     127C     ************************************************************************** 
     128C  
     129      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin, 
     130     &                              weight,pweight,procname) 
     131C 
     132CCC   Description: 
     133CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D  
     134CCC   grid variable. 
     135C 
     136C     Declarations: 
     137C       
     138       
     139C 
     140C     Arguments       
     141      External :: procname 
     142      Optional :: procname 
     143      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear,  
     144                                            ! lagrange, spline, ... ) 
     145      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid 
     146      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid 
     147      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child  
     148                                            ! grid 
     149      INTEGER :: deb,fin                    ! Positions where interpolations are 
     150                                            ! done on the fine grid  
     151      REAL, DIMENSION( 
     152     &         child%var%lb(1):child%var%ub(1), 
     153     &         child%var%lb(2):child%var%ub(2)  
     154     &    ), Target :: tab ! Values of the grid variable 
     155      LOGICAL :: pweight                    ! Indicates if weight is used for   
     156                                            ! the temporal interpolation  
     157      REAL :: weight                        ! Coefficient for the time  
     158                                            ! interpolation 
     159C 
     160C 
     161C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
     162C     variable.    
     163C 
     164      allocate(childtemp % var)   
     165C 
     166      childtemp % var % root_var => child % var % root_var 
     167C       
     168C     Values of the grid variable 
     169      childtemp % var % array2 => tab   
     170C 
     171C     Temporary results for the time interpolation before and after the space  
     172C     interpolation  
     173      childtemp % var % oldvalues2D => child % var % oldvalues2D 
     174C  
     175C     Index indicating if a space interpolation is necessary 
     176      childtemp % var % interpIndex => child % var % interpIndex        
     177      childtemp % var % Interpolationshouldbemade =  
     178     &                 child % var % Interpolationshouldbemade    
     179      childtemp % var % list_interp => child % var% list_interp  
     180       
     181      childtemp % var% lb = child % var % lb 
     182      childtemp % var% ub = child % var % ub          
    165183C 
    166184C     Call to the procedure for the calculations of the boundary conditions 
     
    211229                                            ! are done on the fine grid  
    212230      REAL, DIMENSION( 
    213      &         lbound(child%var%array3,1):ubound(child%var%array3,1), 
    214      &         lbound(child%var%array3,2):ubound(child%var%array3,2), 
    215      &         lbound(child%var%array3,3):ubound(child%var%array3,3) 
     231     &         child%var%lb(1):child%var%ub(1), 
     232     &         child%var%lb(2):child%var%ub(2), 
     233     &         child%var%lb(3):child%var%ub(3) 
    216234     &         ), Target :: tab ! Values of the grid variable 
    217235      LOGICAL :: pweight                    ! Indicates if weight is used for  
     
    239257      childtemp % var % Interpolationshouldbemade =  
    240258     &                 child % var % Interpolationshouldbemade  
    241       childtemp % var % list_interp => child % var% list_interp            
     259      childtemp % var % list_interp => child % var% list_interp  
     260       
     261      childtemp % var% lb = child % var % lb 
     262      childtemp % var% ub = child % var % ub 
    242263C 
    243264C     Call to the procedure for the calculations of the boundary conditions      
     
    288309                                              ! are done on the fine grid  
    289310      REAL, DIMENSION( 
    290      &        lbound(child%var%array4,1):ubound(child%var%array4,1), 
    291      &        lbound(child%var%array4,2):ubound(child%var%array4,2), 
    292      &        lbound(child%var%array4,3):ubound(child%var%array4,3), 
    293      &        lbound(child%var%array4,4):ubound(child%var%array4,4) 
     311     &         child%var%lb(1):child%var%ub(1), 
     312     &         child%var%lb(2):child%var%ub(2), 
     313     &         child%var%lb(3):child%var%ub(3), 
     314     &         child%var%lb(4):child%var%ub(4) 
    294315     &        ), Target :: tab ! Values of the grid variable 
    295316      LOGICAL :: pweight                      ! Indicates if weight is used for  
     
    317338      childtemp % var % Interpolationshouldbemade =  
    318339     &                 child % var % Interpolationshouldbemade   
    319       childtemp % var % list_interp => child % var% list_interp           
     340      childtemp % var % list_interp => child % var% list_interp  
     341       
     342      childtemp % var% lb = child % var % lb 
     343      childtemp % var% ub = child % var % ub                
    320344C 
    321345C     Call to the procedure for the calculations of the boundary conditions 
     
    365389                                              ! are done on the fine grid  
    366390      REAL, DIMENSION( 
    367      &         lbound(child%var%array5,1):ubound(child%var%array5,1), 
    368      &         lbound(child%var%array5,2):ubound(child%var%array5,2), 
    369      &         lbound(child%var%array5,3):ubound(child%var%array5,3), 
    370      &         lbound(child%var%array5,4):ubound(child%var%array5,4), 
    371      &         lbound(child%var%array5,5):ubound(child%var%array5,5) 
     391     &         child%var%lb(1):child%var%ub(1), 
     392     &         child%var%lb(2):child%var%ub(2), 
     393     &         child%var%lb(3):child%var%ub(3), 
     394     &         child%var%lb(4):child%var%ub(4), 
     395     &         child%var%lb(5):child%var%ub(5) 
    372396     &         ), Target :: tab ! Values of the grid variable 
    373397      LOGICAL :: pweight                      ! Indicates if weight is used for  
     
    395419      childtemp % var % Interpolationshouldbemade =  
    396420     &                 child % var % Interpolationshouldbemade  
    397       childtemp % var % list_interp => child % var% list_interp            
     421      childtemp % var % list_interp => child % var% list_interp   
     422       
     423      childtemp % var% lb = child % var % lb 
     424      childtemp % var% ub = child % var % ub 
     425                      
    398426C 
    399427C     Call to the procedure for the calculations of the boundary conditions   
     
    442470                                              ! are done on the fine grid  
    443471      REAL, DIMENSION( 
    444      &         lbound(child%var%array6,1):ubound(child%var%array6,1), 
    445      &         lbound(child%var%array6,2):ubound(child%var%array6,2), 
    446      &         lbound(child%var%array6,3):ubound(child%var%array6,3), 
    447      &         lbound(child%var%array6,4):ubound(child%var%array6,4), 
    448      &         lbound(child%var%array6,5):ubound(child%var%array6,5), 
    449      &         lbound(child%var%array6,6):ubound(child%var%array6,6) 
     472     &         child%var%lb(1):child%var%ub(1), 
     473     &         child%var%lb(2):child%var%ub(2), 
     474     &         child%var%lb(3):child%var%ub(3), 
     475     &         child%var%lb(4):child%var%ub(4), 
     476     &         child%var%lb(5):child%var%ub(5), 
     477     &         child%var%lb(6):child%var%ub(6) 
    450478     &         ), Target :: tab ! Values of the grid variable 
    451479      LOGICAL :: pweight                      ! Indicates if weight is used for  
     
    473501      childtemp % var % Interpolationshouldbemade =  
    474502     &                 child % var % Interpolationshouldbemade  
    475       childtemp % var % list_interp => child % var% list_interp            
     503      childtemp % var % list_interp => child % var% list_interp   
     504       
     505      childtemp % var% lb = child % var % lb 
     506      childtemp % var% ub = child % var % ub                
    476507C 
    477508C     Call to the procedure for the calculations of the boundary conditions 
     
    626657          case('N') ! No space DIMENSION       
    627658C 
    628             select case (nbdim)  
    629 C       
    630               case(1) 
    631                 nbtab_Child(n) = SIZE(child % var % array1,n) - 1 
    632                 pttab_Child(n) = lbound(child % var % array1,n) 
    633               case(2) 
    634                 nbtab_Child(n) = SIZE(child % var % array2,n) - 1 
    635                 pttab_Child(n) = lbound(child % var % array2,n) 
    636               case(3) 
    637                 nbtab_Child(n) = SIZE(child % var % array3,n) - 1 
    638                 pttab_Child(n) = lbound(child % var % array3,n)   
    639               case(4) 
    640                 nbtab_Child(n) = SIZE(child % var % array4,n) - 1 
    641                 pttab_Child(n) = lbound(child % var % array4,n) 
    642               case(5) 
    643                 nbtab_Child(n) = SIZE(child % var % array5,n) - 1 
    644                 pttab_Child(n) = lbound(child % var % array5,n)       
    645               case(6) 
    646                 nbtab_Child(n) = SIZE(child % var % array6,n) - 1 
    647                 pttab_Child(n) = lbound(child % var % array6,n)       
    648 C 
    649             end select 
     659            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n) 
     660            pttab_Child(n) = child % var % lb(n) 
    650661C 
    651662C           No interpolation but only a copy of the values of the grid variable 
  • trunk/AGRIF/AGRIF_FILES/modbcfunction.F

    r779 r1200  
    256256C 
    257257      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     258      TYPE(Agrif_PVariable),Pointer ::tabvars 
     259       
     260     
    258261C 
    259262C 
     
    261264C 
    262265C      
     266 
     267      if (tabvarsindic <=0) then 
     268      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     269      else 
     270      tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 
     271      endif   
     272       
    263273      if (Agrif_Curgrid % fixedrank .NE. 0) then   
    264        IF (.Not.Associated(Agrif_Curgrid%tabvars(tabvarsindic)%var 
    265      &                % interpIndex)) THEN 
    266         Allocate(Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex) 
    267           Agrif_Curgrid%tabvars(tabvarsindic)%var % interpIndex = -1 
    268  
    269         Allocate( 
    270      &    Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D(2,1)) 
    271           Agrif_Curgrid%tabvars(tabvarsindic)%var % oldvalues2D = 0.  
     274       IF (.Not.Associated(tabvars%var% interpIndex)) THEN 
     275        Allocate(tabvars%var % interpIndex) 
     276          tabvars%var % interpIndex = -1 
     277 
     278        Allocate(tabvars%var % oldvalues2D(2,1)) 
     279          tabvars%var % oldvalues2D = 0.  
    272280       ENDIF       
    273281       if ( PRESENT(Interpolationshouldbemade) ) then 
    274          Agrif_Curgrid%tabvars(tabvarsindic)%var % 
     282         tabvars%var % 
    275283     &     Interpolationshouldbemade = Interpolationshouldbemade 
    276284       endif 
     
    278286      endif 
    279287C 
    280       Agrif_Curgrid%tabvars(tabvarsindic)%var % bcinf = point(1) 
    281       Agrif_Curgrid%tabvars(tabvarsindic)%var % bcsup = point(2) 
     288      tabvars%var % bcinf = point(1) 
     289      tabvars%var % bcsup = point(2) 
    282290C 
    283291      End Subroutine Agrif_Set_bc 
     
    346354C 
    347355      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     356      TYPE(Agrif_PVariable),Pointer ::tabvars 
     357       
     358     
    348359C 
    349360C 
    350361C     Begin  
    351362C 
    352       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp =  
     363C      
     364 
     365      if (tabvarsindic <=0) then 
     366      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 
     367      else 
     368      tabvars=>Agrif_Mygrid % tabvars(tabvarsindic) 
     369      endif  
     370C 
     371      tabvars% var % bctypeinterp =  
    353372     &           Agrif_Constant    
    354373      IF (present(interp)) THEN 
    355       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp =  
     374      tabvars% var % bctypeinterp =  
    356375     &           interp 
    357376      ENDIF        
    358377      IF (present(interp1)) THEN 
    359       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,1) =  
     378      tabvars% var % bctypeinterp(1:2,1) =  
    360379     &           interp1 
    361380      ENDIF        
    362381      IF (present(interp11)) THEN 
    363       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,1) =  
     382      tabvars% var % bctypeinterp(1,1) =  
    364383     &           interp11 
    365384      ENDIF 
    366385      IF (present(interp12)) THEN 
    367       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,2) =  
     386      tabvars% var % bctypeinterp(1,2) =  
    368387     &           interp12 
    369388      ENDIF           
    370389      IF (present(interp2)) THEN 
    371       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,2) =  
     390      tabvars% var % bctypeinterp(1:2,2) =  
    372391     &           interp2 
    373392      ENDIF 
    374393      IF (present(interp21)) THEN 
    375       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,1) =  
     394      tabvars% var % bctypeinterp(2,1) =  
    376395     &           interp21 
    377396      ENDIF       
    378397      IF (present(interp22)) THEN 
    379       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,2) =  
     398      tabvars% var % bctypeinterp(2,2) =  
    380399     &           interp22 
    381400      ENDIF             
    382401      IF (present(interp3)) THEN 
    383       Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,3) = 
     402      tabvars% var % bctypeinterp(1:2,3) = 
    384403     &           interp3 
    385404      ENDIF 
     
    507526CCC   Subroutine Agrif_Init_variable0d 
    508527C     ************************************************************************** 
    509       Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic) 
     528      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic, 
     529     &        procname) 
    510530 
    511531      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 
    512532      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     533      External :: procname 
     534      Optional ::  procname 
    513535C 
    514536      if (Agrif_Root()) Return 
    515537C       
     538      if (present(procname)) then 
     539      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic,procname) 
     540      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.,procname) 
     541      else 
    516542      CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic) 
    517543      CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.) 
     544      endif 
    518545 
    519546      End Subroutine Agrif_Init_variable0d 
     
    523550CCC   Subroutine Agrif_Init_variable1d 
    524551C     ************************************************************************** 
    525       Subroutine Agrif_Init_variable1d(q,tabvarsindic) 
     552      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname) 
    526553 
    527554      REAL, DIMENSION(:) :: q 
    528555      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     556      External :: procname 
     557      Optional ::  procname 
     558 
    529559C 
    530560      if (Agrif_Root()) Return 
    531561C 
     562      if (present(procname)) then 
     563      CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
     564      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
     565      else 
    532566      CALL Agrif_Interp_variable(q,tabvarsindic) 
    533567      CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     568      endif 
    534569 
    535570      End Subroutine Agrif_Init_variable1d 
     
    538573CCC   Subroutine Agrif_Init_variable2d 
    539574C     ************************************************************************** 
    540       Subroutine Agrif_Init_variable2d(q,tabvarsindic) 
     575      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname) 
    541576 
    542577      REAL,  DIMENSION(:,:) :: q 
    543578      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     579      External :: procname 
     580      Optional ::  procname 
     581 
    544582C 
    545583      if (Agrif_Root()) Return 
    546584C 
     585      if (present(procname)) then 
     586      CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
     587      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
     588      else 
    547589      CALL Agrif_Interp_variable(q,tabvarsindic) 
    548590      CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     591      endif 
     592 
    549593 
    550594      End Subroutine Agrif_Init_variable2d 
     
    554598CCC   Subroutine Agrif_Init_variable3d 
    555599C     ************************************************************************** 
    556       Subroutine Agrif_Init_variable3d(q,tabvarsindic) 
     600      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname) 
    557601 
    558602      REAL,  DIMENSION(:,:,:) :: q 
    559603      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     604      External :: procname 
     605      Optional ::  procname 
    560606C 
    561607      if (Agrif_Root()) Return 
    562608C 
     609      if (present(procname)) then 
     610      CALL Agrif_Interp_variable(q,tabvarsindic,procname) 
     611      CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 
     612      else 
    563613      CALL Agrif_Interp_variable(q,tabvarsindic) 
    564614      CALL Agrif_Bc_variable(q,tabvarsindic,1.) 
     615      endif 
     616 
    565617C 
    566618      End Subroutine Agrif_Init_variable3d 
     619C 
     620C 
     621C     ************************************************************************** 
     622CCC   Subroutine Agrif_Init_variable4d 
     623C     ************************************************************************** 
     624      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname) 
     625 
     626      REAL,  DIMENSION(:,:,:,:) :: q 
     627      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     628      External :: procname 
     629      Optional ::  procname 
     630C 
     631      if (Agrif_Root()) Return 
     632C 
     633      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.) 
     639      endif 
     640 
     641C 
     642      End Subroutine Agrif_Init_variable4d       
    567643C 
    568644C 
     
    713789C 
    714790C 
    715 C 
    716791C     ************************************************************************** 
    717792CCC   Subroutine Agrif_Bc_variable1d 
    718793C     ************************************************************************** 
    719       Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight) 
    720  
    721       REAL   , DIMENSION(:)          :: q 
     794      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight, 
     795     &                               procname) 
     796 
     797      REAL   , Dimension(:)          :: q 
     798      External :: procname 
     799      Optional ::  procname 
    722800      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
    723801C         
     
    725803      REAL    :: weight 
    726804      LOGICAL :: pweight 
    727 C 
     805      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 
     806C 
     807C       
     808C       
     809      If (Agrif_Root()) Return 
     810       
    728811      if ( PRESENT(calledweight) ) then 
    729812        weight=calledweight       
     
    733816        pweight = .FALSE. 
    734817      endif 
    735 C       
    736 C 
    737       if (Agrif_Root()) Return 
    738        
     818       
     819      if (tabvarsindic <=0) then 
     820      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     821      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) 
     827      endif 
     828             
     829      IF (present(procname)) THEN 
    739830      Call Agrif_Interp_Bc_1D( 
    740      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    741      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    742      & Agrif_Curgrid % tabvars(tabvarsindic), 
    743      & q, 
    744      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    745      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
    746      & weight, 
    747      & pweight) 
    748       End Subroutine Agrif_Bc_variable1d 
    749 C 
    750 C 
    751 CC 
     831     & roottabvars % var % bctypeinterp, 
     832     & parenttabvars, 
     833     & tabvars,q, 
     834     & tabvars % var % bcinf, 
     835     & tabvars % var % bcsup, 
     836     & weight,pweight,procname)       
     837      ELSE 
     838      Call Agrif_Interp_Bc_1D( 
     839     & roottabvars % var % bctypeinterp, 
     840     & parenttabvars, 
     841     & tabvars,q, 
     842     & tabvars % var % bcinf, 
     843     & tabvars % var % bcsup, 
     844     & weight,pweight) 
     845      ENDIF 
     846      End Subroutine Agrif_Bc_variable1d  
     847       
    752848C 
    753849C     ************************************************************************** 
     
    755851C     ************************************************************************** 
    756852      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight, 
    757      &                                 procname) 
    758  
    759       REAL   , DIMENSION(:,:)          :: q 
     853     &                               procname) 
     854 
     855      REAL   , Dimension(:,:)          :: q 
    760856      External :: procname 
    761857      Optional ::  procname 
     
    765861      REAL    :: weight 
    766862      LOGICAL :: pweight 
    767 C 
     863      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 
     864C 
     865C       
     866C       
     867      If (Agrif_Root()) Return 
     868       
    768869      if ( PRESENT(calledweight) ) then 
    769         weight=calledweight 
     870        weight=calledweight       
    770871        pweight = .TRUE. 
    771872      else 
     
    773874        pweight = .FALSE. 
    774875      endif 
    775 C       
    776 C 
    777  
    778       if (Agrif_Root()) Return 
     876       
     877      if (tabvarsindic <=0) then 
     878      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     879      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) 
     885      endif 
     886             
    779887      IF (present(procname)) THEN 
    780888      Call Agrif_Interp_Bc_2D( 
    781      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    782      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    783      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    784      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    785      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     889     & roottabvars % var % bctypeinterp, 
     890     & parenttabvars, 
     891     & tabvars,q, 
     892     & tabvars % var % bcinf, 
     893     & tabvars % var % bcsup, 
    786894     & weight,pweight,procname)       
    787895      ELSE 
    788        Call Agrif_Interp_Bc_2D( 
    789      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    790      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    791      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    792      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    793      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     896      Call Agrif_Interp_Bc_2D( 
     897     & roottabvars % var % bctypeinterp, 
     898     & parenttabvars, 
     899     & tabvars,q, 
     900     & tabvars % var % bcinf, 
     901     & tabvars % var % bcsup, 
    794902     & weight,pweight) 
    795903      ENDIF 
    796  
    797904      End Subroutine Agrif_Bc_variable2d 
     905             
    798906C 
    799907C     ************************************************************************** 
     
    811919      REAL    :: weight 
    812920      LOGICAL :: pweight 
    813 C 
     921      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 
     922C 
     923C       
     924C       
     925      If (Agrif_Root()) Return 
     926       
    814927      if ( PRESENT(calledweight) ) then 
    815928        weight=calledweight       
     
    819932        pweight = .FALSE. 
    820933      endif 
    821 C       
    822 C       
    823       If (Agrif_Root()) Return 
     934       
     935      if (tabvarsindic <=0) then 
     936      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     937      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) 
     943      endif 
     944             
    824945      IF (present(procname)) THEN 
    825946      Call Agrif_Interp_Bc_3D( 
    826      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    827      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    828      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    829      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    830      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     947     & roottabvars % var % bctypeinterp, 
     948     & parenttabvars, 
     949     & tabvars,q, 
     950     & tabvars % var % bcinf, 
     951     & tabvars % var % bcsup, 
    831952     & weight,pweight,procname)       
    832953      ELSE 
    833954      Call Agrif_Interp_Bc_3D( 
    834      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    835      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    836      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    837      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    838      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     955     & roottabvars % var % bctypeinterp, 
     956     & parenttabvars, 
     957     & tabvars,q, 
     958     & tabvars % var % bcinf, 
     959     & tabvars % var % bcsup, 
    839960     & weight,pweight) 
    840961      ENDIF 
    841962      End Subroutine Agrif_Bc_variable3d 
     963       
    842964C 
    843965C     ************************************************************************** 
     
    855977      REAL    :: weight 
    856978      LOGICAL :: pweight 
    857 C 
     979      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 
     980C 
     981C       
     982C       
     983      If (Agrif_Root()) Return 
     984       
    858985      if ( PRESENT(calledweight) ) then 
    859986        weight=calledweight       
     
    863990        pweight = .FALSE. 
    864991      endif 
    865 C       
    866 C       
    867       If (Agrif_Root()) Return 
     992       
     993      if (tabvarsindic <=0) then 
     994      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     995      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) 
     1001      endif 
     1002             
    8681003      IF (present(procname)) THEN 
    8691004      Call Agrif_Interp_Bc_4D( 
    870      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    871      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    872      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    873      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    874      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     1005     & roottabvars % var % bctypeinterp, 
     1006     & parenttabvars, 
     1007     & tabvars,q, 
     1008     & tabvars % var % bcinf, 
     1009     & tabvars % var % bcsup, 
    8751010     & weight,pweight,procname)       
    8761011      ELSE 
    8771012      Call Agrif_Interp_Bc_4D( 
    878      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    879      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    880      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    881      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    882      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     1013     & roottabvars % var % bctypeinterp, 
     1014     & parenttabvars, 
     1015     & tabvars,q, 
     1016     & tabvars % var % bcinf, 
     1017     & tabvars % var % bcsup, 
    8831018     & weight,pweight) 
    8841019      ENDIF 
    8851020      End Subroutine Agrif_Bc_variable4d 
     1021             
    8861022C 
    8871023C     ************************************************************************** 
     
    8891025C     ************************************************************************** 
    8901026      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight, 
    891      &                              procname) 
     1027     &                               procname) 
    8921028 
    8931029      REAL   , Dimension(:,:,:,:,:)          :: q 
     
    8991035      REAL    :: weight 
    9001036      LOGICAL :: pweight 
    901 C 
     1037      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 
     1038C 
     1039C       
     1040C       
     1041      If (Agrif_Root()) Return 
     1042       
    9021043      if ( PRESENT(calledweight) ) then 
    9031044        weight=calledweight       
     
    9071048        pweight = .FALSE. 
    9081049      endif 
    909 C       
    910 C       
    911       If (Agrif_Root()) Return 
     1050       
     1051      if (tabvarsindic <=0) then 
     1052      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 
     1053      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) 
     1059      endif 
     1060             
    9121061      IF (present(procname)) THEN 
    913       Call Agrif_Interp_Bc_5D( 
    914      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    915      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    916      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    917      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    918      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     1062      Call Agrif_Interp_Bc_5d( 
     1063     & roottabvars % var % bctypeinterp, 
     1064     & parenttabvars, 
     1065     & tabvars,q, 
     1066     & tabvars % var % bcinf, 
     1067     & tabvars % var % bcsup, 
    9191068     & weight,pweight,procname)       
    9201069      ELSE 
    921       Call Agrif_Interp_Bc_5D( 
    922      & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp, 
    923      & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
    924      & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    925      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf, 
    926      & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup, 
     1070      Call Agrif_Interp_Bc_5d( 
     1071     & roottabvars % var % bctypeinterp, 
     1072     & parenttabvars, 
     1073     & tabvars,q, 
     1074     & tabvars % var % bcinf, 
     1075     & tabvars % var % bcsup, 
    9271076     & weight,pweight) 
    9281077      ENDIF 
    9291078      End Subroutine Agrif_Bc_variable5d 
     1079       
    9301080C 
    9311081C     ************************************************************************** 
     
    9331083C     ************************************************************************** 
    9341084C  
    935       Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic) 
     1085      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname) 
    9361086 
    9371087      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 
    9381088      INTEGER :: tabvarsindic  ! indice of the variable in tabvars 
    9391089      INTEGER :: dimensio  ! indice of the variable in tabvars 
     1090      External :: procname 
     1091      Optional ::  procname 
    9401092C       
    9411093      if (Agrif_Root()) Return 
     
    9431095      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim  
    9441096C 
    945       if ( dimensio .EQ. 1 ) 
    946      & Call Agrif_Interp_1D( 
     1097      if ( dimensio .EQ. 1 ) then 
     1098       if (present(procname)) then 
     1099       Call Agrif_Interp_1D( 
    9471100     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9481101     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9501103     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,      
    9511104     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1105     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1106       else 
     1107       Call Agrif_Interp_1D( 
     1108     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1109     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1110     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1111     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,      
     1112     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9521113     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    953 C 
    954       if ( dimensio .EQ. 2 ) 
    955      & Call Agrif_Interp_2D( 
     1114       endif 
     1115       endif 
     1116C 
     1117      if ( dimensio .EQ. 2 ) then 
     1118      if (present(procname)) then 
     1119       Call Agrif_Interp_2D( 
    9561120     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9571121     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9591123     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,      
    9601124     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1125     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1126      else 
     1127       Call Agrif_Interp_2D( 
     1128     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1129     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1130     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1131     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,      
     1132     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9611133     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    962 C 
    963       if ( dimensio .EQ. 3 ) 
    964      & Call Agrif_Interp_3D( 
     1134      endif 
     1135      endif 
     1136C 
     1137      if ( dimensio .EQ. 3 ) then 
     1138      if (present(procname)) then 
     1139       Call Agrif_Interp_3D( 
    9651140     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9661141     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9681143     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,      
    9691144     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1145     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1146      else 
     1147       Call Agrif_Interp_3D( 
     1148     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1149     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1150     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1151     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,      
     1152     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9701153     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    971 C 
    972       if ( dimensio .EQ. 4 ) 
    973      & Call Agrif_Interp_4D( 
     1154      endif 
     1155      endif 
     1156C 
     1157      if ( dimensio .EQ. 4 ) then 
     1158      if (present(procname)) then 
     1159       Call Agrif_Interp_4D( 
    9741160     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9751161     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9771163     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,      
    9781164     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1165     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1166      else 
     1167       Call Agrif_Interp_4D( 
     1168     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1169     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1170     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1171     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,      
     1172     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9791173     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    980 C 
    981       if ( dimensio .EQ. 5 ) 
    982      & Call Agrif_Interp_5D( 
     1174      endif 
     1175      endif 
     1176C 
     1177      if ( dimensio .EQ. 5 ) then 
     1178      if (present(procname)) then 
     1179       Call Agrif_Interp_5D( 
    9831180     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9841181     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9861183     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,      
    9871184     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1185     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1186      else 
     1187       Call Agrif_Interp_5D( 
     1188     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1189     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1190     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1191     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,      
     1192     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9881193     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    989 C 
    990       if ( dimensio .EQ. 6 ) 
    991      & Call Agrif_Interp_6D( 
     1194       endif 
     1195       endif 
     1196C 
     1197      if ( dimensio .EQ. 6 ) then 
     1198      if (present(procname)) then 
     1199       Call Agrif_Interp_6D( 
    9921200     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
    9931201     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     
    9951203     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,      
    9961204     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1205     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1206      else 
     1207       Call Agrif_Interp_6D( 
     1208     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     1209     & Agrif_Curgrid % parent % tabvars(tabvarsindic), 
     1210     & Agrif_Curgrid % tabvars(tabvarsindic), 
     1211     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,      
     1212     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
    9971213     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
     1214      endif 
     1215      endif 
    9981216C 
    9991217      Return 
     
    10041222C     ************************************************************************** 
    10051223C  
    1006       Subroutine Agrif_Interp_var1d(q,tabvarsindic) 
     1224      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname) 
    10071225 
    10081226      REAL, DIMENSION(:) :: q 
    10091227      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1228      External :: procname 
     1229      Optional ::  procname 
    10101230C 
    10111231      if (Agrif_Root()) Return 
    10121232C       
     1233      if (present(procname)) then 
    10131234      Call Agrif_Interp_1D( 
    10141235     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     
    10161237     & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    10171238     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1239     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1240      else 
     1241      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, 
    10181246     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1019  
     1247      endif 
    10201248      Return 
    10211249      End Subroutine Agrif_Interp_var1d 
     
    10251253C     ************************************************************************** 
    10261254C  
    1027       Subroutine Agrif_Interp_var2d(q,tabvarsindic) 
     1255      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname) 
    10281256 
    10291257      REAL,  DIMENSION(:,:) :: q 
    10301258      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1259      External :: procname 
     1260      Optional ::  procname 
     1261 
    10311262C 
    10321263       if (Agrif_Root()) Return 
    10331264C 
     1265       if (present(procname)) then 
    10341266       Call Agrif_Interp_2D( 
    10351267     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     
    10371269     & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    10381270     & 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, 
    10391278     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1040  
     1279       endif 
    10411280      Return 
    10421281      End Subroutine Agrif_Interp_var2d 
     
    10461285C     ************************************************************************** 
    10471286C  
    1048       Subroutine Agrif_Interp_var3d(q,tabvarsindic) 
     1287      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname) 
    10491288 
    10501289      REAL,  DIMENSION(:,:,:) :: q 
    10511290      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1291      External :: procname 
     1292      Optional ::  procname 
     1293 
    10521294C 
    10531295      if (Agrif_Root()) Return 
    10541296C 
     1297      if (present(procname)) then 
    10551298      Call Agrif_Interp_3D( 
    10561299     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     
    10581301     & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    10591302     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1303     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1304      else 
     1305      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, 
    10601310     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1061  
     1311      endif 
    10621312      Return 
    10631313      End Subroutine Agrif_Interp_var3d 
     
    10671317C     ************************************************************************** 
    10681318C  
    1069       Subroutine Agrif_Interp_var4d(q,tabvarsindic) 
     1319      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname) 
    10701320 
    10711321      REAL,  DIMENSION(:,:,:,:) :: q 
    10721322      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1323      External :: procname 
     1324      Optional ::  procname 
     1325 
    10731326C 
    10741327      if (Agrif_Root()) Return 
    10751328C 
     1329      if (present(procname)) then 
    10761330      Call Agrif_Interp_4D( 
    10771331     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     
    10791333     & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    10801334     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1335     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1336      else 
     1337      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, 
    10811342     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1082  
     1343      endif 
    10831344      Return 
    10841345      End Subroutine Agrif_Interp_var4d      
     
    10881349C     ************************************************************************** 
    10891350C  
    1090       Subroutine Agrif_Interp_var5d(q,tabvarsindic) 
     1351      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname) 
    10911352 
    10921353      REAL,  DIMENSION(:,:,:,:,:) :: q 
    10931354      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1355      External :: procname 
     1356      Optional ::  procname 
     1357 
    10941358C 
    10951359      if (Agrif_Root()) Return 
    10961360C 
     1361      if (present(procname)) then 
    10971362      Call Agrif_Interp_5D( 
    10981363     & Agrif_Mygrid % tabvars(tabvarsindic) % var %  TypeInterp, 
     
    11001365     & Agrif_Curgrid % tabvars(tabvarsindic),q, 
    11011366     & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 
     1367     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 
     1368      else 
     1369      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, 
    11021374     & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 
    1103  
     1375      endif 
    11041376      Return 
    11051377      End Subroutine Agrif_Interp_var5d        
     
    11101382C  
    11111383      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic, 
    1112      &                              locupdate,procname) 
     1384     &                              locupdate,locupdate1, 
     1385     &                  locupdate2,procname) 
    11131386 
    11141387      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     
    11181391      INTEGER :: dimensio 
    11191392      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
     1393      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1394      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2             
    11201395C 
    11211396      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim  
    11221397C       
    11231398      if (Agrif_Root()) Return 
     1399       
    11241400C      
    11251401      IF (present(locupdate)) THEN 
    1126       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1127       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1128       ELSE 
    1129       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1130       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
    1131       ENDIF 
     1402      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
     1403     &      = locupdate(1) 
     1404      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio)  
     1405     &      = locupdate(2) 
     1406      ELSE 
     1407      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)  
     1408     &      = -99 
     1409      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio)  
     1410     &      = -99 
     1411      ENDIF 
     1412       
     1413      IF (present(locupdate1)) THEN 
     1414      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1415     &      = locupdate1(1) 
     1416      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1417     &      = locupdate1(2) 
     1418      ENDIF   
     1419       
     1420      IF (present(locupdate2)) THEN 
     1421      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1422     &      = locupdate2(1) 
     1423      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1424     &      = locupdate2(2) 
     1425      ENDIF              
    11321426  
    11331427      if ( dimensio .EQ. 1 ) then 
     
    12401534C     ************************************************************************** 
    12411535C  
    1242       Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,procname) 
     1536      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate, 
     1537     &  locupdate1,locupdate2,procname) 
    12431538 
    12441539      REAL,  DIMENSION(:) :: q 
     
    12471542      Optional ::  procname       
    12481543      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
     1544      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1545      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    12491546C       
    12501547      if (Agrif_Root()) Return 
    12511548C      
    12521549      IF (present(locupdate)) THEN 
    1253       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1254       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1255       ELSE 
    1256       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1257       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
    1258       ENDIF 
     1550      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)  
     1551     &      = locupdate(1) 
     1552      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)  
     1553     &      = locupdate(2) 
     1554      ELSE 
     1555      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)  
     1556     &      = -99 
     1557      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)  
     1558     &      = -99 
     1559      ENDIF 
     1560       
     1561      IF (present(locupdate1)) THEN 
     1562      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1563     &      = locupdate1(1) 
     1564      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1565     &      = locupdate1(2) 
     1566      ENDIF   
     1567       
     1568      IF (present(locupdate2)) THEN 
     1569      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1570     &      = locupdate2(1) 
     1571      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1572     &      = locupdate2(2) 
     1573      ENDIF        
    12591574  
    12601575      IF (present(procname)) THEN 
     
    12831598C     ************************************************************************** 
    12841599C  
    1285       Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,procname) 
     1600      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate, 
     1601     &  locupdate1,locupdate2,procname) 
    12861602 
    12871603      REAL,  DIMENSION(:,:) :: q 
     
    12891605      Optional ::  procname 
    12901606      INTEGER, DIMENSION(2), OPTIONAL :: locupdate  
     1607      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1608      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    12911609      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
    12921610C       
    12931611      IF (Agrif_Root()) RETURN 
     1612       
    12941613C  
    12951614      IF (present(locupdate)) THEN 
    1296       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1297       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1298       ELSE 
    1299       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1300       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
     1615      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)  
     1616     &      = locupdate(1) 
     1617      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)  
     1618     &      = locupdate(2) 
     1619      ELSE 
     1620      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)  
     1621     &      = -99 
     1622      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)  
     1623     &      = -99 
     1624      ENDIF 
     1625       
     1626      IF (present(locupdate1)) THEN 
     1627      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1628     &      = locupdate1(1) 
     1629      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1630     &      = locupdate1(2) 
     1631      ENDIF   
     1632       
     1633      IF (present(locupdate2)) THEN 
     1634      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1635     &      = locupdate2(1) 
     1636      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1637     &      = locupdate2(2) 
    13011638      ENDIF 
    13021639  
     
    13261663C     ************************************************************************** 
    13271664C  
    1328       Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,procname) 
     1665      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate, 
     1666     &  locupdate1,locupdate2,procname) 
    13291667 
    13301668      REAL,  DIMENSION(:,:,:) :: q 
     
    13321670      Optional ::  procname 
    13331671      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
    1334       INTEGER :: tabvarsindic ! indice of the variable in tabvars 
    1335 C       
    1336       IF (Agrif_Root()) RETURN 
     1672      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1673      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
     1674      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
     1675C       
     1676      IF (Agrif_Root()) RETURN  
    13371677C       
    13381678 
    13391679      IF (present(locupdate)) THEN 
    1340       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1341       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1342       ELSE 
    1343       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1344       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
     1680      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)  
     1681     &      = locupdate(1) 
     1682      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)  
     1683     &      = locupdate(2) 
     1684      ELSE 
     1685      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)  
     1686     &      = -99 
     1687      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)  
     1688     &      = -99 
     1689      ENDIF       
     1690       
     1691      IF (present(locupdate1)) THEN 
     1692      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1693     &      = locupdate1(1) 
     1694      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1695     &      = locupdate1(2) 
     1696      ENDIF   
     1697       
     1698      IF (present(locupdate2)) THEN 
     1699      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1700     &      = locupdate2(1) 
     1701      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1702     &      = locupdate2(2) 
    13451703      ENDIF 
    13461704 
     
    13701728C     ************************************************************************** 
    13711729C  
    1372       Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,procname) 
     1730      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate, 
     1731     &  locupdate1,locupdate2,procname) 
    13731732 
    13741733      REAL,  DIMENSION(:,:,:,:) :: q 
     
    13761735      Optional ::  procname 
    13771736      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
     1737      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1738      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    13781739      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
    13791740C       
     
    13811742C       
    13821743      IF (present(locupdate)) THEN 
    1383       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1384       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1385       ELSE 
    1386       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1387       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
     1744      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)  
     1745     &      = locupdate(1) 
     1746      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)  
     1747     &      = locupdate(2) 
     1748      ELSE 
     1749      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)  
     1750     &      = -99 
     1751      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)  
     1752     &      = -99 
     1753      ENDIF 
     1754       
     1755      IF (present(locupdate1)) THEN 
     1756      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1757     &      = locupdate1(1) 
     1758      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1759     &      = locupdate1(2) 
     1760      ENDIF   
     1761       
     1762      IF (present(locupdate2)) THEN 
     1763      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1764     &      = locupdate2(1) 
     1765      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1766     &      = locupdate2(2) 
    13881767      ENDIF 
    13891768 
     
    14131792C     ************************************************************************** 
    14141793C  
    1415       Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,procname) 
     1794      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate, 
     1795     &  locupdate1,locupdate2,procname) 
    14161796 
    14171797      REAL,  DIMENSION(:,:,:,:,:) :: q 
     
    14191799      Optional ::  procname 
    14201800      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
     1801      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 
     1802      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2         
    14211803      INTEGER :: tabvarsindic ! indice of the variable in tabvars 
    14221804C 
     
    14241806C       
    14251807      IF (present(locupdate)) THEN 
    1426       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = locupdate(1) 
    1427       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = locupdate(2) 
    1428       ELSE 
    1429       Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = -99 
    1430       Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = -99 
     1808      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)  
     1809     &      = locupdate(1) 
     1810      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)  
     1811     &      = locupdate(2) 
     1812      ELSE 
     1813      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)  
     1814     &      = -99 
     1815      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)  
     1816     &      = -99 
     1817      ENDIF 
     1818       
     1819      IF (present(locupdate1)) THEN 
     1820      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)  
     1821     &      = locupdate1(1) 
     1822      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)  
     1823     &      = locupdate1(2) 
     1824      ENDIF   
     1825       
     1826      IF (present(locupdate2)) THEN 
     1827      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)  
     1828     &      = locupdate2(1) 
     1829      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)  
     1830     &      = locupdate2(2) 
    14311831      ENDIF 
    14321832 
     
    15511951       
    15521952      End Subroutine Agrif_Flux_Correction 
    1553                    
    1554       Subroutine Agrif_Declare_Profile(profilename,posvar,firstpoint, 
    1555      &    raf) 
     1953 
     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) 
     1969C 
     1970C     
     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 
     2046                               
     2047      Subroutine Agrif_Declare_Profile_flux(profilename,posvar, 
     2048     &    firstpoint,raf) 
    15562049      character*(*) :: profilename 
    15572050      Type(Agrif_Profile), Pointer :: newprofile 
     
    15772070      Agrif_myprofiles => newprofile 
    15782071       
    1579       End Subroutine Agrif_Declare_Profile 
     2072      End Subroutine Agrif_Declare_Profile_flux 
    15802073               
    15812074C 
  • trunk/AGRIF/AGRIF_FILES/modcluster.F

    r662 r1200  
    13071307C           grid pointed by parcours%gr       
    13081308C       
    1309             Call Agrif_Allocation (parcours % gr)      
     1309            Call Agrif_Allocation (parcours % gr)    
     1310C             
     1311            Call Agrif_initialisations(parcours % gr)               
    13101312C        
    13111313            Call Agrif_Instance(parcours % gr) 
  • trunk/AGRIF/AGRIF_FILES/modcurgridfunctions.F

    r774 r1200  
    960960      end subroutine Agrif_Open_File 
    961961 
     962C     ************************************************************************** 
     963CCC    subroutine Agrif_Set_MaskMaxSearch 
     964C     ************************************************************************** 
     965      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch) 
     966      integer mymaxsearch 
     967      MaxSearch = mymaxsearch 
     968      end subroutine Agrif_Set_MaskMaxSearch 
     969 
    962970      End Module Agrif_CurgridFunctions  
  • trunk/AGRIF/AGRIF_FILES/modinit.F

    r396 r1200  
    129129C     Pointer argument:  
    130130      Type(Agrif_Grid), Pointer  :: Agrif_Gr 
     131       
    131132C 
    132133      do i = 1 , Agrif_NbVariables 
     
    136137         if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
    137138             Agrif_Gr % tabvars(i) % var % nbdim = 1 
     139             Agrif_Gr % tabvars(i) % var % lb(1:1) =  
     140     &         lbound(Agrif_Gr%tabvars(i)%var%array1) 
     141             Agrif_Gr % tabvars(i) % var % ub(1:1) =  
     142     &         ubound(Agrif_Gr%tabvars(i)%var%array1)      
    138143         endif 
    139144         if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
    140145             Agrif_Gr % tabvars(i) % var % nbdim = 2 
     146             Agrif_Gr % tabvars(i) % var % lb(1:2) =  
     147     &         lbound(Agrif_Gr%tabvars(i)%var%array2) 
     148             Agrif_Gr % tabvars(i) % var % ub(1:2) =  
     149     &         ubound(Agrif_Gr%tabvars(i)%var%array2) 
    141150         endif 
    142151         if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
    143152             Agrif_Gr % tabvars(i) % var % nbdim = 3 
     153             Agrif_Gr % tabvars(i) % var % lb(1:3) =  
     154     &         lbound(Agrif_Gr%tabvars(i)%var%array3) 
     155             Agrif_Gr % tabvars(i) % var % ub(1:3) =  
     156     &         ubound(Agrif_Gr%tabvars(i)%var%array3) 
    144157         endif 
    145158         if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
    146159             Agrif_Gr % tabvars(i) % var % nbdim = 4 
     160             Agrif_Gr % tabvars(i) % var % lb(1:4) =  
     161     &         lbound(Agrif_Gr%tabvars(i)%var%array4) 
     162             Agrif_Gr % tabvars(i) % var % ub(1:4) =  
     163     &         ubound(Agrif_Gr%tabvars(i)%var%array4) 
    147164         endif 
    148165         if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
    149166             Agrif_Gr % tabvars(i) % var % nbdim = 5 
     167             Agrif_Gr % tabvars(i) % var % lb(1:5) =  
     168     &         lbound(Agrif_Gr%tabvars(i)%var%array5) 
     169             Agrif_Gr % tabvars(i) % var % ub(1:5) =  
     170     &         ubound(Agrif_Gr%tabvars(i)%var%array5) 
    150171         endif 
    151172         if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
    152173             Agrif_Gr % tabvars(i) % var % nbdim = 6 
     174             Agrif_Gr % tabvars(i) % var % lb(1:6) =  
     175     &         lbound(Agrif_Gr%tabvars(i)%var%array6) 
     176             Agrif_Gr % tabvars(i) % var % ub(1:6) =  
     177     &         ubound(Agrif_Gr%tabvars(i)%var%array6) 
    153178         endif 
    154179C 
  • trunk/AGRIF/AGRIF_FILES/modinterp.F

    r898 r1200  
    5454C  
    5555      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab, 
    56      &    torestore,nbdim)             
     56     &    torestore,nbdim,procname)             
    5757C 
    5858CCC   Description: 
     
    7474      LOGICAL :: torestore 
    7575      REAL, DIMENSION( 
    76      &         lbound(child%var%array1,1):ubound(child%var%array1,1) 
     76     &         child%var%lb(1):child%var%ub(1) 
    7777     &         ), Target :: tab    ! Result 
     78      External :: procname 
     79      Optional ::  procname 
    7880C 
    7981C 
     
    8890C     Tab is the result of the interpolation 
    8991      childtemp % var % array1 => tab  
     92       
     93      childtemp % var % lb = child % var % lb 
     94      childtemp % var % ub = child % var % ub   
     95             
    9096C       
    9197      if (torestore) then 
     
    108114      childtemp % var % list_interp => child % var% list_interp             
    109115C       
     116      if (present(procname)) then 
     117      Call Agrif_InterpVariable 
     118     &     (TypeInterp,parent,childtemp,torestore,procname) 
     119      else 
    110120      Call Agrif_InterpVariable 
    111121     &     (TypeInterp,parent,childtemp,torestore) 
     122      endif 
    112123      child % var % list_interp => childtemp % var %list_interp      
    113124C       
     
    124135C  
    125136      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab, 
    126      &                           torestore,nbdim)             
     137     &                           torestore,nbdim,procname)             
    127138C 
    128139CCC   Description: 
     
    144155      LOGICAL :: torestore 
    145156      REAL, DIMENSION( 
    146      &    lbound(child%var%array2,1):ubound(child%var%array2,1), 
    147      &    lbound(child%var%array2,2):ubound(child%var%array2,2) 
     157     &         child%var%lb(1):child%var%ub(1), 
     158     &         child%var%lb(2):child%var%ub(2) 
    148159     &    ), Target :: tab    ! Result 
     160      External :: procname 
     161      Optional ::  procname 
    149162C 
    150163C 
     
    159172C     Tab is the result of the interpolation 
    160173      childtemp % var % array2 => tab   
    161 C       
     174       
     175      childtemp % var % lb = child % var % lb 
     176      childtemp % var % ub = child % var % ub 
     177       
     178C 
    162179      if (torestore) then       
    163180C  
    164           childtemp % var % array2 = child % var % array2 
     181          childtemp % var % array2 = child % var % array2           
    165182C  
    166183          childtemp % var % restore2D => child % var % restore2D         
     
    179196      childtemp % var % list_interp => child % var% list_interp           
    180197C      
     198      if (present(procname)) then 
     199      Call Agrif_InterpVariable 
     200     &     (TypeInterp,parent,childtemp,torestore,procname) 
     201      else 
    181202      Call Agrif_InterpVariable 
    182203     &     (TypeInterp,parent,childtemp,torestore) 
     204      endif 
     205 
    183206      child % var % list_interp => childtemp % var %list_interp      
    184207C       
     
    195218C  
    196219      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab, 
    197      &   torestore,nbdim)             
     220     &   torestore,nbdim,procname)             
    198221C 
    199222CCC   Description: 
     
    215238      LOGICAL :: torestore 
    216239      REAL, DIMENSION( 
    217      &      lbound(child%var%array3,1):ubound(child%var%array3,1), 
    218      &      lbound(child%var%array3,2):ubound(child%var%array3,2), 
    219      &      lbound(child%var%array3,3):ubound(child%var%array3,3) 
     240     &         child%var%lb(1):child%var%ub(1), 
     241     &         child%var%lb(2):child%var%ub(2), 
     242     &         child%var%lb(3):child%var%ub(3) 
    220243     &      ), Target :: tab  ! Results 
     244      External :: procname 
     245      Optional ::  procname 
    221246C 
    222247C 
     
    231256C     Tab is the result of the interpolation  
    232257      childtemp % var % array3 => tab  
     258       
     259      childtemp % var % lb = child % var % lb 
     260      childtemp % var % ub = child % var % ub         
    233261C       
    234262      if (torestore) then 
     
    251279      childtemp % var % list_interp => child % var% list_interp           
    252280C      
     281 
     282      if (present(procname)) then 
     283      Call Agrif_InterpVariable 
     284     &     (TypeInterp,parent,childtemp,torestore,procname) 
     285      else 
    253286      Call Agrif_InterpVariable 
    254287     &     (TypeInterp,parent,childtemp,torestore) 
     288      endif 
     289 
     290 
    255291      child % var % list_interp => childtemp % var %list_interp      
    256292C       
     
    267303C  
    268304      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab, 
    269      &   torestore,nbdim)             
     305     &   torestore,nbdim,procname)             
    270306C 
    271307CCC   Description: 
     
    287323      LOGICAL :: torestore 
    288324      REAL, DIMENSION( 
    289      &      lbound(child%var%array4,1):ubound(child%var%array4,1), 
    290      &      lbound(child%var%array4,2):ubound(child%var%array4,2), 
    291      &      lbound(child%var%array4,3):ubound(child%var%array4,3), 
    292      &      lbound(child%var%array4,4):ubound(child%var%array4,4) 
     325     &         child%var%lb(1):child%var%ub(1), 
     326     &         child%var%lb(2):child%var%ub(2), 
     327     &         child%var%lb(3):child%var%ub(3), 
     328     &         child%var%lb(4):child%var%ub(4) 
    293329     &      ), Target :: tab  ! Results 
     330      External :: procname 
     331      Optional ::  procname 
    294332C 
    295333C 
     
    304342C     Tab is the result of the interpolation 
    305343      childtemp % var % array4 => tab  
     344       
     345      childtemp % var % lb = child % var % lb 
     346      childtemp % var % ub = child % var % ub   
     347             
    306348C  
    307349      if (torestore) then 
     
    324366      childtemp % var % list_interp => child % var% list_interp            
    325367C      
     368      if (present(procname)) then 
     369      Call Agrif_InterpVariable 
     370     &     (TypeInterp,parent,childtemp,torestore,procname) 
     371      else 
    326372      Call Agrif_InterpVariable 
    327373     &     (TypeInterp,parent,childtemp,torestore) 
     374      endif 
     375 
     376 
    328377      child % var % list_interp => childtemp % var %list_interp 
    329378C       
     
    340389C  
    341390      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab, 
    342      &   torestore,nbdim)             
     391     &   torestore,nbdim,procname)             
    343392C 
    344393CCC   Description: 
     
    360409      LOGICAL :: torestore 
    361410      REAL, DIMENSION( 
    362      &      lbound(child%var%array5,1):ubound(child%var%array5,1), 
    363      &      lbound(child%var%array5,2):ubound(child%var%array5,2), 
    364      &      lbound(child%var%array5,3):ubound(child%var%array5,3), 
    365      &      lbound(child%var%array5,4):ubound(child%var%array5,4), 
    366      &      lbound(child%var%array5,5):ubound(child%var%array5,5) 
     411     &         child%var%lb(1):child%var%ub(1), 
     412     &         child%var%lb(2):child%var%ub(2), 
     413     &         child%var%lb(3):child%var%ub(3), 
     414     &         child%var%lb(4):child%var%ub(4), 
     415     &         child%var%lb(5):child%var%ub(5) 
    367416     &      ),  Target :: tab  ! Results 
     417      External :: procname 
     418      Optional ::  procname 
    368419C 
    369420C 
     
    378429C     Tab is the result of the interpolation 
    379430      childtemp % var % array5 => tab   
     431       
     432      childtemp % var % lb = child % var % lb 
     433      childtemp % var % ub = child % var % ub   
     434             
    380435C       
    381436      if (torestore) then 
     
    398453      childtemp % var % list_interp => child % var% list_interp           
    399454C       
     455      if (present(procname)) then 
     456      Call Agrif_InterpVariable 
     457     &     (TypeInterp,parent,childtemp,torestore,procname) 
     458      else 
    400459      Call Agrif_InterpVariable 
    401460     &     (TypeInterp,parent,childtemp,torestore) 
     461      endif 
     462 
    402463      
    403464      child % var % list_interp => childtemp % var %list_interp 
     
    415476C  
    416477      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab, 
    417      &  torestore,nbdim)             
     478     &  torestore,nbdim,procname)             
    418479C 
    419480CCC   Description: 
     
    435496      LOGICAL :: torestore 
    436497      REAL, DIMENSION( 
    437      &      lbound(child%var%array6,1):ubound(child%var%array6,1), 
    438      &      lbound(child%var%array6,2):ubound(child%var%array6,2), 
    439      &      lbound(child%var%array6,3):ubound(child%var%array6,3), 
    440      &      lbound(child%var%array6,4):ubound(child%var%array6,4), 
    441      &      lbound(child%var%array6,5):ubound(child%var%array6,5), 
    442      &      lbound(child%var%array6,6):ubound(child%var%array6,6) 
     498     &         child%var%lb(1):child%var%ub(1), 
     499     &         child%var%lb(2):child%var%ub(2), 
     500     &         child%var%lb(3):child%var%ub(3), 
     501     &         child%var%lb(4):child%var%ub(4), 
     502     &         child%var%lb(5):child%var%ub(5), 
     503     &         child%var%lb(6):child%var%ub(6) 
    443504     &      ),  Target :: tab  ! Results 
     505      External :: procname 
     506      Optional ::  procname 
    444507C 
    445508C 
     
    454517C     Tab is the result of the interpolation 
    455518      childtemp % var % array6 => tab   
     519       
     520      childtemp % var % lb = child % var % lb 
     521      childtemp % var % ub = child % var % ub   
     522             
    456523C       
    457524      if (torestore) then 
     
    475542      childtemp % var % list_interp => child % var% list_interp            
    476543C       
     544 
     545      if (present(procname)) then 
     546      Call Agrif_InterpVariable 
     547     &     (TypeInterp,parent,childtemp,torestore,procname) 
     548      else 
    477549      Call Agrif_InterpVariable 
    478550     &     (TypeInterp,parent,childtemp,torestore) 
     551      endif 
     552 
     553 
    479554C       
    480555      child % var % list_interp => childtemp % var %list_interp 
     
    490565C     ************************************************************************** 
    491566C    
    492       Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore) 
     567      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore, 
     568     &            procname) 
    493569C 
    494570CCC   Description: 
     
    521597      REAL    ,DIMENSION(6) :: s_child,s_parent 
    522598      REAL    ,DIMENSION(6) :: ds_child,ds_parent 
     599      External :: procname 
     600      Optional ::  procname 
     601 
    523602C 
    524603      Call PreProcessToInterpOrUpdate(parent,child, 
     
    533612C     the grid variable 
    534613C 
     614 
     615      if (present(procname)) then 
     616      call Agrif_InterpnD 
     617     &            (TYPEinterp,parent,child, 
     618     &             pttab_Child(1:nbdim),petab_Child(1:nbdim), 
     619     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim), 
     620     &             s_Child(1:nbdim),s_Parent(1:nbdim), 
     621     &             ds_Child(1:nbdim),ds_Parent(1:nbdim), 
     622     &             child,torestore,nbdim,procname) 
     623      else 
    535624      call Agrif_InterpnD 
    536625     &            (TYPEinterp,parent,child, 
     
    540629     &             ds_Child(1:nbdim),ds_Parent(1:nbdim), 
    541630     &             child,torestore,nbdim) 
     631 
     632      endif 
    542633C 
    543634      Return 
     
    633724      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 
    634725      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 
    635       LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1       
     726      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 
    636727      LOGICAL, DIMENSION(1) :: memberin1 
    637728C 
    638729#endif       
    639730C      
     731 
    640732C    
    641733C     Boundaries of the current grid where interpolation is done 
    642734 
    643        
    644        
    645        
    646735      IF (Associated(child%var%list_interp)) THEN 
    647736      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab, 
     
    659748       
    660749      IF (.not.find_list_interp) THEN 
     750 
    661751      Call Agrif_nbdim_Get_bound_dimension(child % var, 
    662752     &                               lowerbound,upperbound,nbdim) 
    663  
     753       
    664754      Call Agrif_Childbounds(nbdim,lowerbound,upperbound, 
    665755     &                                   pttab,petab, 
     
    667757      
    668758C 
    669 C 
    670  
    671759      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob, 
    672760     &                        s_Parent_temp,s_Child_temp, 
     
    677765     &                        child%var%root_var%posvar, 
    678766     &                        child % var % root_var % interptab) 
    679  
    680  
     767        
    681768#ifdef AGRIF_MPI 
    682769       IF (memberin) THEN 
     
    689776     &                        child%var%root_var%posvar, 
    690777     &                        child % var % root_var % interptab) 
    691       ENDIF  
    692  
     778      ENDIF 
     779        
    693780      Call Agrif_nbdim_Get_bound_dimension(parent%var, 
    694781     &                              lowerbound,upperbound,nbdim) 
    695  
     782        
    696783      Call Agrif_ChildGrid_to_ParentGrid() 
    697784C 
     
    739826            
    740827      ENDIF 
    741  
    742  
    743828 
    744829      IF (member) THEN 
     
    855940#endif 
    856941     &    ) 
    857       endif 
    858        
     942      endif    
    859943C 
    860944C 
     
    9451029 
    9461030 
    947 C 
    948 C 
    949 C     Special values on the child grid   
    950       if (Agrif_UseSpecialValueFineGrid) then 
    951 C 
    952 #ifdef AGRIF_MPI 
    953 C         
    954           Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var, 
    955      &                 childarray, 
    956      &                 pttruetab,cetruetab, 
    957      &                 Agrif_SpecialValueFineGrid,nbdim) 
    958 C 
    959 #else 
    960 C 
    961           Call GiveAgrif_SpecialValueToTab(child%var,tempC%var, 
    962      &                  pttruetab,cetruetab, 
    963      &                  Agrif_SpecialValueFineGrid,nbdim) 
    964 C 
    965 #endif  
    966 C 
    967 C         
    968       endif 
    9691031 
    9701032 
     
    9871049#endif 
    9881050 
     1051 
     1052C 
     1053C 
     1054C     Special values on the child grid   
     1055      if (Agrif_UseSpecialValueFineGrid) then 
     1056C 
     1057 
     1058          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var, 
     1059     &                 childarray, 
     1060     &                 pttruetab,cetruetab, 
     1061     &                 Agrif_SpecialValueFineGrid,nbdim) 
     1062 
     1063C         
     1064      endif 
     1065       
    9891066      endif 
    9901067 
     
    10891166        CASE (2) 
    10901167           do j = pttruetab(2),cetruetab(2) 
    1091              do i = pttruetab(1),cetruetab(1)             
     1168             do i = pttruetab(1),cetruetab(1)  
    10921169              if (restore%var%restore2D(i,j) == 0)      
    10931170     &              child % var % array2(i,j) =  
     
    20962173          ENDIF 
    20972174        EndDo 
    2098 C        print *,'ok trouve' 
     2175 
    20992176        indmin = parcours%interp_loc%indmin(1:nbdim) 
    21002177        indmax = parcours%interp_loc%indmax(1:nbdim) 
  • trunk/AGRIF/AGRIF_FILES/modmask.F

    r779 r1200  
    3535C 
    3636      IMPLICIT NONE 
    37       Integer, Parameter :: MaxSearch = 3 
    3837C 
    3938      CONTAINS 
  • trunk/AGRIF/AGRIF_FILES/modsauv.F

    r662 r1200  
    6161C     Pointer argument     
    6262      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid 
    63       INTEGER i 
     63      INTEGER i  
    6464C 
    6565C    
     
    164164               Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    165165            endif   
    166                               
    167 C 
     166             
     167       endif 
     168            
     169C 
     170       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then 
     171         Call Agrif_Free_list_interp 
     172     &                          (Agrif_Gr%tabvars(i)%var%list_interp) 
     173       endif                              
     174C 
     175       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 
    168176            Deallocate(Agrif_Gr%tabvars(i)%var) 
    169177C  
     
    185193C 
    186194C 
     195      Recursive Subroutine Agrif_Free_list_interp(list_interp) 
     196      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp 
     197       
     198      if (associated(list_interp%suiv)) 
     199     &      Call Agrif_Free_list_interp(list_interp%suiv) 
     200      
     201#ifdef AGRIF_MPI 
     202       Deallocate(list_interp%interp_loc%tab4t) 
     203       Deallocate(list_interp%interp_loc%memberinall) 
     204       Deallocate(list_interp%interp_loc%sendtoproc1) 
     205       Deallocate(list_interp%interp_loc%recvfromproc1) 
     206#endif 
     207       Deallocate(list_interp%interp_loc) 
     208       Deallocate(list_interp) 
     209       Nullify(list_interp) 
     210 
     211      End Subroutine Agrif_Free_list_interp       
    187212C 
    188213C     ************************************************************************** 
     
    307332            if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 
    308333               Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    309             endif               
     334            endif                   
    310335! 
    311336            Deallocate(Agrif_Gr%tabvars(i)%var) 
  • trunk/AGRIF/AGRIF_FILES/modtypes.F

    r898 r1200  
    3232C     Maximum refinement ratio 
    3333 
    34       INTEGER, PARAMETER :: Agrif_MaxRaff = 7       
     34      INTEGER, PARAMETER :: Agrif_MaxRaff = 7 
     35       
     36C     Maximum number of grids of the hierarchy 
     37      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10 
     38                   
    3539C 
    3640C     ************************************************************************** 
     
    160164           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D 
    161165           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D 
    162             
     166           Type(Agrif_List_Variables), Pointer     :: variables=>NULL() 
     167           INTEGER                                 :: NbVariables = 0 
    163168           Type(Agrif_Flux), Pointer               :: fluxes => NULL() 
    164169      End TYPE Agrif_grid 
     
    172177C 
    173178      TYPE Agrif_Variable  
     179         CHARACTER*80 :: variablename 
    174180C        
    175181         ! Pointer on the variable of the root grid  
     
    204210         REAL*8, DIMENSION(:,:,:,:,:)  ,Pointer :: darray5   => NULL() 
    205211         REAL*8, DIMENSION(:,:,:,:,:,:),Pointer :: darray6   => NULL() 
     212C        Arrays containing the values of the grid variables (REAL*4) 
     213         REAL*4                                 :: sarray0 
     214         REAL*4, DIMENSION(:)          ,Pointer :: sarray1   => NULL() 
     215         REAL*4, DIMENSION(:,:)        ,Pointer :: sarray2   => NULL() 
     216         REAL*4, DIMENSION(:,:,:)      ,Pointer :: sarray3   => NULL() 
     217         REAL*4, DIMENSION(:,:,:,:)    ,Pointer :: sarray4   => NULL() 
     218         REAL*4, DIMENSION(:,:,:,:,:)  ,Pointer :: sarray5   => NULL() 
     219         REAL*4, DIMENSION(:,:,:,:,:,:),Pointer :: sarray6   => NULL() 
    206220C        Arrays containing the values of the grid variables (LOGICAL) 
    207221         LOGICAL                                 :: larray0 
     
    241255         INTEGER :: bcinf ! option bc 
    242256         INTEGER :: bcsup ! option bc 
    243          INTEGER :: updateinf ! option update 
    244          INTEGER :: updatesup ! option update          
     257         INTEGER, DIMENSION(6) :: updateinf ! option update 
     258         INTEGER, DIMENSION(6) :: updatesup ! option update          
    245259         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp 
    246260         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp 
    247261         INTEGER, DIMENSION(6) :: TYPEupdate ! option update 
     262          
     263         INTEGER, DIMENSION(6) :: lb, ub 
    248264          
    249265         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL() 
     
    278294      Type(Agrif_List_Interp_Loc), Pointer :: suiv 
    279295      End Type Agrif_List_Interp_Loc 
    280          
     296 
     297       TYPE Agrif_List_Variables 
     298         Type(Agrif_PVariable), Pointer :: pvar 
     299         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL() 
     300       END TYPE Agrif_List_Variables 
     301                
    281302       TYPE Agrif_Profile 
    282303          character*80 :: profilename 
     
    294315         !    each of them  
    295316         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL()  
     317         Type(Agrif_Variable), Pointer :: var 
    296318         Type(Agrif_Profile), Pointer :: nextprofile  => NULL() 
    297319       END TYPE Agrif_Profile 
     
    354376      INTEGER               :: Agrif_Minwidth 
    355377      REAL                  :: Agrif_Efficiency = 0.7 
     378      INTEGER               :: MaxSearch = 5 
    356379      REAL    ,DIMENSION(3) :: Agrif_mind 
    357380C     PARAMETERs for the interpolation of the child grids 
  • trunk/AGRIF/AGRIF_FILES/modupdate.F

    r898 r1200  
    6868      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    6969      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    70       INTEGER :: deb,fin                      ! Positions where interpolations  
     70      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    7171                                              ! are done on the fine grid        
    7272      External :: procname 
     
    8686C       
    8787C     Values on the current grid used for the update 
    88       childtemp % var % array1 => tab      
     88      childtemp % var % array1 => tab 
     89       
     90      childtemp % var % lb = child % var % lb 
     91      childtemp % var % ub = child % var % ub              
    8992       
    9093C      childtemp % var % list_update => child%var%list_update 
     
    129132      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    130133      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    131       INTEGER :: deb,fin                      ! Positions where interpolations  
     134      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    132135                                              ! are done on the fine grid  
    133136                                               
     
    151154C       
    152155C     Values on the current grid used for the update 
    153       childtemp % var % array2 => tab       
     156      childtemp % var % array2 => tab  
     157       
     158      childtemp % var % lb = child % var % lb 
     159      childtemp % var % ub = child % var % ub              
    154160       
    155161C      childtemp % var % list_update => child%var%list_update       
     
    191197      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    192198      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    193       INTEGER :: deb,fin                      ! Positions where interpolations  
     199      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    194200                                              ! are done on the fine grid     
    195201      External :: procname 
     
    215221      childtemp % var % array3 => tab      
    216222       
     223      childtemp % var % lb = child % var % lb 
     224      childtemp % var % ub = child % var % ub   
     225             
     226       
    217227C      childtemp % var % list_update => child%var%list_update       
    218228C 
     
    253263      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    254264      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    255       INTEGER :: deb,fin                      ! Positions where interpolations  
     265      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    256266                                              ! are done on the fine grid      
    257267      External :: procname 
     
    277287      childtemp % var % array4 => tab      
    278288       
     289      childtemp % var % lb = child % var % lb 
     290      childtemp % var % ub = child % var % ub   
     291             
     292       
    279293C      childtemp % var % list_update => child%var%list_update 
    280294             
     
    316330      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    317331      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    318       INTEGER :: deb,fin                      ! Positions where interpolations  
     332      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    319333                                              ! are done on the fine grid      
    320334      External :: procname 
     
    342356      childtemp % var % array5 => tab       
    343357       
     358      childtemp % var % lb = child % var % lb 
     359      childtemp % var % ub = child % var % ub         
     360       
    344361C      childtemp % var % list_update => child%var%list_update       
    345362C 
     
    381398      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid 
    382399      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child 
    383       INTEGER :: deb,fin                      ! Positions where interpolations  
     400      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    384401                                              ! are done on the fine grid        
    385402      REAL, DIMENSION( 
     
    404421C     Values on the current grid used for the update 
    405422      childtemp % var % array6 => tab       
     423       
     424      childtemp % var % lb = child % var % lb 
     425      childtemp % var % ub = child % var % ub   
     426             
    406427C      childtemp % var % list_update => child%var%list_update 
    407428C 
     
    439460      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid 
    440461      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid  
    441       INTEGER               :: deb,fin  ! Positions where boundary conditions 
     462      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
    442463                                        !    are calculated      
    443464      External :: procname 
     
    532553 
    533554      wholeupdate = .FALSE. 
    534  
    535       IF ((deb == -99) .AND. (deb == fin)) THEN 
    536        wholeupdate = .TRUE. 
    537       ENDIF 
    538  
    539       IF ((deb > fin)) THEN 
    540        wholeupdate = .TRUE. 
    541       ENDIF 
     555       
     556      do n=1,nbdim 
     557      if (loctab_child(n) /= -3) then 
     558        if (deb(n)>fin(n)) wholeupdate = .TRUE. 
     559        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE. 
     560      endif 
     561      enddo 
    542562      
    543563       IF (present(procname)) THEN 
     
    620640      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child 
    621641                                                     !    grid  
    622       INTEGER :: deb, fin 
     642      INTEGER, DIMENSION(6) :: deb, fin 
    623643      INTEGER                  :: nbdim              ! Number of dimensions of 
    624644                                                     !    the grid variable 
     
    677697        ENDIF 
    678698 
    679         IF (deb > fin) THEN 
    680           debloc = deb 
    681           finloc = finloc - deb 
     699        IF (deb(i) > fin(i)) THEN 
     700          debloc = deb(i) 
     701          finloc = finloc - deb(i) 
    682702        ENDIF 
    683703 
     
    810830      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child 
    811831                                                     !   grid  
    812       INTEGER                  :: deb,fin            ! Positions where 
    813                                                      !   interpolations are done 
     832      INTEGER, DIMENSION(6) :: deb, fin 
    814833      INTEGER                  :: nbdim              ! Number of dimensions of 
    815834                                                     !   the grid variable 
     
    859878      DO i = 1, nbdim 
    860879        coeffraf = nint(ds_Parent(i)/ds_Child(i)) 
    861         indtab(i,1,1) = pttab_child(i) + (deb + 1) * coeffraf 
    862         indtab(i,1,2) = pttab_child(i) + (fin + 1) * coeffraf 
     880        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf 
     881        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf 
    863882 
    864883        indtab(i,2,1) = pttab_child(i) + nbtab_child(i) 
    865      &    - (fin + 1) *  coeffraf 
     884     &    - (fin(i) + 1) *  coeffraf 
    866885        indtab(i,2,2) = pttab_child(i) + nbtab_child(i) 
    867      &    - (deb + 1) *  coeffraf 
     886     &    - (deb(i) + 1) *  coeffraf 
    868887 
    869888        IF (posvartab_child(i) == 1) THEN 
  • trunk/AGRIF/LIB/Makefile

    r530 r1200  
    22C_D = -g # -g -Wall 
    33# Compilation: 
    4 CC    = @$(C_L) $(C_O) $(C_D) 
     4CC    = cc -O 
    55#- 
    66OBJS = main.o WriteInFile.o toamr.o fortran.o  \ 
     
    1111       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \ 
    1212       UtilCharacter.o UtilListe.o UtilFile.o \ 
    13        WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o 
     13       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \ 
     14       WorkWithlistofcoupled.o 
     15 
    1416 
    1517.SUFFIXES: 
     
    4446WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h 
    4547WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h 
     48WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h 
    4649clean :  
    4750   /bin/rm -f *.o y.output 
  • trunk/AGRIF/LIB/Makefile.lex

    r663 r1200  
    1515       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \ 
    1616       UtilCharacter.o UtilListe.o UtilFile.o \ 
    17        WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o 
     17       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \ 
     18       WorkWithlistofcoupled.o 
    1819 
    1920.SUFFIXES: 
     
    3435   rm -f fortran.c 
    3536   cat fortran.tab.c  fortran.yy.c > fortran.c 
    36    rm -f fortran.yy.c fortran.tab.c 
     37#rm -f fortran.yy.c fortran.tab.c 
    3738convert.tab.c : convert.y decl.h 
    3839   $(YACC) convert.y 
     
    6667WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h 
    6768WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h 
     69WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h 
    6870clean :  
    6971   /bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \ 
  • trunk/AGRIF/LIB/SubLoopCreation.c

    r774 r1200  
    8484      /* now we should write the function declaration                         */ 
    8585      /*    case if it is the                                                 */ 
    86       WriteFunctionDeclaration(); 
     86      WriteFunctionDeclaration(1); 
    8787      if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n"); 
    88       if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1); 
     88 
     89//      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1); 
     90   
    8991      if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n"); 
    9092      if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n"); 
     
    100102      WriteLocalParamDeclaration(); 
    101103      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n"); 
    102       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(); 
     104      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 
    103105      WriteArgumentDeclaration_beforecall(); 
    104106/*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout); 
     
    106108      if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n"); 
    107109      if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n"); 
    108       WriteSubroutineDeclaration(1); 
     110//      WriteSubroutineDeclaration(1); 
    109111      if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n"); 
    110112   } 
     
    138140   while ( parcours ) 
    139141   { 
     142 
    140143      /* if the readed variable is a variable of the subroutine               */ 
    141144      /*    subroutinename we should write the name of this variable          */ 
     
    229232   int compteur ; 
    230233 
     234   strcpy(ligne,""); 
     235    
    231236   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n"); 
    232237   parcours = List_UsedInSubroutine_Var; 
     
    238243      /*    in the output file                                                */ 
    239244      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    240            parcours->var->v_allocatable == 0                            && 
     245          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    241246           parcours->var->v_pointerdeclare == 0 
    242247         ) 
     
    300305      parcours = parcours -> suiv; 
    301306   } 
     307    
    302308   Save_Length(ligne,41); 
    303309   tofich(outputfile,ligne,0); 
     
    327333{ 
    328334   listvar *parcours; 
    329    char ligne[LONG_40M]; 
     335/*   char ligne[LONG_40M];*/ 
     336   char *ligne; 
    330337   int compteur; 
    331338 
     339/*   strcpy(ligne," ");*/ 
     340 
     341   ligne=(char *)malloc(LONG_40M*sizeof(char)); 
     342    
    332343   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n"); 
    333344   parcours = List_UsedInSubroutine_Var; 
     
    339350      /*    in the output file                                                */ 
    340351      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    341            parcours->var->v_allocatable == 0                            && 
     352          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    342353           parcours->var->v_pointerdeclare == 0 
    343354         ) 
     
    385396   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    386397   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n"); 
     398   strcpy(ligne,""); 
     399    
     400   free(ligne); 
    387401} 
    388402 
     
    462476      fclose(fortranout); 
    463477      fortranout = oldfortranout; 
     478 
     479 
    464480      AddUseAgrifUtilBeforeCall_0(fortranout); 
    465       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(); 
     481      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
    466482      WriteArgumentDeclaration_beforecall(); 
    467483      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
     
    493509      tofich(fortranout,ligne,1); 
    494510      } 
     511    oldfortranout = (FILE *)NULL;       
    495512   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    496513   } 
     514    
    497515} 
    498516 
     
    514532      fclose(fortranout); 
    515533      fortranout = oldfortranout; 
     534 
    516535      AddUseAgrifUtilBeforeCall_0(fortranout); 
    517536      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    518537                                                       "      IMPLICIT NONE\n"); 
    519538      WriteLocalParamDeclaration(); 
    520       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(); 
     539      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
    521540      WriteArgumentDeclaration_beforecall(); 
    522541      WriteSubroutineDeclaration(0); 
     
    543562      tofich(fortranout,ligne,1); 
    544563      } 
     564   oldfortranout = (FILE *)NULL; 
    545565   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    546566   } 
  • trunk/AGRIF/LIB/UtilAgrif.c

    r774 r1200  
    103103/*                                                                            */ 
    104104/******************************************************************************/ 
    105 void ModifyTheVariableName_0(char *ident) 
     105void ModifyTheVariableName_0(char *ident, int lengthname) 
    106106{ 
    107107   listvar *newvar; 
    108108   int out; 
    109  
     109    
    110110   if ( firstpass == 0 ) 
    111111   { 
     
    150150      { 
    151151         /* remove the variable                                               */ 
    152          RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 
    153                                strlen(ident)); 
    154          fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 
     152         RemoveWordCUR_0(fortranout,(long)(-lengthname), 
     153                               lengthname); 
     154         fseek(fortranout,(long)(-lengthname),SEEK_CUR); 
    155155         /* then write the new name                                           */ 
    156156         if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 
     
    181181            { 
    182182               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; 
     183               else newvar=newvar->suiv; 
     184            } 
     185            if ( out == 1 ) 
     186            { 
     187               /* remove the variable                                         */ 
     188               RemoveWordCUR_0(fortranout,(long)(-lengthname), 
     189                                     lengthname); 
     190               fseek(fortranout,(long)(-lengthname),SEEK_CUR); 
     191               /* then write the new name                                     */ 
     192               if ( retour77 == 0 ) 
     193               { 
     194                  fprintf(fortranout," Agrif_tabvars & \n      "); 
     195               } 
     196               else 
     197               { 
     198                  fprintf(fortranout," \n     & Agrif_tabvars"); 
     199               } 
     200               fprintf(fortranout,"%s", 
     201                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     202               colnum = strlen( 
     203                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     204            } 
     205         } 
     206      } 
     207   } 
     208} 
     209 
     210/******************************************************************************/ 
     211/*                     ModifyTheVariableName_0                                */ 
     212/******************************************************************************/ 
     213/* Firstpass 0                                                                */ 
     214/******************************************************************************/ 
     215/*                                                                            */ 
     216/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */ 
     217/*                                                                            */ 
     218/******************************************************************************/ 
     219void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident) 
     220{ 
     221   listvar *newvar; 
     222   int out; 
     223    
     224   if ( firstpass == 0 ) 
     225   { 
     226      newvar = List_Global_Var; 
     227      out=0; 
     228      while ( newvar && out == 0 ) 
     229      { 
     230         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
     231         else newvar=newvar->suiv; 
     232      } 
     233 
     234      if ( out == 0 ) 
     235      { 
     236         newvar = List_ModuleUsed_Var; 
     237         while ( newvar && out == 0 ) 
     238         { 
     239            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
     240            else newvar=newvar->suiv; 
     241         } 
     242      } 
     243      if ( out == 0 ) 
     244      { 
     245         newvar = List_Common_Var; 
     246         while ( newvar && out == 0 ) 
     247         { 
     248            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
     249            else newvar=newvar->suiv; 
     250         } 
     251      } 
     252 
     253      if ( out == 0 ) 
     254      { 
     255         newvar = List_ModuleUsedInModuleUsed_Var; 
     256         while ( newvar && out == 0 ) 
     257         { 
     258            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
     259            else newvar=newvar->suiv; 
     260         } 
     261      } 
     262 
     263      if ( out == 1 ) 
     264      { 
     265         /* remove the variable                                               */ 
     266         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)), 
     267                               strlen(ident)); 
     268         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR); 
     269         /* then write the new name                                           */ 
     270         if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) 
     271            fprintf(fortranout,"%d",newvar->var->v_indicetabvars); 
     272         else 
     273         { 
     274            if ( retour77 == 0 ) 
     275            { 
     276               fprintf(fortranout," Agrif_tabvars & \n      "); 
     277            } 
     278            else 
     279            { 
     280               fprintf(fortranout,"Agrif_tabvars"); 
     281               fprintf(fortranout," \n     & "); 
     282            } 
     283            fprintf(fortranout,"%s", 
     284                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     285            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); 
     286         } 
     287      } 
     288      else 
     289      { 
     290         /* we should look in the List_ModuleUsed_Var                         */ 
     291         if ( inagrifcallargument != 1 ) 
     292         { 
     293            newvar = List_ModuleUsed_Var; 
     294            while ( newvar && out == 0 ) 
     295            { 
     296               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1; 
    183297               else newvar=newvar->suiv; 
    184298            } 
     
    207321   } 
    208322} 
     323 
    209324 
    210325 
     
    581696{ 
    582697   char toprint[LONG_C]; 
    583  
    584698   if ( firstpass == 0 ) 
    585699   { 
  • trunk/AGRIF/LIB/UtilCharacter.c

    r774 r1200  
    5656   listvar *newvar; 
    5757   int out; 
     58    
    5859 
    5960   if ( strcasecmp(name,"") ) 
     
    6566         if ( !strcasecmp(newvar->var->v_nomvar,name) ) 
    6667         { 
     68 
    6769            if ( LookingForVariableInListName( 
    6870                             List_SubroutineArgument_Var,name) == 0 ) 
     
    100102   strcpy(toprintglob,""); 
    101103   strcpy(toprinttmp,""); 
     104 
    102105   /*                                                                         */ 
    103106   while ( i < strlen(nom) ) 
     
    164167   Save_Length(toprinttmp,44); 
    165168   Save_Length(toprintglob,39); 
     169 
    166170   /*                                                                         */ 
    167171   return toprintglob; 
  • trunk/AGRIF/LIB/UtilFile.c

    r774 r1200  
    6666 
    6767/******************************************************************************/ 
     68/*                           setposcurname                                       */ 
     69/******************************************************************************/ 
     70/* This subroutine is used to know the current position in the file in argument    */ 
     71/******************************************************************************/ 
     72/*                                                                            */ 
     73/*                      setposcur ---------> position in file                 */ 
     74/*                                                                            */ 
     75/******************************************************************************/ 
     76long int setposcurname(FILE *fileout) 
     77{ 
     78   fflush(fileout); 
     79   return ftell(fileout); 
     80} 
     81 
     82/******************************************************************************/ 
    6883/*                           setposcur                                        */ 
    6984/******************************************************************************/ 
  • trunk/AGRIF/LIB/UtilFortran.c

    r774 r1200  
    167167/* This subroutine is to know if a variable is global                         */ 
    168168/******************************************************************************/ 
    169 void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout) 
     169void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse) 
    170170{ 
    171171  int Globalite; 
     
    175175  listvar *newvar2; 
    176176  int out; 
     177  char truename[LONG_C];   
    177178 
    178179  Globalite = 1; 
     
    181182  tempo = Readthedependfile(module,tempo); 
    182183  newvar = listin; 
     184 
    183185  while ( newvar ) 
    184186  { 
     187     if (!strcmp(newvar->c_namepointedvar,"")) { 
     188       strcpy(truename,newvar->c_namevar); 
     189     } 
     190     else 
     191     { 
     192       strcpy(truename,newvar->c_namepointedvar); 
     193     } 
     194      
    185195     out = 0; 
    186196     newvar2 = tempo; 
    187197     while ( newvar2 && out == 0 ) 
    188198     { 
    189         if ( !strcasecmp(newvar2->var->v_nomvar,newvar->c_namevar) ) out = 1; 
     199        if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1; 
    190200        else newvar2 = newvar2 ->suiv; 
    191201     } 
     
    213223  if ( Globalite == 0 || !newvar) 
    214224  { 
    215      pos_end = setposcur(); 
    216      RemoveWordSET_0(fileout,pos_curuse, 
    217                                 pos_end-pos_curuse); 
     225     pos_end = setposcurname(fileout); 
     226     RemoveWordSET_0(fileout,oldposcuruse, 
     227                                pos_end-oldposcuruse); 
     228                                   
    218229     newvar = listin; 
    219230     while ( newvar ) 
     
    234245} 
    235246 
    236 void Remove_Word_end_module_0() 
    237 { 
    238    if ( firstpass == 0 ) 
    239    { 
    240       RemoveWordCUR_0(fortranout,(long)(-strlen(curmodulename)-12), 
    241                                          strlen(curmodulename)+11); 
     247void Remove_Word_end_module_0(int modulenamelength) 
     248{ 
     249   if ( firstpass == 0 ) 
     250   { 
     251      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12), 
     252                                         modulenamelength+11); 
    242253   } 
    243254} 
     
    470481         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    471482         { 
    472             writevardeclaration(parcours,module_declar,0); 
     483            writevardeclaration(parcours,module_declar,0,1); 
    473484         } 
    474485         parcours = parcours -> suiv; 
    475486      } 
     487   } 
     488} 
     489 
     490void Write_GlobalType_Declaration_0() 
     491{ 
     492   listvar *parcours; 
     493   int out = 0; 
     494   int headtypewritten = 0; 
     495   char ligne[LONGNOM]; 
     496   int changeval; 
     497 
     498   if ( firstpass == 0 ) 
     499   { 
     500      parcours = List_Global_Var; 
     501      while( parcours ) 
     502      { 
     503         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
     504         { 
     505           if (!strcasecmp(parcours->var->v_typevar,"type")) 
     506           { 
     507            out = 1; 
     508            if (headtypewritten == 0) 
     509              { 
     510                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename); 
     511                tofich(module_declar,ligne,1); 
     512                headtypewritten = 1; 
     513              } 
     514            changeval = 0; 
     515            if (parcours->var->v_allocatable == 1) 
     516             { 
     517               changeval = 1; 
     518               parcours->var->v_allocatable = 0; 
     519               parcours->var->v_pointerdeclare = 1; 
     520             } 
     521            writevardeclaration(parcours,module_declar,0,0); 
     522            if (changeval == 1) 
     523              { 
     524               parcours->var->v_allocatable = 1; 
     525               parcours->var->v_pointerdeclare = 0; 
     526              } 
     527            } 
     528         } 
     529         parcours = parcours -> suiv; 
     530      } 
     531      if (out == 1) 
     532        { 
     533                sprintf(ligne,"END TYPE Agrif_%s",curmodulename); 
     534                tofich(module_declar,ligne,1); 
     535                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename);  
     536                tofich(module_declar,ligne,1); 
     537        } 
    476538   } 
    477539} 
     
    488550         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) 
    489551         { 
    490             writevardeclaration(parcours,fortranout,0); 
     552            writevardeclaration(parcours,fortranout,0,1); 
    491553         } 
    492554         parcours = parcours -> suiv; 
     
    648710} 
    649711 
     712/******************************************************************************/ 
     713/*                          varistyped_0                                    */ 
     714/******************************************************************************/ 
     715/* Firstpass 0                                                                */ 
     716/******************************************************************************/ 
     717/*                                                                            */ 
     718/******************************************************************************/ 
     719int varistyped_0(char *ident) 
     720{ 
     721   listvar *parcours; 
     722   int out; 
     723 
     724   out =0; 
     725   if ( firstpass == 0 ) 
     726   { 
     727      parcours = List_Global_Var; 
     728      while( parcours && out == 0 ) 
     729      { 
     730         if ( !strcasecmp(ident,parcours->var->v_nomvar) )  
     731             { 
     732             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1; 
     733             } 
     734         parcours = parcours->suiv; 
     735      } 
     736   } 
     737   return out; 
     738} 
     739 
    650740 
    651741/******************************************************************************/ 
  • trunk/AGRIF/LIB/UtilListe.c

    r774 r1200  
    9191{ 
    9292   listvar *newvar; 
    93  
    9493   if ( firstpass == ValueFirstpass ) 
    9594   { 
     
    207206      strcpy(tmpvar->v_commonname,parcours->var->v_commonname); 
    208207      strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec); 
     208 
    209209      strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename); 
     210             
    210211      tmpvar->v_pointedvar=parcours->var->v_pointedvar; 
    211212      strcpy(tmpvar->v_commoninfile,mainfile); 
     
    361362      Save_Length(nameinttypename,9); 
    362363   } 
     364          
    363365   if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1; 
    364366   if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1; 
     
    369371   /*                                                                         */ 
    370372   var->v_dimension=d; 
     373 
    371374   /* Creation of the string for the dimension of this variable               */ 
    372375   dimsempty = 1; 
     
    464467   return newvar ; 
    465468} 
     469 
     470/******************************************************************/ 
     471/* printliste  */ 
     472/* print the list given in argulent */ 
     473/******************************************************************/ 
     474 
     475void printliste(listvar * lin) 
     476{ 
     477   listvar *newvar; 
     478   variable *v; 
     479 
     480   newvar=lin; 
     481   while (newvar) 
     482   { 
     483      v=newvar->var; 
     484      printf("nom = %s, allocatable = %d dim = %s\n",v->v_nomvar,v->v_allocatable,(v->v_dimension)->dim.last); 
     485      newvar=newvar->suiv; 
     486   } 
     487} 
     488 
     489/******************************************************************************/ 
     490/*   IsinListe : return 1 if name nom is in list lin                          */ 
     491/*                                                                            */ 
     492/******************************************************************************/ 
     493 int IsinListe(listvar *lin,char *nom) 
     494{ 
     495   listvar *newvar; 
     496   variable *v; 
     497   int out ; 
     498    
     499   newvar=lin; 
     500   out = 0; 
     501   while (newvar && (out == 0)) 
     502   { 
     503      v=newvar->var; 
     504      if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) { 
     505      out = 1; 
     506      } 
     507      newvar=newvar->suiv; 
     508   } 
     509 
     510   return out ; 
     511} 
     512 
     513listname *Insertname(listname *lin,char *nom) 
     514{ 
     515   listname *newvar ; 
     516   listname *tmpvar; 
     517 
     518   newvar=(listname *) malloc (sizeof (listname)); 
     519   strcpy(newvar->n_name,nom); 
     520   newvar->suiv = NULL; 
     521   if (!lin) 
     522   { 
     523      newvar->suiv=NULL; 
     524      lin = newvar; 
     525   } 
     526   else 
     527   { 
     528      tmpvar = lin ; 
     529      while (tmpvar->suiv) 
     530      { 
     531         tmpvar = tmpvar ->suiv ; 
     532      } 
     533      tmpvar -> suiv = newvar; 
     534   } 
     535   return lin; 
     536} 
     537 
     538/******************************************************************/ 
     539/* printname  */ 
     540/* print the list given in argulent */ 
     541/******************************************************************/ 
     542 
     543void printname(listname * lin) 
     544{ 
     545   listname *newvar; 
     546 
     547   newvar=lin; 
     548   while (newvar) 
     549   { 
     550      printf("nom = %s \n",newvar->n_name); 
     551      newvar=newvar->suiv; 
     552   } 
     553} 
     554 
     555void removeglobfromlist(listname **lin) 
     556{ 
     557  listname *listemp; 
     558  listname *parcours1; 
     559  listvar *parcours2; 
     560  listname * parcourspres; 
     561  int out; 
     562   
     563  parcours1 = *lin; 
     564  parcourspres = (listname *)NULL; 
     565   
     566  while (parcours1) 
     567  { 
     568  parcours2 = List_Global_Var; 
     569  out = 0; 
     570  while (parcours2 && out == 0) 
     571  { 
     572    if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name)) 
     573    { 
     574    out = 1; 
     575    } 
     576    parcours2 = parcours2->suiv; 
     577  } 
     578  if (out == 1) 
     579  { 
     580  if (parcours1 == *lin) 
     581   { 
     582   *lin = (*lin)->suiv; 
     583   parcours1 = *lin; 
     584   } 
     585   else 
     586   { 
     587   parcourspres->suiv = parcours1->suiv; 
     588   parcours1 = parcourspres->suiv; 
     589   } 
     590   } 
     591   else 
     592   { 
     593   parcourspres = parcours1; 
     594    parcours1 = parcours1->suiv;   
     595    } 
     596  } 
     597} 
     598 
     599void writelistpublic(listname *lin) 
     600{ 
     601  listname *parcours1; 
     602  char ligne[LONG_40M]; 
     603  char tempname[LONG_4M]; 
     604   
     605  if (lin) 
     606  { 
     607  sprintf(ligne,"public :: "); 
     608  parcours1 = lin; 
     609   
     610  while (parcours1) 
     611  { 
     612    strcat(ligne,parcours1->n_name); 
     613    if (parcours1->suiv) strcat(ligne,", "); 
     614    parcours1 = parcours1->suiv;   
     615  } 
     616  tofich(fortranout,ligne,1); 
     617  } 
     618 
     619} 
  • trunk/AGRIF/LIB/WorkWithglobliste.c

    r774 r1200  
    7373   } 
    7474} 
     75 
     76void checkandchangedims(listvar *listsecondpass) 
     77{ 
     78listvar *parcours; 
     79listvar *parcours1; 
     80variable * newvar; 
     81variable * oldvar; 
     82 
     83int out ; 
     84 
     85printliste(List_Global_Var); 
     86printliste(List_SubroutineDeclaration_Var); 
     87 
     88parcours = listsecondpass; 
     89while (parcours) 
     90{ 
     91newvar = parcours->var; 
     92parcours1 = List_SubroutineDeclaration_Var; 
     93out = 0; 
     94while (parcours1 && out == 0) 
     95{ 
     96  oldvar = parcours1->var; 
     97  if (!strcasecmp(newvar->v_nomvar,oldvar->v_nomvar) && !strcasecmp(newvar->v_subroutinename,subroutinename)) 
     98   { 
     99   if (newvar->v_dimensiongiven == 1) 
     100   { 
     101    strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last); 
     102    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);     
     103   } 
     104   out = 1; 
     105   } 
     106  parcours1 = parcours1->suiv; 
     107} 
     108parcours = parcours->suiv; 
     109} 
     110printliste(List_SubroutineDeclaration_Var); 
     111} 
  • trunk/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c

    r774 r1200  
    287287  newmodule = List_NameOfModuleUsed; 
    288288  fprintf(fortranout,"\n"); 
     289 
    289290  while ( newmodule ) 
    290291  { 
  • trunk/AGRIF/LIB/WorkWithlistvarindoloop.c

    r774 r1200  
    250250 
    251251  pointtmplist = List_CouplePointed_Var; 
    252  
    253252  while ( pointtmplist ) 
    254253  { 
     
    312311                        strcpy(var1->v_nameinttypename,var2->v_nameinttypename); 
    313312   else strcpy(var2->v_nameinttypename,var1->v_nameinttypename); 
    314  
     313           
    315314   if ( !strcasecmp(var1->v_commoninfile,"") ) 
    316315                              strcpy(var1->v_commoninfile,var2->v_commoninfile); 
     
    425424      } 
    426425      /* if variable has been found                                           */ 
     426       
    427427      if ( out == 1 ) CopyRecord(parcours->var,parcours1->var); 
     428       
    428429      /* looking in List_Dimension_Var                                        */ 
    429430      if (out == 0 ) 
     
    447448        } 
    448449        /* if variable has been found                                         */ 
     450         
    449451        if ( out == 1 ) 
    450452        { 
     
    522524   listvar *parcours1; 
    523525   int out; 
    524  
    525526   parcours = list_to_modify; 
    526527   while( parcours ) 
     
    558559   listvar *parcours1; 
    559560   int out; 
    560  
     561    
    561562   parcours = list_to_modify; 
    562563   while( parcours ) 
    563564   { 
    564565      /* looking in List_Global_Var                                           */ 
     566       
     567      out = 0; 
     568      if (list_to_modify != List_SubroutineDeclaration_Var) { 
    565569      parcours1 = List_Global_Var; 
    566       out = 0; 
    567570      while ( parcours1 && out == 0 ) 
    568571      { 
     
    574577         else parcours1 = parcours1->suiv; 
    575578      } 
     579      } 
     580           
    576581      /* if variable has been found                                           */ 
    577       if ( out == 1 ) CopyRecord(parcours->var,parcours1->var); 
     582      if ( out == 1 ) { 
     583      CopyRecord(parcours->var,parcours1->var); 
     584      } 
    578585      /* looking in List_SubroutineDeclaration_Var                            */ 
    579586      else 
     
    592599            else parcours1 = parcours1->suiv; 
    593600         } 
     601              
    594602         /* if variable has been found                                        */ 
    595          if ( out == 1 ) CopyRecord(parcours->var,parcours1->var); 
     603         if ( out == 1 ) { 
     604         CopyRecord(parcours->var,parcours1->var); 
     605         } 
    596606         else 
    597607         { 
     
    610620            } 
    611621            /* if variable has been found                                     */ 
    612             if ( out == 1 ) CopyRecord(parcours->var,parcours1->var); 
     622            if ( out == 1 ) CopyRecord(parcours->var,parcours1->var);        
    613623         } 
    614624      } 
    615625      parcours = parcours->suiv; 
    616626   } 
     627    
    617628} 
    618629 
     
    823834void UpdateListDeclarationWithDimensionList() 
    824835{ 
    825  
    826836   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, 
    827837                                              List_SubroutineDeclaration_Var,1); 
    828  
    829838} 
    830839 
     
    843852   listvar *parcoursprec; 
    844853   int remove; 
    845  
     854     
     855         
    846856   parcoursprec = (listvar *)NULL; 
    847857   parcours = List_UsedInSubroutine_Var; 
     
    952962   listvar *parcoursprec; 
    953963   int out ; 
    954  
     964            
    955965   parcoursprec = (listvar *)NULL; 
    956966   parcours = List_SubroutineDeclaration_Var; 
     
    10031013      } 
    10041014   } 
     1015        
    10051016} 
    10061017 
     
    10791090   Clean_List_UsedInSubroutine_Var(); 
    10801091   Clean_List_SubroutineDeclaration_Var(); 
    1081  
     1092    
    10821093   newvar = (listvar *)NULL; 
    10831094/*   newvar = List_Common_Var;*/ 
     
    11041115{ 
    11051116   listvar *newvar; 
    1106  
     1117         
    11071118   Update_List_Subroutine_Var(List_SubroutineArgument_Var); 
     1119 
     1120 
     1121        
    11081122   Update_List_Subroutine_Var(List_FunctionType_Var); 
    11091123   Update_List_Var(List_Parameter_Var); 
     
    11161130   Update_List_Var(List_UsedInSubroutine_Var); 
    11171131   Update_List_From_Common_Var(List_UsedInSubroutine_Var); 
     1132   Update_List_From_Common_Var(List_SubroutineDeclaration_Var); 
    11181133   Update_NotGridDepend_Var(List_NotGridDepend_Var); 
    1119  
     1134     
    11201135   newvar =(listvar * )NULL; 
    11211136/*   newvar = List_Common_Var;*/ 
     
    11861201      parcours = parcours -> suiv ; 
    11871202   } 
     1203        
    11881204} 
    11891205 
     
    12551271      parcours = parcours->suiv; 
    12561272   } 
     1273        
    12571274} 
    12581275 
     
    15741591              !strcasecmp(parcours->var->v_subroutinename,"")            && 
    15751592              parcours->var->v_VariableIsParameter == 0                  && 
    1576               parcours->var->v_allocatable == 0                          && 
     1593              (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    15771594              parcours->var->v_notgrid == 0                              && 
    15781595              ( parcours->var->v_nbdim != 0 || 
     
    17191736   while ( parcours4 ) 
    17201737   { 
    1721       if ( parcours4->var->v_allocatable == 1 ) 
     1738      if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type")) 
    17221739      { 
    17231740         Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, 
  • trunk/AGRIF/LIB/WriteInFile.c

    r774 r1200  
    5252  if (strlen (s) <= 60) 
    5353    { 
    54       if ( returnlineornot == 0 ) fprintf (filout, "     & %s", s); 
    55       else if ( returnlineornot == 2 ) fprintf (filout, "& %s", s); 
    56       else if ( returnlineornot == 3 ) fprintf (filout, "& %s\n", s); 
    57       else                             fprintf (filout, "     & %s\n", s); 
     54      if ( returnlineornot == 0 ) fprintf (filout, "     &%s", s); 
     55      else if ( returnlineornot == 2 ) fprintf (filout, "&%s", s); 
     56      else if ( returnlineornot == 3 ) fprintf (filout, "&%s\n", s); 
     57      else                             fprintf (filout, "     &%s\n", s); 
    5858      if ( returnlineornot == 0 || 
    5959           returnlineornot == 2 ) colnum=colnum+strlen(s)+6; 
     
    9595      strcpy (&temp[60-size], "\0"); 
    9696 
    97       if ( retour77 == 0 ) fprintf (filout, "     & %s  &\n", temp); 
    98       else fprintf (filout, "     & %s  \n", temp); 
     97      if ( retour77 == 0 ) fprintf (filout, "     &%s&\n", temp); 
     98      else fprintf (filout, "     &%s\n", temp); 
    9999      colnum=0; 
    100100      tofich_reste (filout, (char *) &s[60-size],returnlineornot); 
     
    159159      strcpy (&temp[60-size], "\0"); 
    160160 
    161       if ( retour77 == 0 ) fprintf (filout, "      %s  &\n", temp); 
    162       else fprintf (filout, "      %s  \n", temp); 
     161      if ( retour77 == 0 ) fprintf (filout, "      %s&\n", temp); 
     162      else fprintf (filout, "      %s\n", temp); 
    163163      colnum=0; 
    164164      tofich_reste (filout, (char *) &s[60-size], returnlineornot); 
  • trunk/AGRIF/LIB/Writedeclarations.c

    r774 r1200  
    5050/*                                                                            */ 
    5151/******************************************************************************/ 
    52 void WriteBeginDeclaration(variable *v,char ligne[LONG_4C]) 
     52void WriteBeginDeclaration(variable *v,char ligne[LONG_4C], int visibility) 
    5353{ 
    5454  char tmpligne[LONG_4C]; 
     
    5959     printf("          is unknown. CONV should define a type\n"); 
    6060  } 
     61   
    6162  sprintf (ligne, "%s", v->v_typevar); 
    6263  if ( v->v_c_star == 1 ) strcat(ligne,"*"); 
     64   
    6365  /* We should give the precision of the variable if it has been given        */ 
    6466  if ( strcasecmp(v->v_precision,"") ) 
     
    6870     strcat(ligne,tmpligne); 
    6971  } 
     72   
    7073  if (strcasecmp(v->v_dimchar,"")) 
    7174  { 
     
    7477     strcat(ligne,tmpligne); 
    7578  } 
     79   
    7680  if ( strcasecmp(v->v_nameinttypename,"") ) 
    7781  { 
     
    8791  } 
    8892  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER"); 
     93  if (visibility == 1) 
     94  { 
    8995  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC"); 
    9096  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE"); 
     97  } 
    9198  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL"); 
    9299  if ( v->v_allocatable         == 1 && 
    93        v->v_save                == 0 ) strcat(ligne,", ALLOCATABLE"); 
     100       v->v_save                == 0 ) 
     101       {strcat(ligne,", ALLOCATABLE"); 
     102       } 
    94103  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL"); 
    95104  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER"); 
     
    141150 
    142151  strcat (ligne, ", Dimension("); 
     152 
    143153  if ( v->v_dimensiongiven == 1 && tmpok == 1 ) 
     154  { 
    144155                                         strcat(ligne,v->v_readedlistdimension); 
     156                                         } 
    145157  if ( v->v_dimensiongiven == 1 && tmpok == 0 ) 
    146158  { 
    147159     strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    148160                                  (v->v_readedlistdimension,List_Global_Var,0)); 
    149      if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
    150      { 
    151         strcpy(newname,""); 
     161 
     162     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
     163 
    152164        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    153                                  (v->v_readedlistdimension,List_Common_Var,0)); 
     165                                 (newname,List_Common_Var,0)); 
     166 
     167     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);  
     168      
     169        strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
     170                              (newname,List_ModuleUsed_Var,0)); 
    154171        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    155      } 
    156      if ( !strcasecmp(newname,v->v_readedlistdimension) ) 
    157      { 
    158         strcpy(newname,""); 
    159         /* la liste des use de cette subroutine                               */ 
    160         strcpy(newname,ChangeTheInitalvaluebyTabvarsName 
    161                               (v->v_readedlistdimension,List_ModuleUsed_Var,0)); 
    162         if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
    163      } 
     172 
    164173     Save_Length(newname,47); 
    165174     strcat(ligne,newname); 
     
    190199/*                                                                            */ 
    191200/******************************************************************************/ 
    192 void writevardeclaration (listvar * var_record, FILE *fileout, int value) 
     201void writevardeclaration (listvar * var_record, FILE *fileout, int value, int visibility) 
    193202{ 
    194203  FILE *filecommon; 
     
    199208  filecommon=fileout; 
    200209  newvar = var_record; 
    201  
     210   
    202211  if ( newvar->var->v_save == 0 || inmodulemeet == 0 ) 
    203212  { 
    204213     v = newvar->var; 
    205      WriteBeginDeclaration(v,ligne); 
     214      
     215     WriteBeginDeclaration(v,ligne,visibility); 
     216 
    206217     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    207218     else WriteTableDeclaration(v,ligne,value); 
     
    212223        strcat(ligne,v->v_initialvalue); 
    213224     } 
     225      
    214226     tofich (filecommon, ligne,1); 
    215227  } 
    216228  Save_Length(ligne,45); 
     229   
    217230} 
    218231 
     
    227240      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    228241      { 
    229          writevardeclaration(parcours,fortranout,0); 
     242         writevardeclaration(parcours,fortranout,0,1); 
    230243      } 
    231244      parcours = parcours -> suiv; 
     
    233246} 
    234247 
    235 void WriteFunctionDeclaration() 
     248void WriteFunctionDeclaration(int value) 
    236249{ 
    237250   listvar *parcours; 
     
    244257         ) 
    245258      { 
    246          writevardeclaration(parcours,fortranout,0); 
     259         writevardeclaration(parcours,fortranout,value,1); 
    247260      } 
    248261      parcours = parcours -> suiv; 
     
    259272      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
    260273           parcours->var->v_save == 0                                  && 
    261            parcours->var->v_allocatable == 0                           && 
     274          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      && 
    262275           parcours->var->v_pointerdeclare == 0                        && 
    263276           parcours->var->v_VariableIsParameter == 0                   && 
     
    265278         ) 
    266279      { 
    267          writevardeclaration(parcours,fortranout,value); 
     280         writevardeclaration(parcours,fortranout,value,1); 
     281 
    268282      } 
    269283      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 
     
    273287              ) 
    274288      { 
    275          writevardeclaration(parcours,fortranout,value); 
     289         writevardeclaration(parcours,fortranout,value,1); 
     290 
    276291      } 
    277292      parcours = parcours -> suiv; 
     
    303318      { 
    304319         position = position + 1; 
    305          writevardeclaration(newvar,fortranout,0); 
     320 
     321         writevardeclaration(newvar,fortranout,0,1); 
    306322         neededparameter = writedeclarationintoamr(List_Parameter_Var, 
    307323                   paramtoamr,newvar->var,newvar->var->v_subroutinename, 
     
    331347      { 
    332348         position = position + 1; 
    333          writevardeclaration(newvar,fortranout,1); 
     349 
     350         writevardeclaration(newvar,fortranout,1,1); 
    334351         /*                                                                   */ 
    335352         newvar = List_SubroutineArgument_Var; 
     
    346363         ) 
    347364      { 
    348          writevardeclaration(newvar,fortranout,1); 
     365 
     366         writevardeclaration(newvar,fortranout,1,1); 
    349367      } 
    350368      newvar = newvar -> suiv; 
     
    359377         ) 
    360378      { 
    361          writevardeclaration(newvar,fortranout,1); 
     379         writevardeclaration(newvar,fortranout,1,1); 
    362380      } 
    363381      newvar = newvar -> suiv; 
     
    454472        changeval = 0; 
    455473        v = newvar->var; 
    456         if ( v->v_allocatable == 1 ) 
     474        if ( v->v_allocatable == 1 && strcasecmp(v->v_typevar,"type") ) 
    457475        { 
    458476           changeval = 1; 
    459477           v->v_allocatable = 0; 
    460478        } 
    461         WriteBeginDeclaration(v,ligne); 
     479        WriteBeginDeclaration(v,ligne,1); 
    462480        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); 
    463481        else WriteTableDeclaration(v,ligne,1); 
     
    509527     if ( newvar->var->v_nbdim == 0 && 
    510528          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  && 
    511            newvar->var->v_allocatable == 0                           && 
     529          (newvar->var->v_allocatable == 0  || !strcasecmp(newvar->var->v_typevar,"type"))      && 
    512530           newvar->var->v_pointerdeclare == 0 
    513531         ) 
     
    515533        v = newvar->var; 
    516534 
    517         WriteBeginDeclaration(v,ligne); 
     535        WriteBeginDeclaration(v,ligne,1); 
    518536        WriteScalarDeclaration(v,ligne); 
    519537        tofich (fileout, ligne,1); 
     
    549567     if ( newvar->var->v_nbdim != 0                                 && 
    550568          !strcasecmp(newvar->var->v_subroutinename,subroutinename) && 
    551           newvar->var->v_allocatable == 0                           && 
     569          (newvar->var->v_allocatable == 0  || !strcasecmp(newvar->var->v_typevar,"type"))      && 
    552570          newvar->var->v_pointerdeclare == 0 
    553571        ) 
     
    555573        changeval = 0; 
    556574        v = newvar->var; 
    557         if ( v->v_allocatable == 1 ) 
     575        if ( v->v_allocatable == 1) 
    558576        { 
     577          if (strcasecmp(v->v_typevar,"type")) 
     578           { 
    559579           changeval = 1; 
    560580           v->v_allocatable = 0; 
     581           } 
     582          else 
     583           { 
     584           changeval = 2; 
     585           v->v_allocatable = 0; 
     586           v->v_pointerdeclare = 1; 
     587           } 
    561588        } 
    562         WriteBeginDeclaration(v,ligne); 
     589 
     590        WriteBeginDeclaration(v,ligne,1); 
    563591        WriteTableDeclaration(v,ligne,1); 
    564592        tofich (fileout, ligne,1); 
    565         if ( changeval == 1 ) v->v_allocatable = 1; 
     593        if ( changeval >= 1 ) v->v_allocatable = 1; 
     594        if ( changeval == 2 ) v->v_pointerdeclare = 0; 
    566595     } 
    567596     newvar = newvar->suiv; 
     
    569598  Save_Length(ligne,45); 
    570599} 
     600 
     601 
     602void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl) 
     603{ 
     604listvar *parcours; 
     605listvar *parcours2; 
     606listvar *parcours3; 
     607int out; 
     608 
     609if (insubroutinedeclare == 1) 
     610{ 
     611parcours = listdecl; 
     612while (parcours) 
     613{ 
     614/* 
     615parcours2 = List_SubroutineArgument_Var; 
     616out = 0; 
     617while (parcours2 && out == 0) 
     618{ 
     619if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
     620 { 
     621 out = 1; 
     622 } 
     623parcours2 = parcours2->suiv; 
     624} 
     625*/ 
     626out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var); 
     627if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var); 
     628if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var); 
     629if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var); 
     630 
     631/* 
     632parcours2 = List_Common_Var; 
     633while (parcours2 && out == 0) 
     634{ 
     635if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar)) 
     636 { 
     637 out = 1; 
     638 } 
     639parcours2 = parcours2->suiv; 
     640} 
     641*/ 
     642//printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare); 
     643if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)  
     644 
     645{ 
     646writevardeclaration(parcours,fortranout,1,1); 
     647} 
     648//if (firstpass == 1 && out == 1) 
     649if (firstpass == 1) 
     650  { 
     651  if (VariableIsParameter == 0 && SaveDeclare == 0) 
     652    { 
     653    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var); 
     654    } 
     655  } 
     656parcours = parcours->suiv; 
     657} 
     658} 
     659} 
  • trunk/AGRIF/LIB/convert.y

    r774 r1200  
    8989   listnom *parcours; 
    9090   listvar *newvar; 
     91   int stylegiven = 0; 
     92   int infreegiven ; 
     93   int infixedgiven ; 
     94   int lengthmainfile; 
    9195 
    9296   if (argc < 2) 
     
    9599       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n"); 
    96100       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n"); 
     101       printf(" [-free|-fixed]\n"); 
    97102       exit(0); 
    98103   } 
     
    122127   tmpuselocallist = (listusemodule *)NULL; 
    123128   List_ContainsSubroutine = (listnom *)NULL; 
     129   oldfortranout = (FILE *)NULL; 
    124130 
    125131   strcpy(mainfile,argv[1]); 
     
    185191   value_char_size2 = 0 ; 
    186192   value_char_size3 = 0 ; 
     193   inallocate = 0; 
     194   infixed = 1; 
     195   infree  = 0; 
    187196 
    188197   checkexistcommon=1; 
     
    235244         strcpy(filetoparse,argv[i+1]); 
    236245         i++; 
    237       } 
     246         lengthmainfile = strlen(filetoparse); 
     247         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90")) 
     248         { 
     249         infixed = 0; 
     250         infree = 1; 
     251         } 
     252         else 
     253         { 
     254         infixed = 1; 
     255         infree = 0; 
     256         } 
     257      } 
     258      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */ 
     259      { 
     260         stylegiven = 1; 
     261         infreegiven  = 1 ; 
     262         infixedgiven = 0; 
     263      }    
     264      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */ 
     265      { 
     266         stylegiven = 1; 
     267         infreegiven  = 0; 
     268         infixedgiven = 1; 
     269      }          
    238270      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */ 
    239271      { 
     
    268300   } 
    269301 
     302   if (stylegiven == 1)  
     303   { 
     304   infree = infreegiven; 
     305   infixed = infixedgiven;    
     306   } 
    270307   Save_Length(nomdir,34); 
    271308   Save_Length(commondirout,35); 
  • trunk/AGRIF/LIB/decl.h

    r774 r1200  
    3333/* version 1.7                                                                */ 
    3434/******************************************************************************/ 
    35 #define LONGNOM 800 
    36  
    37 #define LONG_C 300 
    38 #define LONG_4C 400 
     35#define LONGNOM 8000 
     36 
     37#define LONG_C 3000 
     38#define LONG_4C 4000 
    3939#define LONG_4M 4000 
    4040#define LONG_40M 40000 
     
    258258 char DeclType[LONG_C]; 
    259259 char nameinttypename[LONG_C]; 
     260 char nameinttypenameback[LONG_C];  
    260261 int GlobalDeclaration; 
    261262 char InitValue[LONG_4C]; 
     
    339340 long int pos_curcall;     /* current position in the output file             */ 
    340341 long int pos_curuse;      /* current position in the output file             */ 
     342 long int pos_curuseold;   /* current position in the output file             */ 
    341343 long int pos_curfunction; /* current position in the output file             */ 
    342344 long int pos_cur_decl;    /* current position in the output file             */ 
     
    433435 int value_char_size3; 
    434436 
     437  
     438 int inallocate; 
     439 int infixed; 
     440 int infree; 
    435441/******************************************************************************/ 
    436442/*********** Declaration of externals subroutines *****************************/ 
     
    520526extern int Vartonumber(char *tokname); 
    521527extern int Agrif_in_Tok_NAME(char *tokname); 
    522 extern void ModifyTheVariableName_0(char *ident); 
     528extern void ModifyTheVariableName_0(char *ident,int lengthname); 
    523529extern void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod); 
    524530extern void AddUseAgrifUtil_0(FILE *fileout); 
     
    547553extern FILE * associateaplus (char *filename); 
    548554extern long int setposcur(); 
     555extern long int setposcurname(FILE *fileout); 
    549556extern long int setposcurinoldfortranout(); 
    550557extern void copyuse_0(char *namemodule); 
     
    559566extern int VariableIsInList(listvar *curvar,listvar *listin); 
    560567extern void variableisglobalinmodule(listcouple *listin, char *module, 
    561                                                                  FILE *fileout); 
     568                                                                 FILE *fileout,long int oldposcuruse); 
    562569extern void Remove_Word_Contains_0(); 
    563 extern void Remove_Word_end_module_0(); 
     570extern void Remove_Word_end_module_0(int modulenamelength); 
    564571extern void Write_Word_Contains_0(); 
    565572extern void Write_Word_end_module_0(); 
     
    568575extern void Write_Alloc_Subroutine_For_End_0(); 
    569576extern void Write_GlobalParameter_Declaration_0(); 
     577extern void Write_GlobalType_Declaration_0(); 
    570578extern void Write_NotGridDepend_Declaration_0(); 
    571579extern int IsTabvarsUseInArgument_0(); 
     
    575583extern int varispointer_0(char *ident); 
    576584extern int VariableIsNotFunction(char *ident); 
     585extern int varistyped_0(char *ident); 
    577586/******************************************************************************/ 
    578587/*********** UtilListe.c ******************************************************/ 
     
    589598extern listvar * insertvar(listvar *lin,variable *v); 
    590599extern listvar *settype(char *nom,listvar *lin); 
     600extern void printliste(listvar * lin); 
     601extern int IsinListe(listvar *lin,char *nom); 
     602extern listname *Insertname(listname *lin,char *nom); 
     603extern void printname(listname * lin); 
     604extern void removeglobfromlist(listname **lin); 
     605extern void writelistpublic(listname *lin); 
    591606/******************************************************************************/ 
    592607/*********** UtilNotGridDep.c *************************************************/ 
     
    605620extern void Add_Globliste_1(listvar *listtoadd); 
    606621extern void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd); 
     622extern void checkandchangedims(listvar *listsecondpass); 
    607623/******************************************************************************/ 
    608624/*********** WorkWithlistdatavariable.c ***************************************/ 
     
    678694/*********** Writedeclarations.c **********************************************/ 
    679695/******************************************************************************/ 
    680 extern void WriteBeginDeclaration(variable *v,char ligne[LONG_4C]); 
     696extern void WriteBeginDeclaration(variable *v,char ligne[LONG_4C],int visibility); 
    681697extern void WriteScalarDeclaration(variable *v,char ligne[LONG_4C]); 
    682698extern void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok); 
    683699extern void writevardeclaration (listvar * var_record, FILE *fileout, 
    684                                                                      int value); 
     700                                                                     int value,int visibility); 
    685701extern void WriteLocalParamDeclaration(); 
    686 extern void WriteFunctionDeclaration(); 
     702extern void WriteFunctionDeclaration(int value); 
    687703extern void WriteSubroutineDeclaration(int value); 
    688704extern void WriteArgumentDeclaration_beforecall(); 
     
    694710                                                                 FILE *fileout); 
    695711extern void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout); 
     712extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl); 
    696713/******************************************************************************/ 
    697714/*********** WriteInFile.c ****************************************************/ 
     
    705722extern void RemoveWordCUR_0(FILE * filout, long int position, 
    706723                                                         long int sizetoremove); 
     724 
     725/******************************************************************************/ 
     726/*********** WorkWithlistofcoupled.c **********************************************/ 
     727/******************************************************************************/                                                         
     728extern int variscoupled_0(char *ident) ; 
     729extern char * getcoupledname_0(char *ident); 
     730extern void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident); 
  • trunk/AGRIF/LIB/fortran.c

    r774 r1200  
    5353char c_selectorname[LONG_C]; 
    5454char ligne[LONG_C]; 
     55char truename[LONGNOM]; 
    5556char identcopy[LONG_C]; 
    5657int c_selectorgiven=0; 
     
    6263int removeline=0; 
    6364listvar *test; 
    64 #line 56 "fortran.y" 
     65#line 57 "fortran.y" 
    6566typedef union { 
    6667       char      nac[LONG_C]; 
     
    7071       listnom  *ln; 
    7172       listcouple  *lc; 
     73       listname *lnn; 
    7274       typedim   dim1; 
    7375       variable *v; 
    7476       } YYSTYPE; 
    75 #line 76 "y.tab.c" 
     77#line 78 "y.tab.c" 
    7678#define TOK_BINARY_OP 257 
    77 #define EQV 258 
    78 #define NEQV 259 
     79#define TOK_EQV 258 
     80#define TOK_NEQV 259 
    7981#define TOK_OR 260 
    8082#define TOK_XOR 261 
     
    9294#define TOK_DASTER 273 
    9395#define TOK_SEP 274 
    94 #define TOK_NEXTLINE 275 
    95 #define TOK_PARAMETER 276 
    96 #define TOK_RESULT 277 
    97 #define TOK_ONLY 278 
    98 #define TOK_INCLUDE 279 
    99 #define TOK_SUBROUTINE 280 
    100 #define TOK_PROGRAM 281 
    101 #define TOK_FUNCTION 282 
    102 #define TOK_OMP 283 
    103 #define TOK_DOLLAR 284 
    104 #define TOK_FORMAT 285 
    105 #define TOK_MAX 286 
    106 #define TOK_TANH 287 
    107 #define TOK_WHERE 288 
    108 #define TOK_ELSEWHERE 289 
    109 #define TOK_ENDWHERE 290 
    110 #define TOK_MAXVAL 291 
    111 #define TOK_TRIM 292 
    112 #define TOK_SUM 293 
    113 #define TOK_SQRT 294 
    114 #define TOK_CASE 295 
    115 #define TOK_SELECTCASE 296 
    116 #define TOK_FILE 297 
    117 #define TOK_END 298 
    118 #define TOK_ERR 299 
    119 #define TOK_DONOTTREAT 300 
    120 #define TOK_ENDDONOTTREAT 301 
    121 #define TOK_EXIST 302 
    122 #define TOK_MIN 303 
    123 #define TOK_INT 304 
     96#define TOK_SEMICOLON 275 
     97#define TOK_NEXTLINE 276 
     98#define TOK_PARAMETER 277 
     99#define TOK_RESULT 278 
     100#define TOK_ONLY 279 
     101#define TOK_INCLUDE 280 
     102#define TOK_SUBROUTINE 281 
     103#define TOK_PROGRAM 282 
     104#define TOK_FUNCTION 283 
     105#define TOK_OMP 284 
     106#define TOK_DOLLAR 285 
     107#define TOK_FORMAT 286 
     108#define TOK_MAX 287 
     109#define TOK_TANH 288 
     110#define TOK_WHERE 289 
     111#define TOK_ELSEWHERE 290 
     112#define TOK_ENDWHERE 291 
     113#define TOK_MAXVAL 292 
     114#define TOK_TRIM 293 
     115#define TOK_SUM 294 
     116#define TOK_SQRT 295 
     117#define TOK_CASE 296 
     118#define TOK_SELECTCASE 297 
     119#define TOK_FILE 298 
     120#define TOK_END 299 
     121#define TOK_ERR 300 
     122#define TOK_DONOTTREAT 301 
     123#define TOK_ENDDONOTTREAT 302 
     124#define TOK_EXIST 303 
     125#define TOK_MIN 304 
    124126#define TOK_FLOAT 305 
    125127#define TOK_EXP 306 
     
    246248#define YYERRCODE 256 
    247249short fortranlhs[] = {                                        -1, 
    248     0,    0,   65,   65,   65,   65,   65,   68,   68,   73, 
    249    73,   73,   73,   73,   79,   75,   69,   69,   69,   69, 
    250    66,   67,   67,   70,   70,   80,   72,   81,   81,   74, 
    251    74,   74,   74,   74,   74,   16,   71,   77,   33,    6, 
    252     6,    6,   82,   82,   82,    5,    5,   37,   37,   76, 
    253    76,   76,   76,   76,   76,   76,   76,   76,   76,   76, 
    254    76,   76,   76,   76,   76,   76,   76,   76,   76,   76, 
    255    83,   83,  102,  102,  102,  102,  102,  102,  102,  102, 
    256   102,  102,  102,  102,  102,  102,  102,  102,  102,  102, 
    257   102,  102,  102,  102,  102,  102,   97,   97,   85,   85, 
    258    98,   98,  104,  105,  105,  103,  103,   84,   84,    2, 
    259     2,  107,   86,   99,  100,  100,  100,   57,   57,   88, 
    260    88,   88,   88,  110,  111,  111,  109,  109,  109,   46, 
    261    46,   46,   46,   46,   32,   32,   95,  112,  112,  112, 
    262   112,  113,   94,   94,  114,    3,    3,   91,   91,   90, 
    263    90,   96,   96,   87,   87,   87,  116,  116,  117,  117, 
    264   118,   15,   15,  108,  108,    4,    4,   14,   93,  119, 
    265   119,   89,   89,  120,    1,    1,  106,   19,   19,   19, 
    266    19,  126,  125,  125,  125,  125,  128,  128,  128,  124, 
    267    25,   24,   24,   24,   24,   24,   24,  115,  115,   64, 
    268    64,  123,  123,  123,  130,  130,  127,  127,  127,  127, 
    269    36,   36,  129,  129,  121,  121,  121,  131,  131,  132, 
     250    0,    0,   68,   68,   68,   68,   68,   71,   71,   76, 
     251   76,   76,   76,   76,   82,   78,   72,   72,   72,   72, 
     252   69,   70,   70,   73,   73,   83,   75,   84,   84,   77, 
     253   77,   77,   77,   77,   77,   16,   74,   80,   33,    6, 
     254    6,    6,   85,   85,   85,    5,    5,   38,   38,   79, 
     255   79,   79,   79,   79,   79,   79,   79,   79,   79,   79, 
     256   79,   79,   79,   79,   79,   79,   79,   79,   79,   79, 
     257   86,   86,  103,  103,  103,  103,  103,  103,  103,  103, 
     258  103,  103,  103,  103,  103,  103,  103,  103,  103,  103, 
     259  103,  103,  103,  103,  103,  103,   98,   98,   88,   88, 
     260   99,   99,  105,  106,  106,  104,  104,   87,   87,    2, 
     261    2,  108,   89,  100,  101,  101,  101,   58,   58,   91, 
     262   91,   91,   91,  111,  112,  112,  110,  110,  110,   47, 
     263   47,   47,   47,   47,   32,   32,   97,  113,  113,  113, 
     264  113,  114,   96,   96,  115,    3,    3,   93,   93,   67, 
     265   67,   66,   66,   90,   90,   90,  117,  117,  118,  118, 
     266  119,   15,   15,  109,  109,    4,    4,   14,   95,  120, 
     267  120,   92,   92,  121,    1,    1,  107,   19,   19,   19, 
     268   19,  127,  126,  126,  126,  126,  128,  128,  128,  125, 
     269   25,   24,   24,   24,   24,   24,   24,  116,  116,   65, 
     270   65,  124,  124,  124,  130,  130,   34,   34,   34,   34, 
     271   37,   37,  129,  129,  122,  122,  122,  131,  131,  132, 
    270272  132,  132,  132,  132,  132,  132,  132,  132,  132,  132, 
    271    30,   30,   30,  101,  101,   11,   11,   12,   12,   13, 
    272    13,   13,   13,   13,   62,   62,   61,   61,   61,   61, 
    273    60,   60,   60,   60,   60,   60,   60,   60,   60,   60, 
    274    60,   60,   60,   60,   60,   60,   60,   60,   60,   60, 
    275    60,   60,   60,   60,   60,   60,   60,   39,   39,   38, 
    276    38,   38,   38,   38,   38,   31,   31,   63,   63,   63, 
    277    63,   63,   63,   63,   63,   63,   63,   63,   63,   63, 
    278    63,   63,   63,   63,   63,   63,   58,   58,   58,   58, 
    279    59,   59,   40,   40,   40,  133,   48,   48,   48,   48, 
    280    35,   47,   41,   49,   49,   51,   51,   50,   50,   52, 
    281    52,   52,   52,   52,   52,   52,   28,   27,   27,   27, 
    282    27,   27,   27,   27,   27,   26,   26,   26,   26,   54, 
    283    54,   53,   56,   56,   55,   55,  122,  122,  134,   34, 
    284    92,   92,   92,   92,  135,   17,    9,    9,   10,    7, 
    285     7,    8,    8,   78,   78,   78,   78,   78,   78,   78, 
    286    78,   78,   78,   78,   78,   78,   78,   78,   78,   78, 
    287    78,   78,   78,   78,   78,   78,   20,   23,   22,   21, 
    288   143,  143,  143,  141,  141,  141,  146,  146,  146,  145, 
    289   145,   18,   18,  148,  148,  144,  147,  149,  149,  136, 
     273   30,   30,   30,  102,  102,   11,   11,   12,   12,   13, 
     274   13,   13,   13,   13,   63,   63,   62,   62,   62,   62, 
     275   61,   61,   61,   61,   61,   61,   61,   61,   61,   61, 
     276   61,   61,   61,   61,   61,   61,   61,   61,   61,   61, 
     277   61,   61,   61,   61,   61,   61,   40,   40,   39,   39, 
     278   39,   39,   39,   39,   31,   31,   64,   64,   64,   64, 
     279   64,   64,   64,   64,   64,   64,   64,   64,   64,   64, 
     280   64,   64,   64,   64,   64,   64,   64,   59,   59,   59, 
     281   59,   60,   60,   41,   41,   41,  133,   49,   49,   49, 
     282   49,   36,   48,   42,   50,   50,   52,   52,   51,   51, 
     283   53,   53,   53,   53,   53,   53,   53,   28,   27,   27, 
     284   27,   27,   27,   27,   27,   27,   26,   26,   26,   26, 
     285   55,   55,   54,   57,   57,   56,   56,  123,  123,  134, 
     286   35,   94,   94,   94,   94,  135,   17,    9,    9,   10, 
     287    7,    7,    8,    8,   81,   81,   81,   81,   81,   81, 
     288   81,   81,   81,   81,   81,   81,   81,   81,   81,   81, 
     289   81,   81,   81,   81,   81,   81,   81,   20,   23,   22, 
     290   21,  143,  143,  143,  141,  141,  141,  146,  146,  146, 
     291  145,  145,   18,   18,  148,  148,  144,  147,  149,  149, 
    290292  136,  136,  136,  136,  136,  136,  136,  136,  136,  136, 
    291   136,  157,  150,  150,  156,  156,  151,  151,  154,  159, 
    292   159,  160,  160,  158,  162,  161,  161,  163,  163,  155, 
    293   155,  153,  153,  153,  153,  170,  170,  171,  171,  171, 
    294   172,  172,  173,  173,  168,  168,  177,  177,  176,  176, 
    295   166,  166,  169,  169,  169,  169,  169,  178,  178,  180, 
    296   180,  180,  180,  180,  180,  180,  180,  165,  165,  175, 
    297   175,  167,  167,  167,  167,  179,  179,  181,  181,  181, 
    298   181,  181,  181,  181,  181,  181,  181,  181,  181,  181, 
    299   182,  182,  174,  174,  184,  184,  183,  183,  183,  183, 
    300   183,  185,  185,  185,   42,   42,   43,   43,   43,   43, 
    301    43,   43,   43,   43,   44,   44,   44,   44,   44,   45, 
    302    45,  186,  186,  164,  152,  152,  137,  137,  137,  187, 
    303   187,  187,  188,  189,  189,  139,  139,  138,  138,  140, 
    304   140,  190,  190,  191,  191,  142,   29, 
     293  136,  136,  157,  150,  150,  156,  156,  151,  151,  154, 
     294  159,  159,  160,  160,  158,  162,  161,  161,  163,  163, 
     295  155,  155,  153,  153,  153,  153,  153,  153,  171,  171, 
     296  172,  172,  172,  173,  173,  174,  174,  168,  168,  178, 
     297  178,  177,  177,  166,  166,  170,  170,  170,  170,  170, 
     298  179,  179,  181,  181,  181,  181,  181,  181,  181,  181, 
     299  165,  165,  176,  176,  167,  167,  167,  169,  180,  180, 
     300  182,  182,  182,  182,  182,  182,  182,  182,  182,  182, 
     301  182,  182,  182,  183,  183,  175,  175,  185,  185,  184, 
     302  184,  184,  184,  184,  186,  186,  186,   43,   43,   43, 
     303   44,   44,   44,   44,   44,   44,   44,   44,   45,   45, 
     304   45,   45,   45,   46,   46,  187,  187,  164,  152,  152, 
     305  137,  137,  137,  188,  188,  188,  189,  190,  190,  139, 
     306  139,  138,  138,  140,  140,  191,  191,  192,  192,  142, 
     307   29, 
    305308}; 
    306309short fortranlen[] = {                                         2, 
     
    332335    3,    3,    4,    4,    3,    4,    4,    3,    4,    4, 
    333336    4,    4,    4,    4,    4,    4,    4,    4,    4,    4, 
    334     4,    4,    3,    4,    4,    4,    4,    1,    3,    1, 
    335     1,    1,    2,    2,    2,    1,    1,    2,    2,    2, 
     337    4,    3,    4,    4,    4,    4,    1,    3,    1,    1, 
     338    1,    2,    2,    2,    1,    1,    2,    2,    2,    2, 
    336339    2,    2,    2,    2,    2,    2,    2,    3,    2,    3, 
    337     2,    2,    2,    2,    2,    2,    0,    1,    2,    2, 
    338     2,    1,    1,    1,    1,    0,    1,    2,    4,    5, 
    339     4,    3,    3,    1,    2,    1,    3,    1,    1,    3, 
    340     5,    4,    3,    2,    2,    1,    1,    1,    1,    1, 
    341     1,    1,    1,    2,    2,    1,    2,    1,    1,    0, 
    342     1,    5,    0,    1,    1,    1,    0,    3,    0,    5, 
    343     2,    4,    6,    6,    1,    1,    1,    3,    3,    1, 
    344     3,    3,    1,    1,    5,    5,    4,    1,    2,    2, 
    345     2,    2,    1,    2,    5,    1,    1,    2,    5,    1, 
    346     2,    3,    4,    1,    1,    1,    1,    1,    1,    1, 
    347     1,    3,    3,    3,    2,    2,    0,    5,    7,    0, 
    348     2,    1,    1,    0,    1,    1,    1,    0,    1,    1, 
    349     2,    1,    1,    1,    5,    5,    2,    2,    2,    2, 
    350     1,    0,    4,    6,    1,    3,    2,    2,    2,    0, 
    351     3,    0,    1,    2,    1,    1,    3,    1,    2,    1, 
    352     1,    2,    2,    2,    1,    0,    2,    1,    1,    1, 
    353     0,    2,    0,    1,    2,    2,    0,    1,    0,    2, 
    354     3,    3,    3,    3,    1,    3,    1,    1,    3,    1, 
    355     1,    1,    2,    4,    4,    2,    2,    1,    1,    1, 
    356     1,    1,    1,    1,    1,    1,    3,    1,    1,    3, 
    357     3,    3,    3,    2,    3,    2,    2,    2,    2,    3, 
    358     1,    1,    1,    3,    0,    1,    2,    4,    2,    2, 
    359     5,    0,    1,    2,    1,    1,    3,    3,    3,    3, 
    360     3,    3,    1,    1,    1,    3,    5,    5,    5,    5, 
    361     7,    1,    3,    1,    8,    2,    1,    1,    3,    1, 
    362     1,    1,    4,    1,    3,    1,    3,    0,    4,    1, 
    363     3,    0,    1,    0,    2,    3,    1, 
     340    2,    2,    2,    2,    2,    2,    2,    0,    1,    2, 
     341    2,    2,    1,    1,    1,    1,    0,    1,    2,    4, 
     342    5,    4,    3,    3,    1,    2,    1,    3,    1,    1, 
     343    3,    5,    4,    3,    2,    2,    1,    1,    1,    1, 
     344    1,    1,    1,    1,    2,    2,    1,    2,    1,    1, 
     345    0,    1,    5,    0,    1,    1,    1,    0,    3,    0, 
     346    5,    2,    4,    6,    6,    1,    1,    1,    3,    3, 
     347    1,    3,    3,    1,    1,    5,    5,    4,    1,    2, 
     348    2,    2,    2,    1,    2,    5,    1,    1,    2,    5, 
     349    1,    2,    3,    4,    1,    1,    1,    1,    1,    1, 
     350    1,    1,    3,    3,    3,    2,    2,    0,    5,    7, 
     351    0,    2,    1,    1,    0,    1,    1,    1,    0,    1, 
     352    1,    2,    1,    1,    1,    5,    5,    2,    2,    2, 
     353    2,    1,    0,    4,    6,    1,    3,    2,    2,    2, 
     354    0,    3,    0,    1,    2,    1,    1,    3,    1,    2, 
     355    1,    1,    2,    2,    2,    3,    2,    1,    0,    2, 
     356    1,    1,    1,    0,    2,    0,    1,    2,    2,    0, 
     357    1,    0,    2,    3,    3,    3,    3,    1,    3,    1, 
     358    1,    3,    1,    1,    1,    2,    4,    4,    2,    2, 
     359    1,    1,    1,    1,    1,    1,    1,    1,    1,    3, 
     360    1,    1,    3,    3,    3,    3,    2,    3,    2,    2, 
     361    2,    2,    3,    1,    1,    1,    3,    0,    1,    2, 
     362    4,    2,    2,    5,    0,    1,    2,    1,    1,    1, 
     363    3,    3,    3,    3,    3,    3,    1,    1,    1,    3, 
     364    5,    5,    5,    5,    7,    1,    3,    1,    8,    2, 
     365    1,    1,    3,    1,    1,    1,    4,    1,    3,    1, 
     366    3,    0,    4,    1,    3,    0,    1,    0,    2,    3, 
     367    1, 
    364368}; 
    365369short fortrandefred[] = {                                      1, 
    366370    0,   37,   19,   20,   17,   18,   27,    5,   21,    2, 
    367     0,    0,   27,   23,    3,  113,   38,    0,    0,  455, 
    368     0,  386,  387,    0,    0,    0,    0,    0,   29,    0, 
    369     0,    0,    0,    0,  390,    0,  495,    0,    0,  416, 
    370   396,    0,    0,    0,  417,    0,  488,  489,  493,  494, 
    371   492,    0,    0,    0,  145,  395,    0,    0,    0,  394, 
    372     0,  420,  124,    0,  445,  157,    0,    0,    0,  450, 
    373     0,  451,  365,    0,  182,    0,  193,  192,  197,  195, 
    374   397,  400,  399,  398,  190,  114,  194,  196,  337,  435, 
    375     0,    0,    0,    0,    0,  378,    0,    0,    0,    4, 
    376     0,   21,   21,    0,    0,   21,    0,    0,    0,    0, 
    377    58,   60,   61,   62,   63,   64,   65,    0,    0,    0, 
    378     0,    0,    0,    0,    0,  374,  383,    0,    0,    0, 
    379     0,  422,  423,  424,    0,    0,    0,    0,    0,    0, 
    380    25,   37,    7,   36,   32,    0,    0,    0,  286,  287, 
    381     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    382     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    383     0,    0,    0,    0,    0,    0,    0,  338,  339,    0, 
    384   346,  349,  348,  341,  342,  343,  340,    0,    0,    0, 
    385     0,    0,  249,    0,  247,    0,  282,    0,  315,  250, 
    386     0,    0,    0,  355,  429,    0,    0,    0,  101,    0, 
    387   427,    0,    0,  150,    0,  148,    0,  428,    0,  413, 
    388   412,  391,  544,    0,  546,    0,  415,  406,   35,  382, 
    389     0,  477,  475,    0,  454,    0,    0,    0,    0,  162, 
     371    0,    0,   27,   23,    3,  113,   38,    0,    0,  458, 
     372    0,  387,  388,    0,    0,    0,    0,    0,   29,    0, 
     373    0,    0,    0,    0,  391,    0,  497,    0,    0,  417, 
     374  397,    0,    0,    0,  418,    0,  491,  492,  496,  498, 
     375  495,    0,    0,    0,  145,  396,    0,    0,    0,  395, 
     376    0,  421,  124,    0,  446,  157,    0,    0,    0,  451, 
     377    0,  452,  366,    0,  182,    0,  193,  192,  197,  195, 
     378  398,  401,  400,  399,  190,  114,  194,  196,  338,  436, 
     379    0,    0,    0,    0,    0,  379,    0,    0,    0,   60, 
     380    0,    8,   21,   21,    0,    0,   21,    0,    0,    0, 
     381    0,   58,   61,   62,   63,   64,   65,    0,    0,    0, 
     382    0,    0,    0,    0,    0,  375,  384,    0,    0,    0, 
     383    0,  423,  424,  425,    0,    0,    0,    0,    0,    0, 
     384    0,   25,   37,    7,   36,   32,    0,    0,    0,  285, 
     385  286,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     386    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     387    0,    0,    0,    0,    0,    0,    0,  339,  340,    0, 
     388  347,  350,  349,  342,  343,  344,  341,    0,    0,    0, 
     389    0,    0,  249,    0,  247,    0,  281,    0,  316,  250, 
     390    0,    0,    0,  356,  430,    0,    0,    0,  101,    0, 
     391  428,    0,    0,  150,    0,  148,    0,  429,    0,  414, 
     392  413,  392,  548,    0,  550,    0,  416,  407,   35,  383, 
     393    0,  480,  478,    0,  457,    0,    0,    0,    0,  162, 
    390394    0,    0,  138,    0,    0,  172,  173,  158,  143,  144, 
    391395  170,    0,  234,  235,    0,   72,   52,    0,    0,    0, 
    392   112,    0,   50,    0,  174,  380,  381,  379,    0,    0, 
     396  112,    0,   50,    0,  174,  381,  382,  380,    0,    0, 
    393397    0,  178,   15,    0,    0,    0,   10,   11,   39,   21, 
    394398   37,   14,    0,    0,    0,    0,  166,  165,    0,    0, 
    395399    0,    0,    0,    0,    0,    0,  120,    0,    0,  137, 
    396400    0,    0,    0,    0,  159,    0,    0,  179,    0,  210, 
    397     0,  366,    0,  388,    0,    0,  432,  384,    0,    0, 
    398     0,    0,    0,    0,  421,  430,    0,    0,  439,  444, 
    399     0,  452,  511,  512,  491,    0,    0,    0,    0,    0, 
    400     0,    0,    0,    0,  453,    0,    0,    0,    0,    6, 
    401     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     401    0,  367,    0,  389,    0,    0,  433,  385,    0,    0, 
     402    0,    0,    0,    0,  422,  431,    0,    0,  440,  445, 
     403    0,  453,  514,  515,  494,    0,    0,    0,    0,    0, 
     404    0,    0,    0,    0,  454,    0,    0,    0,    0,    0, 
     405    6,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    402406    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    403407    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    404408    0,    0,  249,    0,    0,    0,    0,    0,    0,    0, 
    405     0,    0,  347,    0,  351,  345,  344,  316,    0,  318, 
    406     0,  316,    0,    0,    0,    0,    0,    0,    0,    0, 
    407     0,    0,    0,    0,    0,    0,    0,    0,    0,  283, 
    408     0,    0,  392,    0,    0,    0,    0,    0,  109,  152, 
    409     0,    0,    0,    0,  566,    0,    0,    0,    0,    0, 
    410   547,  552,    0,    0,    0,    0,    0,  556,  560,    0, 
    411     0,   74,   75,   78,   73,   79,   76,   81,   82,   83, 
    412    84,   85,   80,   86,   87,   88,   89,   90,   91,   92, 
    413    93,   94,   95,   77,   96,    0,   97,    0,  139,    0, 
    414     0,    0,    0,    0,    0,  220,  222,    0,  224,    0, 
    415   226,  227,  228,  229,  230,  221,    0,  218,  216,  174, 
    416   110,    0,    0,  180,    0,    0,  203,    0,    0,    0, 
    417     9,   16,   12,   13,    0,    0,    0,    0,    0,  123, 
    418     0,    0,    0,   70,    0,    0,    0,  126,  121,  141, 
    419     0,    0,  161,    0,    0,  184,    0,  212,    0,    0, 
    420     0,    0,    0,  207,  181,    0,    0,    0,  411,  567, 
    421     0,  404,    0,    0,  432,  436,    0,    0,    0,    0, 
    422   446,  481,  482,    0,    0,    0,    0,  478,  496,    0, 
    423     0,    0,    0,    0,    0,    0,    0,    0,    0,  465, 
    424     0,  513,    0,    0,  466,    0,    0,    0,    0,    0, 
    425     0,   49,   48,   41,    0,   46,    0,    0,    0,  252, 
    426     0,    0,    0,  251,  258,  255,    0,    0,    0,    0, 
    427     0,    0,    0,    0,    0,    0,    0,    0,    0,  273, 
    428     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    429   323,    0,    0,    0,    0,  248,    0,    0,    0,    0, 
     409    0,    0,  348,    0,  352,  346,  345,  317,    0,  319, 
     410    0,  317,    0,    0,    0,    0,    0,    0,    0,    0, 
     411    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     412    0,  282,    0,    0,  393,    0,    0,    0,    0,    0, 
     413  109,  152,    0,    0,    0,    0,  570,    0,    0,    0, 
     414    0,    0,  551,  556,    0,    0,    0,    0,    0,  560, 
     415  564,    0,    0,   74,   75,   78,   73,   79,   76,   81, 
     416   82,   83,   84,   85,   80,   86,   87,   88,   89,   90, 
     417   91,   92,   93,   94,   95,   77,   96,    0,   97,    0, 
     418  139,    0,    0,    0,    0,    0,    0,  220,  222,    0, 
     419  224,    0,  226,  227,  228,  229,  230,  221,    0,  218, 
     420  216,  174,  110,    0,    0,  180,    0,    0,  203,    0, 
     421    0,    0,    9,   16,   12,   13,    0,    0,    0,    0, 
     422    0,  123,    0,    0,    0,   70,    0,    0,    0,  126, 
     423  121,  141,    0,    0,  161,    0,    0,  184,    0,  212, 
     424    0,    0,    0,    0,    0,  207,  181,    0,    0,    0, 
     425  412,  571,    0,  405,    0,    0,  433,  437,    0,    0, 
     426    0,    0,  447,  484,  485,    0,    0,    0,    0,  481, 
     427  499,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     428    0,  468,    0,  516,    0,    0,  469,    0,    0,    0, 
     429    0,    0,    0,  456,   49,   48,   41,    0,   46,    0, 
     430    0,    0,  252,    0,    0,    0,  251,  258,  255,    0, 
     431    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     432    0,  272,    0,    0,    0,    0,    0,    0,    0,    0, 
     433    0,    0,  324,    0,    0,    0,    0,  248,    0,    0, 
     434    0,    0,    0,    0,  307,    0,    0,    0,    0,    0, 
     435    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    430436    0,    0,  306,    0,    0,    0,    0,    0,    0,    0, 
    431     0,    0,    0,    0,    0,    0,    0,    0,  305,    0, 
    432     0,    0,    0,    0,    0,    0,    0,  393,  104,    0, 
    433   103,  102,   66,    0,    0,    0,    0,    0,    0,  474, 
    434   473,  476,    0,    0,    0,  377,    0,  163,    0,   99, 
    435     0,  171,   51,    0,  223,    0,    0,    0,    0,  111, 
    436     0,    0,  204,    0,  245,    0,  238,    0,  240,  433, 
    437    31,    0,   54,  167,    0,    0,  136,    0,    0,    0, 
    438     0,    0,    0,  129,    0,    0,    0,  160,    0,    0, 
    439     0,    0,  189,  186,  208,    0,    0,    0,  367,    0, 
    440     0,    0,    0,  449,  441,    0,  486,  487,    0,    0, 
    441     0,    0,  471,  472,    0,    0,    0,  523,    0,    0, 
    442     0,    0,    0,    0,    0,    0,    0,    0,    0,   42, 
    443     0,   33,  385,    0,  253,  254,  257,  260,  262,  263, 
    444   264,  265,  266,  261,  267,  268,  269,  270,  271,  272, 
    445   274,  275,  276,  277,  256,    0,    0,    0,  248,  528, 
    446     0,  532,    0,  530,    0,  259,    0,    0,  321,    0, 
    447   326,    0,  329,    0,    0,    0,    0,    0,    0,    0, 
    448     0,  153,  389,    0,    0,    0,  549,  375,  557,  376, 
    449   561,   98,    0,    0,    0,  147,  232,  233,  231,    0, 
    450   219,  217,    0,    0,  206,    0,    0,  237,    0,    0, 
    451   122,    0,    0,    0,    0,    0,    0,  115,  128,    0, 
    452   117,  140,  146,  185,    0,  187,    0,    0,    0,    0, 
    453     0,    0,    0,    0,  447,    0,    0,    0,  497,    0, 
    454   479,    0,    0,  524,  514,   47,   44,    0,    0,    0, 
    455     0,    0,  360,    0,    0,    0,    0,    0,  320,  105, 
    456     0,  553,    0,  100,    0,    0,  199,  225,    0,    0, 
    457   239,    0,  244,  119,    0,    0,    0,    0,    0,  188, 
    458   214,    0,  363,    0,  370,  369,  368,  425,  426,    0, 
    459   434,  485,    0,    0,    0,   45,    0,  537,  539,  538, 
    460   352,    0,    0,  327,    0,    0,  559,    0,    0,  175, 
    461     0,  116,    0,    0,    0,  521,    0,    0,    0,    0, 
    462   201,  176,    0,  372,  371,    0,    0,    0,    0,    0, 
    463     0,    0,    0, 
     437    0,  394,  104,    0,  103,  102,   66,    0,    0,    0, 
     438    0,    0,    0,  477,  476,  479,    0,    0,    0,  378, 
     439    0,  163,    0,   99,    0,  171,   51,    0,  223,    0, 
     440    0,    0,    0,  111,    0,    0,  204,    0,  245,    0, 
     441  238,    0,  240,  434,   31,    0,   54,  167,    0,    0, 
     442  136,    0,    0,    0,    0,    0,    0,  129,    0,    0, 
     443    0,  160,    0,    0,    0,    0,  189,  186,  208,    0, 
     444    0,    0,  368,    0,    0,    0,    0,  450,  442,    0, 
     445  489,  490,    0,    0,    0,    0,  474,  475,    0,    0, 
     446    0,  526,    0,    0,    0,    0,    0,    0,    0,    0, 
     447    0,    0,    0,   42,    0,   33,  386,    0,  253,  254, 
     448  257,  261,  262,  263,  264,  265,  260,  266,  267,  268, 
     449  269,  270,  271,  273,  274,  275,  276,  256,    0,    0, 
     450    0,  248,  532,    0,  536,    0,  534,    0,  259,    0, 
     451    0,  322,    0,  327,    0,  330,    0,    0,    0,    0, 
     452    0,    0,    0,    0,  153,  390,    0,    0,    0,  553, 
     453  376,  561,  377,  565,   98,    0,    0,    0,  147,  232, 
     454  233,  231,    0,  219,  217,    0,    0,  206,    0,    0, 
     455  237,    0,    0,  122,    0,    0,    0,    0,    0,    0, 
     456  115,  128,    0,  117,  140,  146,  185,    0,  187,    0, 
     457    0,    0,    0,    0,    0,    0,    0,  448,    0,    0, 
     458    0,  500,    0,  482,    0,    0,  527,  517,   47,   44, 
     459    0,    0,    0,    0,    0,  361,    0,    0,    0,    0, 
     460    0,  321,  105,    0,  557,    0,  100,    0,    0,  199, 
     461  225,    0,    0,  239,    0,  244,  119,    0,    0,    0, 
     462    0,    0,  188,  214,    0,  364,    0,  371,  370,  369, 
     463  426,  427,    0,  435,  488,    0,    0,    0,   45,    0, 
     464  541,  543,  542,  353,    0,    0,  328,    0,    0,  563, 
     465    0,    0,  175,    0,  116,    0,    0,    0,  524,    0, 
     466    0,    0,    0,  201,  176,    0,  373,  372,    0,    0, 
     467    0,    0,    0,    0,    0,    0, 
    464468}; 
    465469short fortrandgoto[] = {                                       1, 
    466   262,  263,   91,  286,  595,  352,  924,  925,  738,  739, 
    467   510,  706,  707,  287,  242,  145,  313,  222,   92,   93, 
    468    94,   95,   96,   97,   98,  189,  190,  191,  551,  840, 
    469   192,  718,  280,  193,  194,  540,  596,  195,  355,  196, 
    470   197,  385,  386,  800,  890,  719,  198,  199,  638,  811, 
    471   812,  813,  395,  396,  205,  211,  720,  659,  643,  200, 
    472   356,  709,  420,  907,   10,  276,   11,  100,   12,  142, 
    473    13,   14,  101,  102,  277,  103,  104,  105,  106,    0, 
    474   107,  772,  255,  215,  245,  108,  109,  110,  111,  112, 
    475   113,  114,  115,  116,  117,  431,  476,  208,  118,  293, 
    476   496,  477,  481,  209,  426,  501,  264,  289,  294,  119, 
    477   297,  120,  300,  121,  836,  122,  304,  305,  252,  503, 
    478   265,  950,  272,  123,  308,  124,  311,  542,  733,  507, 
    479   497,  498,  639,  951,  125,  126,  439,  679,  447,  450, 
    480   127,  128,  202,  129,  320,  552,  130,  228,    0,  131, 
    481   325,  132,  133,  134,  135,  136,  274,  137,  329,  559, 
    482   560,  138,  561,  225,  139,  332,  140,  345,  235,    0, 
    483     0,    0,  580,  581,  346,  585,    0,  566,  347,  568, 
    484   569,  349,  582,  583,  759,    0,  441,  442,    0,    0, 
    485     0, 
     470  262,  263,   91,  286,  598,  353,  927,  928,  742,  743, 
     471  512,  710,  711,  287,  242,  146,  313,  222,   92,   93, 
     472   94,   95,   96,   97,   98,  189,  190,  191,  553,  843, 
     473  192,  722,  280,  311,  193,  194,  542,  599,  195,  356, 
     474  196,  197,  385,  386,  387,  893,  723,  198,  199,  640, 
     475  814,  815,  816,  395,  396,  205,  211,  724,  663,  645, 
     476  200,  357,  713,  422,  910,  433,  100,   10,  276,   11, 
     477  101,   12,  143,   13,   14,  102,  103,  277,  104,  105, 
     478  106,  107,    0,  108,  776,  255,  215,  245,  109,  110, 
     479  111,  112,  113,  114,  115,  116,  117,  478,  208,  118, 
     480  293,  498,  479,  483,  209,  428,  503,  264,  289,  294, 
     481  119,  297,  120,  300,  121,  839,  122,  304,  305,  252, 
     482  505,  265,  953,  272,  123,  308,  124,  544,  737,  509, 
     483  499,  500,  641,  954,  125,  126,  441,  683,  449,  452, 
     484  127,  128,  202,  129,  320,  554,  130,  228,    0,  131, 
     485  325,  132,  133,  134,  135,  136,  274,  137,  329,  561, 
     486  562,  138,  563,  225,  139,  332,  140,  345,  141,  235, 
     487    0,    0,    0,  582,  583,  346,  587,    0,  568,  347, 
     488  570,  571,  349,  584,  585,  763,    0,  443,  444,    0, 
     489    0,    0, 
    486490}; 
    487491short fortransindex[] = {                                      0, 
    488    23,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    489 25815, -367,    0,    0,    0,    0,    0, -320, -320,    0, 
    490   122,    0,    0, 7265,  127, 5708,  198,  203,    0, 7265, 
    491   105,  108, 5708,  210,    0,    3,    0,  -10, 7265,    0, 
    492     0, -227, -189,    3,    0,  218,    0,    0,    0,    0, 
    493     0,  -13,  227,  229,    0,    0,  194,  194, -116,    0, 
    494   235,    0,    0, -277,    0,    0,  -86,    3,    3,    0, 
    495  -126,    0,    0,  167,    0,    3,    0,    0,    0,    0, 
    496     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    497   253,   37,    3,    3,    3,    0,  260,   89,  268,    0, 
    498   279,    0,    0,  -29, -367,    0,  121,  -14,  363,  365, 
    499     0,    0,    0,    0,    0,    0,    0,    4,  -89,  379, 
    500   363,  -49,  131, -225,   10,    0,    0, 2476,    9, 7265, 
    501    22,    0,    0,    0, 5708,  406,  434,   95,  461, 5131, 
    502     0,    0,    0,    0,    0,  476, 7265, 7265,    0,    0, 
    503  7265,  482,  501,  530, 7265, 7265, 7265,  531,  541,  542, 
    504   555,  572,  574,  582,  589,  591,  619,  634,  647,  651, 
    505  7265,  652,  656,  661,  662,  673, 7784,    0,    0,  688, 
    506     0,    0,    0,    0,    0,    0,    0, 7265,   -6,  112, 
    507   708, 7265,    0,  709,    0,  583,    0,  710,    0,    0, 
    508  2572,  117, 7265,    0,    0, 2572,  309,  641,    0, 7265, 
    509     0, 2572,  694,    0,  341,    0,  341,    0, 7265,    0, 
    510     0,    0,    0, 7265,    0, 3642,    0,    0,    0,    0, 
    511   309,    0,    0, 8303,    0,  309,  309,  341, 3655,    0, 
    512   342,  309,    0, 7265,  716,    0,    0,    0,    0,    0, 
    513     0,  717,    0,    0,  194,    0,    0,  346,  453,  711, 
    514     0,  723,    0, -320,    0,    0,    0,    0,  344, 8822, 
    515  -225,    0,    0,  730,25815, -367,    0,    0,    0,    0, 
    516     0,    0, -320,  718,  354,  734,    0,    0,  234,  368, 
    517   234,   -2,   55,   28,  730,  368,    0,  309,  234,    0, 
    518   370,  730,  371,  745,    0,   -8,23686,    0,23298,    0, 
    519   749,    0,  747,    0,  762,  763,    0,    0,  363,  309, 
    520  2572, 7265, 7265,  309,    0,    0,  382,23815,    0,    0, 
    521   478,    0,    0,    0,    0, 7265, 7265, 7265, 7265,  754, 
    522   478,  112,  583, 1955,    0,  765,  493,    0,  287,    0, 
    523    12,  545,24724, 3819,   75, 2572, 7265, 7265, 7265,   84, 
    524 24798,  172, 7265, 7265, 7265, 7265, 7265, 7265, 7265, 7265, 
    525  7265, 7265, 7265, 7265, 7265,24850, 7265, 7265, 7265, 7265, 
    526  7265, 7784,    0,  772,  439,  780,  782,    0, 2572, 7265, 
    527   788,24884,    0, 7265,    0,    0,    0,    0, 2572,    0, 
    528   309,    0,23975, 7265, 7265, 7265, 7265, 7265, 7265, 7265, 
    529  7265, 7265, 7265, 7265, 7265,23346, 7265,24023,24152,    0, 
    530  7265, 7265,    0,24898,  730,  224,  198,24957,    0,    0, 
    531   789,  789,24971,25560,    0,  794,  583,  710,  791,  799, 
    532     0,    0,  796,  515,  797,  794,  795,    0,    0,  246, 
    533   789,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    534     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    535     0,    0,    0,    0,    0,  798,    0,  576,    0, 2572, 
    536   330,  801,  427,    3,  730,    0,    0,  730,    0,  815, 
    537     0,    0,    0,    0,    0,    0,   63,    0,    0,    0, 
    538     0,  476,  442,    0,24200, 2572,    0,  819,23475,  730, 
    539     0,    0,    0,    0,  476, 7265,  364,  354,  363,    0, 
    540   363,  160, 7265,    0,  444,  446,  160,    0,    0,    0, 
    541   363,  730,    0,  745,  371,    0,23686,    0,23638,  812, 
    542  2572,  821,24334,    0,    0, -228,  309,  309,    0,    0, 
    543   803,    0, 2572, 2572,    0,    0,  448, 2572,  829,  831, 
    544     0,    0,    0,23146,  287,  381,  231,    0,    0, 2572, 
    545  2572, 2572, 2572, 7265,  594, 1955, 1073,  583, 2572,    0, 
    546   832,    0, 2572, 1955,    0,  287,  287,  287,  287,  287, 
    547   604,    0,    0,    0,  421,    0,  838, 5708, 7265,    0, 
    548   431,  435,24985,    0,    0,    0,25012,25034,25064,25131, 
    549 25145,25226,25248,25278,25300,25314,25328,25378,25392,    0, 
    550   445,  456,  473,  489,  498,  835,  836,  842,25406, 7784, 
    551     0, 7784, 7784,  510, 7265,    0,  824,  846, 6227,  583, 
    552   855, 7265,    0, 2572, 3284, 3284, 3819,  672,  672,  672, 
    553   672,  672,  672,   88,   88,   60, 7265, 7265,    0, 2572, 
    554    60, 7265,  672, 7265,  672, 2572, 2572,    0,    0,  309, 
    555     0,    0,    0,  480,  566, 7265, 6227, -273,  858,    0, 
    556     0,    0, -273,  859,  309,    0, 3655,    0, 7265,    0, 
    557  7265,    0,    0,  861,    0,  263,  453,  849,  492,    0, 
    558   730,  869,    0, 7265,    0,  516,    0, 9858,    0,    0, 
    559     0, 2572,    0,    0,  371,  368,    0,  514,  502,  642, 
    560 25420,  643,  872,    0,  644,  309,  861,    0,  876,24334, 
    561   812,  506,    0,    0,    0,  860,  554,  885,    0,  791, 
    562   795, 7265,  730,    0,    0,23815,    0,    0, 6227, 3136, 
    563   621,  478,    0,    0, 2572,    0,  539,    0, 2572, 2572, 
    564  1955, 2572,  832,   94,  604,  604,  604,   49,  -11,    0, 
    565    15,    0,    0, 2572,    0,    0,    0,    0,    0,    0, 
    566     0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    567     0,    0,    0,    0,    0, 9341, 9341, 9341,    0,    0, 
    568  2572,    0, 2572,    0, 2572,    0,  889, 7265,    0, 6746, 
    569     0,  887,    0,12884,  709,  672,  672,   60,  672,  672, 
    570   730,    0,    0,25462,  547,  871,    0,    0,    0,    0, 
    571     0,    0, 2572,  552,24559,    0,    0,    0,    0,  892, 
    572     0,    0,  730,  861,    0, 2572,23475,    0,24382,  745, 
    573     0,  112,  160,  160,  160,  160,  160,    0,    0,  160, 
    574     0,    0,    0,    0,  812,    0,24334,   11,  517,  519, 
    575   896,  899,25574,  730,    0,  900, 4692,  309,    0,  493, 
    576     0, 1999, 2572,    0,    0,    0,    0,  558,  886,  905, 
    577   908,  909,    0,  911, 7265,25652, 6227, 7265,    0,    0, 
    578   910,    0,  309,    0,24511, 2572,    0,    0,  861,    0, 
    579     0, 2572,    0,    0,  110,  110,  906,  239,  697,    0, 
    580     0,  584,    0,  926,    0,    0,    0,    0,    0, 7265, 
    581     0,    0,  799,  931, 2572,    0, 7265,    0,    0,    0, 
    582     0, 2572, 7265,    0,25724, 7265,    0,  932,    0,    0, 
    583   933,    0,  608,  610,25676,    0,25745, 2572, 7265, 2572, 
    584     0,    0, 7265,    0,    0, 7265, 7265, 2572, 2572, 2572, 
    585 25806, 7265, 2572, 
     492  121,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     49327654, -307,    0,    0,    0,    0,    0, -289, -289,    0, 
     494  111,    0,    0,25618,  118, 1476,  147,  153,    0,25618, 
     495   91,  107, 1476,  163,    0,   27,    0,  -13,25618,    0, 
     496    0, -250, -178,   27,    0,  208,    0,    0,    0,    0, 
     497    0,  -14,  215,  229,    0,    0,  201,  201, -151,    0, 
     498  244,    0,    0, -237,    0,    0,  -89,   27,   27,    0, 
     499 -100,    0,    0, -101,    0,   27,    0,    0,    0,    0, 
     500    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     501  284,   35,   27,   27,   27,    0,  290,  134,  280,    0, 
     502   79,    0,    0,    0,   -5, -307,    0,  138,   -9,  387, 
     503  388,    0,    0,    0,    0,    0,    0,   42, -117,  404, 
     504  387, -110,  225, -312,   43,    0,    0, 3999,   54,25618, 
     505   41,    0,    0,    0, 1476,  420,  425,   59,  437,26088, 
     506  437,    0,    0,    0,    0,    0,  444,25618,25618,    0, 
     507    0,25618,  446,  448,  450,25618,25618,25618,  455,  456, 
     508  466,  478,  480,  486,  487,  497,  503,  504,  509,  513, 
     50925618,  515,  524,  528,  532,  533,25666,    0,    0,  539, 
     510    0,    0,    0,    0,    0,    0,    0,25618,   18,  149, 
     511  542,25618,    0,  548,    0,  553,    0,  563,    0,    0, 
     51214376,  115,25618,    0,    0,14376,  190,  570,    0,25618, 
     513    0,14376,  558,    0,  222,    0,  222,    0,25618,    0, 
     514    0,    0,    0,25618,    0,26332,    0,    0,    0,    0, 
     515  190,    0,    0,25800,    0,  190,  190,  222, 3040,    0, 
     516  224,  190,    0,25618,  609,    0,    0,    0,    0,    0, 
     517    0,  610,    0,    0,  201,    0,    0,  255, 1930,  603, 
     518    0,  651,    0, -289,    0,    0,    0,    0,  283,25848, 
     519 -312,    0,    0,  665,27654, -307,    0,    0,    0,    0, 
     520    0,    0, -289,  648,  296,  675,    0,    0,   19,  308, 
     521   19,  -12,   86,  -11,  665,  308,    0,  190,   19,    0, 
     522  313,  665,  318,  692,    0,  -10, 3093,    0,24429,    0, 
     523  703,    0,  711,    0,  717,  732,    0,    0,  387,  190, 
     52414376,25618,25618,  190,    0,    0,  360, 4498,    0,    0, 
     52525448,    0,    0,    0,    0,25618,25618,25618,25618,  740, 
     52625448,  149,  553, 1423,    0,  764,  209,    0,24371,25666, 
     527    0,    8,  535,26366, 3157,  236,14376,25618,25618,25618, 
     528  281,26399,  461,25618,25618,25618,25618,25618,25618,25618, 
     52925618,25618,25618,25618,25618,26442,25618,25618,25618,25618, 
     53025618,25666,    0,  781,  451,  786,  789,    0,14376,25618, 
     531  790,26465,    0,25618,    0,    0,    0,    0,14376,    0, 
     532  190,    0,24622,25618,25618,25618,25618,25618,25618,25618, 
     53325618,25618,25618,25618,25618,25618,25618, 2012,25618,24756, 
     53424804,    0,25618,25618,    0,26513,  665,  475,  147,26632, 
     535    0,    0,  791,  791,26698,25564,    0,  796,  553,  563, 
     536  793,  801,    0,    0,  798,  256,  799,  796,  797,    0, 
     537    0,  568,  791,    0,    0,    0,    0,    0,    0,    0, 
     538    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     539    0,    0,    0,    0,    0,    0,    0,  800,    0,  571, 
     540    0,14376,  577,  802,  428,   27,  665,    0,    0,  665, 
     541    0,  807,    0,    0,    0,    0,    0,    0,  119,    0, 
     542    0,    0,    0,  444,  436,    0,24950,14376,    0,  819, 
     543 2554,  665,    0,    0,    0,    0,  444,25618,  599,  296, 
     544  387,    0,  387,  233,25618,    0,  447,  449,  233,    0, 
     545    0,    0,  387,  665,    0,  692,  318,    0, 3093,    0, 
     54624574,  817,14376,  824,25096,    0,    0, -225,  190,  190, 
     547    0,    0,  806,    0,14376,14376,    0,    0,  445,14376, 
     548  827,  826,    0,    0,    0, 5446,24371,  605,  100,    0, 
     549    0,14376,14376,14376,14376,25618,  333, 1423,  538,  553, 
     55014376,    0,  828,    0,14376, 1423,    0,24371,24371,24371, 
     55124371,24371,  598,    0,    0,    0,    0,  614,    0,  833, 
     552 1476,25618,    0,  618,  619,26746,    0,    0,    0,26768, 
     55326790,26812,26865,26887,26931,27045,27120,27164,27186,27208, 
     55427230,    0,  626,  634,  636,  638,  642,  831,  834,  835, 
     55527278,25666,    0,25666,25666,  644,25618,    0,  822,  840, 
     55625144,  553,  841,25618,    0,14376, 2081, 2081, 2226, 2226, 
     557 3157,   84,   84,   84,   84,   84,   84,   90,   90,   48, 
     55825618,25618,    0,14376,   48,25618,   84,25618,   84,14376, 
     55914376,    0,    0,  190,    0,    0,    0,  468,  551,25618, 
     56025144, -278,  845,    0,    0,    0, -278,  846,  190,    0, 
     561 3040,    0,25618,    0,25618,    0,    0,  852,    0, -170, 
     562 1930,  843,  485,    0,  665,  864,    0,25618,    0,  646, 
     563    0, 9830,    0,    0,    0,14376,    0,    0,  318,  308, 
     564    0,  321,  550,  635,27300,  643,  870,    0,  645,  190, 
     565  852,    0,  878,25096,  817,  506,    0,    0,    0,  862, 
     566  547,  880,    0,  793,  797,25618,  665,    0,    0, 4498, 
     567    0,    0,25144,  631,  544,25448,    0,    0,14376,    0, 
     568  656,    0,14376,14376, 1423,14376,  828,  250,  598,  598, 
     569  598,   38,   -1,    0,   10,    0,    0,14376,    0,    0, 
     570    0,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
     571    0,    0,    0,    0,    0,    0,    0,    0,25993,25993, 
     57225993,    0,    0,14376,    0,14376,    0,14376,    0,  885, 
     57325618,    0,25278,    0,  883,    0,10667,  548,   84,   84, 
     574   48,   84,   84,  665,    0,    0,27353,  658,  867,    0, 
     575    0,    0,    0,    0,    0,14376,  660,26041,    0,    0, 
     576    0,    0,  891,    0,    0,  665,  852,    0,14376, 2554, 
     577    0,25326,  692,    0,  149,  233,  233,  233,  233,  233, 
     578    0,    0,  233,    0,    0,    0,    0,  817,    0,25096, 
     579   28,  516,  517,  894,  895,27532,  665,    0,  896,25043, 
     580  190,    0,  209,    0, 2501,14376,    0,    0,    0,    0, 
     581  662,  879,  898,  900,  902,    0,  903,25618,11085,25144, 
     58225618,    0,    0,  904,    0,  190,    0,25472,14376,    0, 
     583    0,  852,    0,    0,14376,    0,    0,  184,  184,  906, 
     584  491,  677,    0,    0,  573,    0,  917,    0,    0,    0, 
     585    0,    0,25618,    0,    0,  801,  909,14376,    0,25618, 
     586    0,    0,    0,    0,14376,25618,    0,13811,25618,    0, 
     587  927,    0,    0,  911,    0,  557,  559,27585,    0,27606, 
     58814376,25618,14376,    0,    0,25618,    0,    0,25618,25618, 
     58914376,14376,14376,27627,25618,14376, 
    586590}; 
    587591short fortranrindex[] = {                                      0, 
    588  1436,    0,    0,    0,    0,    0,    0,    0,    0,    0, 
    589   278,22929,    0,    0,    0,    0,    0,    0,    0,    0, 
    590     0,    0,    0,    0,    0,    0,    0,    0,