Changeset 1200 for trunk/AGRIF/AGRIF_FILES
- Timestamp:
- 2008-09-24T15:05:20+02:00 (16 years ago)
- Location:
- trunk/AGRIF/AGRIF_FILES
- Files:
-
- 11 edited
-
modarrays.F (modified) (10 diffs)
-
modbc.F (modified) (14 diffs)
-
modbcfunction.F (modified) (55 diffs)
-
modcluster.F (modified) (1 diff)
-
modcurgridfunctions.F (modified) (1 diff)
-
modinit.F (modified) (2 diffs)
-
modinterp.F (modified) (39 diffs)
-
modmask.F (modified) (1 diff)
-
modsauv.F (modified) (4 diffs)
-
modtypes.F (modified) (8 diffs)
-
modupdate.F (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/AGRIF_FILES/modarrays.F
r662 r1200 176 176 C Local variables 177 177 C 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) 199 180 return 200 181 C … … 552 533 C 553 534 554 #ifdef AGRIF_MPI555 535 C ************************************************************************** 556 536 CCC Subroutine GiveAgrif_SpecialValueToTab_mpi … … 581 561 CASE (1) 582 562 Where (Variable1 % array1( 583 & bound1( lower(1),1,2):bound1(upper(1),1,2))563 & bound1(1,1,2):bound1(1,2,2)) 584 564 & == Value) 585 Variable2 % array1( lower(1):upper(1))565 Variable2 % array1(bound1(1,1,1):bound1(1,2,1)) 586 566 & = Value 587 567 C … … 589 569 CASE (2) 590 570 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)) 593 573 & == 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)) 596 576 & = Value 597 577 C … … 599 579 CASE (3) 600 580 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)) 604 584 & == 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)) 608 588 & = Value 609 589 C … … 611 591 CASE (4) 612 592 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)) 617 597 & == 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)) 622 602 & = Value 623 603 C … … 625 605 CASE (5) 626 606 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)) 632 612 & == 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)) 638 618 & = Value 639 619 C … … 641 621 CASE (6) 642 622 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)) 649 629 & == 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)) 656 636 & = Value 657 637 C … … 662 642 C 663 643 End Subroutine GiveAgrif_SpecialValueToTab_mpi 664 #else 644 665 645 C ************************************************************************** 666 646 CCC Subroutine GiveAgrif_SpecialValueToTab … … 771 751 C 772 752 End Subroutine GiveAgrif_SpecialValueToTab 773 #endif 753 774 754 C 775 755 C -
trunk/AGRIF/AGRIF_FILES/modbc.F
r898 r1200 41 41 C 42 42 C 43 43 44 C 44 45 C ************************************************************************** … … 47 48 C 48 49 Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin, 49 & weight,pweight )50 & weight,pweight,procname) 50 51 C 51 52 CCC Description: 52 53 CCC Subroutine to calculate the boundary conditions on a fine grid for a 1D 53 CCC grid variable.54 C55 C Declarations:56 C57 58 C59 C Arguments60 INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation61 ! (linear,...)62 TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid63 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid64 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child65 ! grid66 INTEGER :: deb,fin ! Positions of the interpolations67 REAL, DIMENSION(68 & lbound(child%var%array1,1):ubound(child%var%array1,1)69 & ), Target :: tab ! Values of the grid variable70 LOGICAL :: pweight ! Indicates if weight is used for71 ! the temporal interpolation72 REAL :: weight ! Coefficient for the time73 ! interpolation74 C75 C76 C Definition of a temporary AGRIF_PVariable data TYPE representing the grid77 C variable.78 C79 allocate(childtemp % var)80 C81 childtemp % var % root_var => child % var % root_var82 C83 C Values of the grid variable84 childtemp % var % array1 => tab85 C86 C Temporary results for the time interpolation before and after the space87 C interpolation88 childtemp % var % oldvalues2D => child % var % oldvalues2D89 C90 C Index indicating if a space interpolation is necessary91 childtemp % var % interpIndex => child % var % interpIndex92 childtemp % var % Interpolationshouldbemade =93 & child % var % Interpolationshouldbemade94 childtemp % var % list_interp => child % var% list_interp95 C96 C Call to the procedure for the calculations of the boundary conditions97 Call Agrif_CorrectVariable98 & (TypeInterp,parent,childtemp,deb,fin,pweight,weight)99 C100 child % var % oldvalues2D => childtemp % var % oldvalues2D101 child % var % list_interp => childtemp % var %list_interp102 C103 deallocate(childtemp % var)104 C105 C106 End Subroutine Agrif_Interp_bc_1D107 C108 C109 C110 C **************************************************************************111 CCC Subroutine Agrif_Interp_bc_2d112 C **************************************************************************113 C114 Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,115 & weight,pweight,procname)116 C117 CCC Description:118 CCC Subroutine to calculate the boundary conditions on a fine grid for a 2D119 54 CCC grid variable. 120 55 C … … 135 70 ! done on the fine grid 136 71 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 140 74 LOGICAL :: pweight ! Indicates if weight is used for 141 75 ! the temporal interpolation … … 152 86 C 153 87 C Values of the grid variable 154 childtemp % var % array 2=> tab88 childtemp % var % array1 => tab 155 89 C 156 90 C Temporary results for the time interpolation before and after the space … … 162 96 childtemp % var % Interpolationshouldbemade = 163 97 & 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 102 C 103 C 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 112 C 113 child % var % oldvalues2D => childtemp % var % oldvalues2D 114 child % var % list_interp => childtemp % var %list_interp 115 C 116 deallocate(childtemp % var) 117 C 118 C 119 End Subroutine Agrif_Interp_bc_1D 120 C 121 122 C 123 C 124 C 125 C ************************************************************************** 126 CCC Subroutine Agrif_Interp_bc_2d 127 C ************************************************************************** 128 C 129 Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin, 130 & weight,pweight,procname) 131 C 132 CCC Description: 133 CCC Subroutine to calculate the boundary conditions on a fine grid for a 2D 134 CCC grid variable. 135 C 136 C Declarations: 137 C 138 139 C 140 C 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 159 C 160 C 161 C Definition of a temporary AGRIF_PVariable data TYPE representing the grid 162 C variable. 163 C 164 allocate(childtemp % var) 165 C 166 childtemp % var % root_var => child % var % root_var 167 C 168 C Values of the grid variable 169 childtemp % var % array2 => tab 170 C 171 C Temporary results for the time interpolation before and after the space 172 C interpolation 173 childtemp % var % oldvalues2D => child % var % oldvalues2D 174 C 175 C 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 165 183 C 166 184 C Call to the procedure for the calculations of the boundary conditions … … 211 229 ! are done on the fine grid 212 230 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) 216 234 & ), Target :: tab ! Values of the grid variable 217 235 LOGICAL :: pweight ! Indicates if weight is used for … … 239 257 childtemp % var % Interpolationshouldbemade = 240 258 & 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 242 263 C 243 264 C Call to the procedure for the calculations of the boundary conditions … … 288 309 ! are done on the fine grid 289 310 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) 294 315 & ), Target :: tab ! Values of the grid variable 295 316 LOGICAL :: pweight ! Indicates if weight is used for … … 317 338 childtemp % var % Interpolationshouldbemade = 318 339 & 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 320 344 C 321 345 C Call to the procedure for the calculations of the boundary conditions … … 365 389 ! are done on the fine grid 366 390 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) 372 396 & ), Target :: tab ! Values of the grid variable 373 397 LOGICAL :: pweight ! Indicates if weight is used for … … 395 419 childtemp % var % Interpolationshouldbemade = 396 420 & 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 398 426 C 399 427 C Call to the procedure for the calculations of the boundary conditions … … 442 470 ! are done on the fine grid 443 471 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) 450 478 & ), Target :: tab ! Values of the grid variable 451 479 LOGICAL :: pweight ! Indicates if weight is used for … … 473 501 childtemp % var % Interpolationshouldbemade = 474 502 & 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 476 507 C 477 508 C Call to the procedure for the calculations of the boundary conditions … … 626 657 case('N') ! No space DIMENSION 627 658 C 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) 650 661 C 651 662 C No interpolation but only a copy of the values of the grid variable -
trunk/AGRIF/AGRIF_FILES/modbcfunction.F
r779 r1200 256 256 C 257 257 INTEGER :: tabvarsindic ! indice of the variable in tabvars 258 TYPE(Agrif_PVariable),Pointer ::tabvars 259 260 258 261 C 259 262 C … … 261 264 C 262 265 C 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 263 273 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. 272 280 ENDIF 273 281 if ( PRESENT(Interpolationshouldbemade) ) then 274 Agrif_Curgrid%tabvars(tabvarsindic)%var %282 tabvars%var % 275 283 & Interpolationshouldbemade = Interpolationshouldbemade 276 284 endif … … 278 286 endif 279 287 C 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) 282 290 C 283 291 End Subroutine Agrif_Set_bc … … 346 354 C 347 355 INTEGER :: tabvarsindic ! indice of the variable in tabvars 356 TYPE(Agrif_PVariable),Pointer ::tabvars 357 358 348 359 C 349 360 C 350 361 C Begin 351 362 C 352 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp = 363 C 364 365 if (tabvarsindic <=0) then 366 tabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 367 else 368 tabvars=>Agrif_Mygrid % tabvars(tabvarsindic) 369 endif 370 C 371 tabvars% var % bctypeinterp = 353 372 & Agrif_Constant 354 373 IF (present(interp)) THEN 355 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp =374 tabvars% var % bctypeinterp = 356 375 & interp 357 376 ENDIF 358 377 IF (present(interp1)) THEN 359 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,1) =378 tabvars% var % bctypeinterp(1:2,1) = 360 379 & interp1 361 380 ENDIF 362 381 IF (present(interp11)) THEN 363 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,1) =382 tabvars% var % bctypeinterp(1,1) = 364 383 & interp11 365 384 ENDIF 366 385 IF (present(interp12)) THEN 367 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1,2) =386 tabvars% var % bctypeinterp(1,2) = 368 387 & interp12 369 388 ENDIF 370 389 IF (present(interp2)) THEN 371 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,2) =390 tabvars% var % bctypeinterp(1:2,2) = 372 391 & interp2 373 392 ENDIF 374 393 IF (present(interp21)) THEN 375 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,1) =394 tabvars% var % bctypeinterp(2,1) = 376 395 & interp21 377 396 ENDIF 378 397 IF (present(interp22)) THEN 379 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(2,2) =398 tabvars% var % bctypeinterp(2,2) = 380 399 & interp22 381 400 ENDIF 382 401 IF (present(interp3)) THEN 383 Agrif_Mygrid % tabvars(tabvarsindic)% var % bctypeinterp(1:2,3) =402 tabvars% var % bctypeinterp(1:2,3) = 384 403 & interp3 385 404 ENDIF … … 507 526 CCC Subroutine Agrif_Init_variable0d 508 527 C ************************************************************************** 509 Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic) 528 Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic, 529 & procname) 510 530 511 531 INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 512 532 INTEGER :: tabvarsindic ! indice of the variable in tabvars 533 External :: procname 534 Optional :: procname 513 535 C 514 536 if (Agrif_Root()) Return 515 537 C 538 if (present(procname)) then 539 CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic,procname) 540 CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.,procname) 541 else 516 542 CALL Agrif_Interp_variable(tabvarsindic0,tabvarsindic) 517 543 CALL Agrif_Bc_variable(tabvarsindic0,tabvarsindic,1.) 544 endif 518 545 519 546 End Subroutine Agrif_Init_variable0d … … 523 550 CCC Subroutine Agrif_Init_variable1d 524 551 C ************************************************************************** 525 Subroutine Agrif_Init_variable1d(q,tabvarsindic )552 Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname) 526 553 527 554 REAL, DIMENSION(:) :: q 528 555 INTEGER :: tabvarsindic ! indice of the variable in tabvars 556 External :: procname 557 Optional :: procname 558 529 559 C 530 560 if (Agrif_Root()) Return 531 561 C 562 if (present(procname)) then 563 CALL Agrif_Interp_variable(q,tabvarsindic,procname) 564 CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 565 else 532 566 CALL Agrif_Interp_variable(q,tabvarsindic) 533 567 CALL Agrif_Bc_variable(q,tabvarsindic,1.) 568 endif 534 569 535 570 End Subroutine Agrif_Init_variable1d … … 538 573 CCC Subroutine Agrif_Init_variable2d 539 574 C ************************************************************************** 540 Subroutine Agrif_Init_variable2d(q,tabvarsindic )575 Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname) 541 576 542 577 REAL, DIMENSION(:,:) :: q 543 578 INTEGER :: tabvarsindic ! indice of the variable in tabvars 579 External :: procname 580 Optional :: procname 581 544 582 C 545 583 if (Agrif_Root()) Return 546 584 C 585 if (present(procname)) then 586 CALL Agrif_Interp_variable(q,tabvarsindic,procname) 587 CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 588 else 547 589 CALL Agrif_Interp_variable(q,tabvarsindic) 548 590 CALL Agrif_Bc_variable(q,tabvarsindic,1.) 591 endif 592 549 593 550 594 End Subroutine Agrif_Init_variable2d … … 554 598 CCC Subroutine Agrif_Init_variable3d 555 599 C ************************************************************************** 556 Subroutine Agrif_Init_variable3d(q,tabvarsindic )600 Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname) 557 601 558 602 REAL, DIMENSION(:,:,:) :: q 559 603 INTEGER :: tabvarsindic ! indice of the variable in tabvars 604 External :: procname 605 Optional :: procname 560 606 C 561 607 if (Agrif_Root()) Return 562 608 C 609 if (present(procname)) then 610 CALL Agrif_Interp_variable(q,tabvarsindic,procname) 611 CALL Agrif_Bc_variable(q,tabvarsindic,1.,procname) 612 else 563 613 CALL Agrif_Interp_variable(q,tabvarsindic) 564 614 CALL Agrif_Bc_variable(q,tabvarsindic,1.) 615 endif 616 565 617 C 566 618 End Subroutine Agrif_Init_variable3d 619 C 620 C 621 C ************************************************************************** 622 CCC Subroutine Agrif_Init_variable4d 623 C ************************************************************************** 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 630 C 631 if (Agrif_Root()) Return 632 C 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 641 C 642 End Subroutine Agrif_Init_variable4d 567 643 C 568 644 C … … 713 789 C 714 790 C 715 C716 791 C ************************************************************************** 717 792 CCC Subroutine Agrif_Bc_variable1d 718 793 C ************************************************************************** 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 722 800 INTEGER :: tabvarsindic ! indice of the variable in tabvars 723 801 C … … 725 803 REAL :: weight 726 804 LOGICAL :: pweight 727 C 805 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 806 C 807 C 808 C 809 If (Agrif_Root()) Return 810 728 811 if ( PRESENT(calledweight) ) then 729 812 weight=calledweight … … 733 816 pweight = .FALSE. 734 817 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 739 830 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 752 848 C 753 849 C ************************************************************************** … … 755 851 C ************************************************************************** 756 852 Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight, 757 & 758 759 REAL , D IMENSION(:,:) :: q853 & procname) 854 855 REAL , Dimension(:,:) :: q 760 856 External :: procname 761 857 Optional :: procname … … 765 861 REAL :: weight 766 862 LOGICAL :: pweight 767 C 863 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 864 C 865 C 866 C 867 If (Agrif_Root()) Return 868 768 869 if ( PRESENT(calledweight) ) then 769 weight=calledweight 870 weight=calledweight 770 871 pweight = .TRUE. 771 872 else … … 773 874 pweight = .FALSE. 774 875 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 779 887 IF (present(procname)) THEN 780 888 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, 786 894 & weight,pweight,procname) 787 895 ELSE 788 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, 794 902 & weight,pweight) 795 903 ENDIF 796 797 904 End Subroutine Agrif_Bc_variable2d 905 798 906 C 799 907 C ************************************************************************** … … 811 919 REAL :: weight 812 920 LOGICAL :: pweight 813 C 921 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 922 C 923 C 924 C 925 If (Agrif_Root()) Return 926 814 927 if ( PRESENT(calledweight) ) then 815 928 weight=calledweight … … 819 932 pweight = .FALSE. 820 933 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 824 945 IF (present(procname)) THEN 825 946 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, 831 952 & weight,pweight,procname) 832 953 ELSE 833 954 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, 839 960 & weight,pweight) 840 961 ENDIF 841 962 End Subroutine Agrif_Bc_variable3d 963 842 964 C 843 965 C ************************************************************************** … … 855 977 REAL :: weight 856 978 LOGICAL :: pweight 857 C 979 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 980 C 981 C 982 C 983 If (Agrif_Root()) Return 984 858 985 if ( PRESENT(calledweight) ) then 859 986 weight=calledweight … … 863 990 pweight = .FALSE. 864 991 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 868 1003 IF (present(procname)) THEN 869 1004 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, 875 1010 & weight,pweight,procname) 876 1011 ELSE 877 1012 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, 883 1018 & weight,pweight) 884 1019 ENDIF 885 1020 End Subroutine Agrif_Bc_variable4d 1021 886 1022 C 887 1023 C ************************************************************************** … … 889 1025 C ************************************************************************** 890 1026 Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight, 891 & procname)1027 & procname) 892 1028 893 1029 REAL , Dimension(:,:,:,:,:) :: q … … 899 1035 REAL :: weight 900 1036 LOGICAL :: pweight 901 C 1037 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1038 C 1039 C 1040 C 1041 If (Agrif_Root()) Return 1042 902 1043 if ( PRESENT(calledweight) ) then 903 1044 weight=calledweight … … 907 1048 pweight = .FALSE. 908 1049 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 912 1061 IF (present(procname)) THEN 913 Call Agrif_Interp_Bc_5 D(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, 919 1068 & weight,pweight,procname) 920 1069 ELSE 921 Call Agrif_Interp_Bc_5 D(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, 927 1076 & weight,pweight) 928 1077 ENDIF 929 1078 End Subroutine Agrif_Bc_variable5d 1079 930 1080 C 931 1081 C ************************************************************************** … … 933 1083 C ************************************************************************** 934 1084 C 935 Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic )1085 Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname) 936 1086 937 1087 INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 938 1088 INTEGER :: tabvarsindic ! indice of the variable in tabvars 939 1089 INTEGER :: dimensio ! indice of the variable in tabvars 1090 External :: procname 1091 Optional :: procname 940 1092 C 941 1093 if (Agrif_Root()) Return … … 943 1095 dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 944 1096 C 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( 947 1100 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 948 1101 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 950 1103 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 , 951 1104 & 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, 952 1113 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 953 C 954 if ( dimensio .EQ. 2 ) 955 & Call Agrif_Interp_2D( 1114 endif 1115 endif 1116 C 1117 if ( dimensio .EQ. 2 ) then 1118 if (present(procname)) then 1119 Call Agrif_Interp_2D( 956 1120 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 957 1121 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 959 1123 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 , 960 1124 & 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, 961 1133 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 962 C 963 if ( dimensio .EQ. 3 ) 964 & Call Agrif_Interp_3D( 1134 endif 1135 endif 1136 C 1137 if ( dimensio .EQ. 3 ) then 1138 if (present(procname)) then 1139 Call Agrif_Interp_3D( 965 1140 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 966 1141 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 968 1143 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 , 969 1144 & 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, 970 1153 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 971 C 972 if ( dimensio .EQ. 4 ) 973 & Call Agrif_Interp_4D( 1154 endif 1155 endif 1156 C 1157 if ( dimensio .EQ. 4 ) then 1158 if (present(procname)) then 1159 Call Agrif_Interp_4D( 974 1160 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 975 1161 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 977 1163 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 , 978 1164 & 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, 979 1173 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 980 C 981 if ( dimensio .EQ. 5 ) 982 & Call Agrif_Interp_5D( 1174 endif 1175 endif 1176 C 1177 if ( dimensio .EQ. 5 ) then 1178 if (present(procname)) then 1179 Call Agrif_Interp_5D( 983 1180 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 984 1181 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 986 1183 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 , 987 1184 & 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, 988 1193 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 989 C 990 if ( dimensio .EQ. 6 ) 991 & Call Agrif_Interp_6D( 1194 endif 1195 endif 1196 C 1197 if ( dimensio .EQ. 6 ) then 1198 if (present(procname)) then 1199 Call Agrif_Interp_6D( 992 1200 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 993 1201 & Agrif_Curgrid % parent % tabvars(tabvarsindic), … … 995 1203 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 , 996 1204 & 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, 997 1213 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1214 endif 1215 endif 998 1216 C 999 1217 Return … … 1004 1222 C ************************************************************************** 1005 1223 C 1006 Subroutine Agrif_Interp_var1d(q,tabvarsindic )1224 Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname) 1007 1225 1008 1226 REAL, DIMENSION(:) :: q 1009 1227 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1228 External :: procname 1229 Optional :: procname 1010 1230 C 1011 1231 if (Agrif_Root()) Return 1012 1232 C 1233 if (present(procname)) then 1013 1234 Call Agrif_Interp_1D( 1014 1235 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, … … 1016 1237 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1017 1238 & 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, 1018 1246 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1019 1247 endif 1020 1248 Return 1021 1249 End Subroutine Agrif_Interp_var1d … … 1025 1253 C ************************************************************************** 1026 1254 C 1027 Subroutine Agrif_Interp_var2d(q,tabvarsindic )1255 Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname) 1028 1256 1029 1257 REAL, DIMENSION(:,:) :: q 1030 1258 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1259 External :: procname 1260 Optional :: procname 1261 1031 1262 C 1032 1263 if (Agrif_Root()) Return 1033 1264 C 1265 if (present(procname)) then 1034 1266 Call Agrif_Interp_2D( 1035 1267 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, … … 1037 1269 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1038 1270 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1271 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim,procname) 1272 else 1273 Call Agrif_Interp_2D( 1274 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1275 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1276 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1277 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1039 1278 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1040 1279 endif 1041 1280 Return 1042 1281 End Subroutine Agrif_Interp_var2d … … 1046 1285 C ************************************************************************** 1047 1286 C 1048 Subroutine Agrif_Interp_var3d(q,tabvarsindic )1287 Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname) 1049 1288 1050 1289 REAL, DIMENSION(:,:,:) :: q 1051 1290 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1291 External :: procname 1292 Optional :: procname 1293 1052 1294 C 1053 1295 if (Agrif_Root()) Return 1054 1296 C 1297 if (present(procname)) then 1055 1298 Call Agrif_Interp_3D( 1056 1299 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, … … 1058 1301 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1059 1302 & 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, 1060 1310 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1061 1311 endif 1062 1312 Return 1063 1313 End Subroutine Agrif_Interp_var3d … … 1067 1317 C ************************************************************************** 1068 1318 C 1069 Subroutine Agrif_Interp_var4d(q,tabvarsindic )1319 Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname) 1070 1320 1071 1321 REAL, DIMENSION(:,:,:,:) :: q 1072 1322 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1323 External :: procname 1324 Optional :: procname 1325 1073 1326 C 1074 1327 if (Agrif_Root()) Return 1075 1328 C 1329 if (present(procname)) then 1076 1330 Call Agrif_Interp_4D( 1077 1331 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, … … 1079 1333 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1080 1334 & 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, 1081 1342 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1082 1343 endif 1083 1344 Return 1084 1345 End Subroutine Agrif_Interp_var4d … … 1088 1349 C ************************************************************************** 1089 1350 C 1090 Subroutine Agrif_Interp_var5d(q,tabvarsindic )1351 Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname) 1091 1352 1092 1353 REAL, DIMENSION(:,:,:,:,:) :: q 1093 1354 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1355 External :: procname 1356 Optional :: procname 1357 1094 1358 C 1095 1359 if (Agrif_Root()) Return 1096 1360 C 1361 if (present(procname)) then 1097 1362 Call Agrif_Interp_5D( 1098 1363 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, … … 1100 1365 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1101 1366 & 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, 1102 1374 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1103 1375 endif 1104 1376 Return 1105 1377 End Subroutine Agrif_Interp_var5d … … 1110 1382 C 1111 1383 Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic, 1112 & locupdate,procname) 1384 & locupdate,locupdate1, 1385 & locupdate2,procname) 1113 1386 1114 1387 INTEGER :: tabvarsindic ! indice of the variable in tabvars … … 1118 1391 INTEGER :: dimensio 1119 1392 INTEGER, DIMENSION(2), OPTIONAL :: locupdate 1393 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1394 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1120 1395 C 1121 1396 dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 1122 1397 C 1123 1398 if (Agrif_Root()) Return 1399 1124 1400 C 1125 1401 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 1132 1426 1133 1427 if ( dimensio .EQ. 1 ) then … … 1240 1534 C ************************************************************************** 1241 1535 C 1242 Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,procname) 1536 Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate, 1537 & locupdate1,locupdate2,procname) 1243 1538 1244 1539 REAL, DIMENSION(:) :: q … … 1247 1542 Optional :: procname 1248 1543 INTEGER, DIMENSION(2), OPTIONAL :: locupdate 1544 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1545 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1249 1546 C 1250 1547 if (Agrif_Root()) Return 1251 1548 C 1252 1549 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 1259 1574 1260 1575 IF (present(procname)) THEN … … 1283 1598 C ************************************************************************** 1284 1599 C 1285 Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,procname) 1600 Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate, 1601 & locupdate1,locupdate2,procname) 1286 1602 1287 1603 REAL, DIMENSION(:,:) :: q … … 1289 1605 Optional :: procname 1290 1606 INTEGER, DIMENSION(2), OPTIONAL :: locupdate 1607 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1608 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1291 1609 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1292 1610 C 1293 1611 IF (Agrif_Root()) RETURN 1612 1294 1613 C 1295 1614 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) 1301 1638 ENDIF 1302 1639 … … 1326 1663 C ************************************************************************** 1327 1664 C 1328 Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,procname) 1665 Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate, 1666 & locupdate1,locupdate2,procname) 1329 1667 1330 1668 REAL, DIMENSION(:,:,:) :: q … … 1332 1670 Optional :: procname 1333 1671 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 1675 C 1676 IF (Agrif_Root()) RETURN 1337 1677 C 1338 1678 1339 1679 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) 1345 1703 ENDIF 1346 1704 … … 1370 1728 C ************************************************************************** 1371 1729 C 1372 Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,procname) 1730 Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate, 1731 & locupdate1,locupdate2,procname) 1373 1732 1374 1733 REAL, DIMENSION(:,:,:,:) :: q … … 1376 1735 Optional :: procname 1377 1736 INTEGER, DIMENSION(2), OPTIONAL :: locupdate 1737 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1738 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1378 1739 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1379 1740 C … … 1381 1742 C 1382 1743 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) 1388 1767 ENDIF 1389 1768 … … 1413 1792 C ************************************************************************** 1414 1793 C 1415 Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,procname) 1794 Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate, 1795 & locupdate1,locupdate2,procname) 1416 1796 1417 1797 REAL, DIMENSION(:,:,:,:,:) :: q … … 1419 1799 Optional :: procname 1420 1800 INTEGER, DIMENSION(2), OPTIONAL :: locupdate 1801 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1802 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1421 1803 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1422 1804 C … … 1424 1806 C 1425 1807 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) 1431 1831 ENDIF 1432 1832 … … 1551 1951 1552 1952 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) 1969 C 1970 C 1971 Allocate(newvariable) 1972 Allocate(newvariable%pvar) 1973 Allocate(newvariable%pvar%var) 1974 Allocate(newvariable%pvar%var%posvar(dimensio)) 1975 Allocate(newvariable%pvar%var%interptab(dimensio)) 1976 newvariable%pvar%var%variablename = variablename 1977 newvariable%pvar%var%interptab = raf 1978 newvariable%pvar%var%nbdim = dimensio 1979 newvariable%pvar%var%posvar = posvar 1980 newvariable%pvar%var%point(1:dimensio) = firstpoint 1981 newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio) 1982 newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio) 1983 1984 newvariable % nextvariable => Agrif_Curgrid%variables 1985 1986 Agrif_Curgrid%variables => newvariable 1987 Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1 1988 1989 varid = -Agrif_Curgrid%Nbvariables 1990 1991 if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables) 1992 & then 1993 Allocate(newvariablep) 1994 Allocate(newvariablep%pvar) 1995 Allocate(newvariablep%pvar%var) 1996 Allocate(newvariablep%pvar%var%posvar(dimensio)) 1997 Allocate(newvariablep%pvar%var%interptab(dimensio)) 1998 newvariablep%pvar%var%variablename = variablename 1999 newvariablep%pvar%var%interptab = raf 2000 newvariablep%pvar%var%nbdim = dimensio 2001 newvariablep%pvar%var%posvar = posvar 2002 newvariablep%pvar%var%point(1:dimensio) = firstpoint 2003 2004 newvariablep % nextvariable => Agrif_Curgrid%parent%variables 2005 2006 Agrif_Curgrid%parent%variables => newvariablep 2007 2008 Agrif_Curgrid%parent%Nbvariables = 2009 & Agrif_Curgrid%parent%Nbvariables + 1 2010 parent_var=>newvariablep%pvar 2011 else 2012 parent_var=>Agrif_Search_Variable 2013 & (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables) 2014 endif 2015 2016 newvariable%pvar%parent_var=>parent_var 2017 2018 root_var=>Agrif_Search_Variable 2019 & (Agrif_Mygrid,Agrif_Curgrid%nbvariables) 2020 2021 newvariable%pvar%var%root_var=>root_var%var 2022 2023 2024 End Subroutine Agrif_Declare_Variable 2025 2026 FUNCTION Agrif_Search_Variable(grid,varid) 2027 integer :: varid 2028 Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable 2029 Type(Agrif_grid), Pointer :: grid 2030 2031 Type(Agrif_List_Variables), pointer :: parcours 2032 Logical :: foundvariable 2033 integer nb 2034 2035 foundvariable = .FALSE. 2036 parcours => grid%variables 2037 2038 do nb=1,varid-1 2039 parcours => parcours%nextvariable 2040 End Do 2041 2042 Agrif_Search_variable => parcours%pvar 2043 2044 2045 End Function Agrif_Search_variable 2046 2047 Subroutine Agrif_Declare_Profile_flux(profilename,posvar, 2048 & firstpoint,raf) 1556 2049 character*(*) :: profilename 1557 2050 Type(Agrif_Profile), Pointer :: newprofile … … 1577 2070 Agrif_myprofiles => newprofile 1578 2071 1579 End Subroutine Agrif_Declare_Profile 2072 End Subroutine Agrif_Declare_Profile_flux 1580 2073 1581 2074 C -
trunk/AGRIF/AGRIF_FILES/modcluster.F
r662 r1200 1307 1307 C grid pointed by parcours%gr 1308 1308 C 1309 Call Agrif_Allocation (parcours % gr) 1309 Call Agrif_Allocation (parcours % gr) 1310 C 1311 Call Agrif_initialisations(parcours % gr) 1310 1312 C 1311 1313 Call Agrif_Instance(parcours % gr) -
trunk/AGRIF/AGRIF_FILES/modcurgridfunctions.F
r774 r1200 960 960 end subroutine Agrif_Open_File 961 961 962 C ************************************************************************** 963 CCC subroutine Agrif_Set_MaskMaxSearch 964 C ************************************************************************** 965 subroutine Agrif_Set_MaskMaxSearch(mymaxsearch) 966 integer mymaxsearch 967 MaxSearch = mymaxsearch 968 end subroutine Agrif_Set_MaskMaxSearch 969 962 970 End Module Agrif_CurgridFunctions -
trunk/AGRIF/AGRIF_FILES/modinit.F
r396 r1200 129 129 C Pointer argument: 130 130 Type(Agrif_Grid), Pointer :: Agrif_Gr 131 131 132 C 132 133 do i = 1 , Agrif_NbVariables … … 136 137 if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 137 138 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) 138 143 endif 139 144 if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 140 145 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) 141 150 endif 142 151 if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 143 152 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) 144 157 endif 145 158 if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 146 159 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) 147 164 endif 148 165 if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 149 166 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) 150 171 endif 151 172 if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 152 173 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) 153 178 endif 154 179 C -
trunk/AGRIF/AGRIF_FILES/modinterp.F
r898 r1200 54 54 C 55 55 Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab, 56 & torestore,nbdim )56 & torestore,nbdim,procname) 57 57 C 58 58 CCC Description: … … 74 74 LOGICAL :: torestore 75 75 REAL, DIMENSION( 76 & lbound(child%var%array1,1):ubound(child%var%array1,1)76 & child%var%lb(1):child%var%ub(1) 77 77 & ), Target :: tab ! Result 78 External :: procname 79 Optional :: procname 78 80 C 79 81 C … … 88 90 C Tab is the result of the interpolation 89 91 childtemp % var % array1 => tab 92 93 childtemp % var % lb = child % var % lb 94 childtemp % var % ub = child % var % ub 95 90 96 C 91 97 if (torestore) then … … 108 114 childtemp % var % list_interp => child % var% list_interp 109 115 C 116 if (present(procname)) then 117 Call Agrif_InterpVariable 118 & (TypeInterp,parent,childtemp,torestore,procname) 119 else 110 120 Call Agrif_InterpVariable 111 121 & (TypeInterp,parent,childtemp,torestore) 122 endif 112 123 child % var % list_interp => childtemp % var %list_interp 113 124 C … … 124 135 C 125 136 Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab, 126 & torestore,nbdim )137 & torestore,nbdim,procname) 127 138 C 128 139 CCC Description: … … 144 155 LOGICAL :: torestore 145 156 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) 148 159 & ), Target :: tab ! Result 160 External :: procname 161 Optional :: procname 149 162 C 150 163 C … … 159 172 C Tab is the result of the interpolation 160 173 childtemp % var % array2 => tab 161 C 174 175 childtemp % var % lb = child % var % lb 176 childtemp % var % ub = child % var % ub 177 178 C 162 179 if (torestore) then 163 180 C 164 childtemp % var % array2 = child % var % array2 181 childtemp % var % array2 = child % var % array2 165 182 C 166 183 childtemp % var % restore2D => child % var % restore2D … … 179 196 childtemp % var % list_interp => child % var% list_interp 180 197 C 198 if (present(procname)) then 199 Call Agrif_InterpVariable 200 & (TypeInterp,parent,childtemp,torestore,procname) 201 else 181 202 Call Agrif_InterpVariable 182 203 & (TypeInterp,parent,childtemp,torestore) 204 endif 205 183 206 child % var % list_interp => childtemp % var %list_interp 184 207 C … … 195 218 C 196 219 Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab, 197 & torestore,nbdim )220 & torestore,nbdim,procname) 198 221 C 199 222 CCC Description: … … 215 238 LOGICAL :: torestore 216 239 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) 220 243 & ), Target :: tab ! Results 244 External :: procname 245 Optional :: procname 221 246 C 222 247 C … … 231 256 C Tab is the result of the interpolation 232 257 childtemp % var % array3 => tab 258 259 childtemp % var % lb = child % var % lb 260 childtemp % var % ub = child % var % ub 233 261 C 234 262 if (torestore) then … … 251 279 childtemp % var % list_interp => child % var% list_interp 252 280 C 281 282 if (present(procname)) then 283 Call Agrif_InterpVariable 284 & (TypeInterp,parent,childtemp,torestore,procname) 285 else 253 286 Call Agrif_InterpVariable 254 287 & (TypeInterp,parent,childtemp,torestore) 288 endif 289 290 255 291 child % var % list_interp => childtemp % var %list_interp 256 292 C … … 267 303 C 268 304 Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab, 269 & torestore,nbdim )305 & torestore,nbdim,procname) 270 306 C 271 307 CCC Description: … … 287 323 LOGICAL :: torestore 288 324 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) 293 329 & ), Target :: tab ! Results 330 External :: procname 331 Optional :: procname 294 332 C 295 333 C … … 304 342 C Tab is the result of the interpolation 305 343 childtemp % var % array4 => tab 344 345 childtemp % var % lb = child % var % lb 346 childtemp % var % ub = child % var % ub 347 306 348 C 307 349 if (torestore) then … … 324 366 childtemp % var % list_interp => child % var% list_interp 325 367 C 368 if (present(procname)) then 369 Call Agrif_InterpVariable 370 & (TypeInterp,parent,childtemp,torestore,procname) 371 else 326 372 Call Agrif_InterpVariable 327 373 & (TypeInterp,parent,childtemp,torestore) 374 endif 375 376 328 377 child % var % list_interp => childtemp % var %list_interp 329 378 C … … 340 389 C 341 390 Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab, 342 & torestore,nbdim )391 & torestore,nbdim,procname) 343 392 C 344 393 CCC Description: … … 360 409 LOGICAL :: torestore 361 410 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) 367 416 & ), Target :: tab ! Results 417 External :: procname 418 Optional :: procname 368 419 C 369 420 C … … 378 429 C Tab is the result of the interpolation 379 430 childtemp % var % array5 => tab 431 432 childtemp % var % lb = child % var % lb 433 childtemp % var % ub = child % var % ub 434 380 435 C 381 436 if (torestore) then … … 398 453 childtemp % var % list_interp => child % var% list_interp 399 454 C 455 if (present(procname)) then 456 Call Agrif_InterpVariable 457 & (TypeInterp,parent,childtemp,torestore,procname) 458 else 400 459 Call Agrif_InterpVariable 401 460 & (TypeInterp,parent,childtemp,torestore) 461 endif 462 402 463 403 464 child % var % list_interp => childtemp % var %list_interp … … 415 476 C 416 477 Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab, 417 & torestore,nbdim )478 & torestore,nbdim,procname) 418 479 C 419 480 CCC Description: … … 435 496 LOGICAL :: torestore 436 497 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) 443 504 & ), Target :: tab ! Results 505 External :: procname 506 Optional :: procname 444 507 C 445 508 C … … 454 517 C Tab is the result of the interpolation 455 518 childtemp % var % array6 => tab 519 520 childtemp % var % lb = child % var % lb 521 childtemp % var % ub = child % var % ub 522 456 523 C 457 524 if (torestore) then … … 475 542 childtemp % var % list_interp => child % var% list_interp 476 543 C 544 545 if (present(procname)) then 546 Call Agrif_InterpVariable 547 & (TypeInterp,parent,childtemp,torestore,procname) 548 else 477 549 Call Agrif_InterpVariable 478 550 & (TypeInterp,parent,childtemp,torestore) 551 endif 552 553 479 554 C 480 555 child % var % list_interp => childtemp % var %list_interp … … 490 565 C ************************************************************************** 491 566 C 492 Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore) 567 Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore, 568 & procname) 493 569 C 494 570 CCC Description: … … 521 597 REAL ,DIMENSION(6) :: s_child,s_parent 522 598 REAL ,DIMENSION(6) :: ds_child,ds_parent 599 External :: procname 600 Optional :: procname 601 523 602 C 524 603 Call PreProcessToInterpOrUpdate(parent,child, … … 533 612 C the grid variable 534 613 C 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 535 624 call Agrif_InterpnD 536 625 & (TYPEinterp,parent,child, … … 540 629 & ds_Child(1:nbdim),ds_Parent(1:nbdim), 541 630 & child,torestore,nbdim) 631 632 endif 542 633 C 543 634 Return … … 633 724 INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 634 725 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 636 727 LOGICAL, DIMENSION(1) :: memberin1 637 728 C 638 729 #endif 639 730 C 731 640 732 C 641 733 C Boundaries of the current grid where interpolation is done 642 734 643 644 645 646 735 IF (Associated(child%var%list_interp)) THEN 647 736 Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab, … … 659 748 660 749 IF (.not.find_list_interp) THEN 750 661 751 Call Agrif_nbdim_Get_bound_dimension(child % var, 662 752 & lowerbound,upperbound,nbdim) 663 753 664 754 Call Agrif_Childbounds(nbdim,lowerbound,upperbound, 665 755 & pttab,petab, … … 667 757 668 758 C 669 C670 671 759 Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob, 672 760 & s_Parent_temp,s_Child_temp, … … 677 765 & child%var%root_var%posvar, 678 766 & child % var % root_var % interptab) 679 680 767 681 768 #ifdef AGRIF_MPI 682 769 IF (memberin) THEN … … 689 776 & child%var%root_var%posvar, 690 777 & child % var % root_var % interptab) 691 ENDIF 692 778 ENDIF 779 693 780 Call Agrif_nbdim_Get_bound_dimension(parent%var, 694 781 & lowerbound,upperbound,nbdim) 695 782 696 783 Call Agrif_ChildGrid_to_ParentGrid() 697 784 C … … 739 826 740 827 ENDIF 741 742 743 828 744 829 IF (member) THEN … … 855 940 #endif 856 941 & ) 857 endif 858 942 endif 859 943 C 860 944 C … … 945 1029 946 1030 947 C948 C949 C Special values on the child grid950 if (Agrif_UseSpecialValueFineGrid) then951 C952 #ifdef AGRIF_MPI953 C954 Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,955 & childarray,956 & pttruetab,cetruetab,957 & Agrif_SpecialValueFineGrid,nbdim)958 C959 #else960 C961 Call GiveAgrif_SpecialValueToTab(child%var,tempC%var,962 & pttruetab,cetruetab,963 & Agrif_SpecialValueFineGrid,nbdim)964 C965 #endif966 C967 C968 endif969 1031 C 970 1032 … … 987 1049 #endif 988 1050 1051 1052 C 1053 C 1054 C Special values on the child grid 1055 if (Agrif_UseSpecialValueFineGrid) then 1056 C 1057 1058 Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var, 1059 & childarray, 1060 & pttruetab,cetruetab, 1061 & Agrif_SpecialValueFineGrid,nbdim) 1062 1063 C 1064 endif 1065 989 1066 endif 990 1067 … … 1089 1166 CASE (2) 1090 1167 do j = pttruetab(2),cetruetab(2) 1091 do i = pttruetab(1),cetruetab(1) 1168 do i = pttruetab(1),cetruetab(1) 1092 1169 if (restore%var%restore2D(i,j) == 0) 1093 1170 & child % var % array2(i,j) = … … 2096 2173 ENDIF 2097 2174 EndDo 2098 C print *,'ok trouve' 2175 2099 2176 indmin = parcours%interp_loc%indmin(1:nbdim) 2100 2177 indmax = parcours%interp_loc%indmax(1:nbdim) -
trunk/AGRIF/AGRIF_FILES/modmask.F
r779 r1200 35 35 C 36 36 IMPLICIT NONE 37 Integer, Parameter :: MaxSearch = 338 37 C 39 38 CONTAINS -
trunk/AGRIF/AGRIF_FILES/modsauv.F
r662 r1200 61 61 C Pointer argument 62 62 TYPE(Agrif_Grid),pointer :: Agrif_Gr ! Pointer on the current grid 63 INTEGER i 63 INTEGER i 64 64 C 65 65 C … … 164 164 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 165 165 endif 166 167 C 166 167 endif 168 169 C 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 174 C 175 if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 168 176 Deallocate(Agrif_Gr%tabvars(i)%var) 169 177 C … … 185 193 C 186 194 C 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 187 212 C 188 213 C ************************************************************************** … … 307 332 if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 308 333 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 309 endif 334 endif 310 335 ! 311 336 Deallocate(Agrif_Gr%tabvars(i)%var) -
trunk/AGRIF/AGRIF_FILES/modtypes.F
r898 r1200 32 32 C Maximum refinement ratio 33 33 34 INTEGER, PARAMETER :: Agrif_MaxRaff = 7 34 INTEGER, PARAMETER :: Agrif_MaxRaff = 7 35 36 C Maximum number of grids of the hierarchy 37 INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10 38 35 39 C 36 40 C ************************************************************************** … … 160 164 INTEGER ,DIMENSION(:,:) ,Pointer :: tabpoint2D 161 165 INTEGER ,DIMENSION(:,:,:) ,Pointer :: tabpoint3D 162 166 Type(Agrif_List_Variables), Pointer :: variables=>NULL() 167 INTEGER :: NbVariables = 0 163 168 Type(Agrif_Flux), Pointer :: fluxes => NULL() 164 169 End TYPE Agrif_grid … … 172 177 C 173 178 TYPE Agrif_Variable 179 CHARACTER*80 :: variablename 174 180 C 175 181 ! Pointer on the variable of the root grid … … 204 210 REAL*8, DIMENSION(:,:,:,:,:) ,Pointer :: darray5 => NULL() 205 211 REAL*8, DIMENSION(:,:,:,:,:,:),Pointer :: darray6 => NULL() 212 C 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() 206 220 C Arrays containing the values of the grid variables (LOGICAL) 207 221 LOGICAL :: larray0 … … 241 255 INTEGER :: bcinf ! option bc 242 256 INTEGER :: bcsup ! option bc 243 INTEGER :: updateinf ! option update244 INTEGER :: updatesup ! option update257 INTEGER, DIMENSION(6) :: updateinf ! option update 258 INTEGER, DIMENSION(6) :: updatesup ! option update 245 259 INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp 246 260 INTEGER, DIMENSION(6) :: TYPEinterp ! option interp 247 261 INTEGER, DIMENSION(6) :: TYPEupdate ! option update 262 263 INTEGER, DIMENSION(6) :: lb, ub 248 264 249 265 Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL() … … 278 294 Type(Agrif_List_Interp_Loc), Pointer :: suiv 279 295 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 281 302 TYPE Agrif_Profile 282 303 character*80 :: profilename … … 294 315 ! each of them 295 316 CHARACTER(6),DIMENSION(:) ,Pointer :: interptab => NULL() 317 Type(Agrif_Variable), Pointer :: var 296 318 Type(Agrif_Profile), Pointer :: nextprofile => NULL() 297 319 END TYPE Agrif_Profile … … 354 376 INTEGER :: Agrif_Minwidth 355 377 REAL :: Agrif_Efficiency = 0.7 378 INTEGER :: MaxSearch = 5 356 379 REAL ,DIMENSION(3) :: Agrif_mind 357 380 C PARAMETERs for the interpolation of the child grids -
trunk/AGRIF/AGRIF_FILES/modupdate.F
r898 r1200 68 68 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 69 69 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 70 INTEGER :: deb,fin! Positions where interpolations70 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 71 71 ! are done on the fine grid 72 72 External :: procname … … 86 86 C 87 87 C 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 89 92 90 93 C childtemp % var % list_update => child%var%list_update … … 129 132 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 130 133 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 131 INTEGER :: deb,fin ! Positions where interpolations134 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 132 135 ! are done on the fine grid 133 136 … … 151 154 C 152 155 C 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 154 160 155 161 C childtemp % var % list_update => child%var%list_update … … 191 197 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 192 198 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 193 INTEGER :: deb,fin! Positions where interpolations199 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 194 200 ! are done on the fine grid 195 201 External :: procname … … 215 221 childtemp % var % array3 => tab 216 222 223 childtemp % var % lb = child % var % lb 224 childtemp % var % ub = child % var % ub 225 226 217 227 C childtemp % var % list_update => child%var%list_update 218 228 C … … 253 263 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 254 264 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 255 INTEGER :: deb,fin! Positions where interpolations265 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 256 266 ! are done on the fine grid 257 267 External :: procname … … 277 287 childtemp % var % array4 => tab 278 288 289 childtemp % var % lb = child % var % lb 290 childtemp % var % ub = child % var % ub 291 292 279 293 C childtemp % var % list_update => child%var%list_update 280 294 … … 316 330 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 317 331 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 318 INTEGER :: deb,fin! Positions where interpolations332 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 319 333 ! are done on the fine grid 320 334 External :: procname … … 342 356 childtemp % var % array5 => tab 343 357 358 childtemp % var % lb = child % var % lb 359 childtemp % var % ub = child % var % ub 360 344 361 C childtemp % var % list_update => child%var%list_update 345 362 C … … 381 398 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 382 399 TYPE(AGRIF_PVariable) :: childtemp ! Temporary variable on the child 383 INTEGER :: deb,fin! Positions where interpolations400 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 384 401 ! are done on the fine grid 385 402 REAL, DIMENSION( … … 404 421 C Values on the current grid used for the update 405 422 childtemp % var % array6 => tab 423 424 childtemp % var % lb = child % var % lb 425 childtemp % var % ub = child % var % ub 426 406 427 C childtemp % var % list_update => child%var%list_update 407 428 C … … 439 460 TYPE(AGRIF_PVariable) :: parent ! Variable on the parent grid 440 461 TYPE(AGRIF_PVariable) :: child ! Variable on the child grid 441 INTEGER :: deb,fin ! Positions where boundary conditions462 INTEGER, DIMENSION(6) :: deb,fin ! Positions where interpolations 442 463 ! are calculated 443 464 External :: procname … … 532 553 533 554 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 542 562 543 563 IF (present(procname)) THEN … … 620 640 TYPE(AGRIF_PVariable) :: child ! Variable on the child 621 641 ! grid 622 INTEGER :: deb, fin642 INTEGER, DIMENSION(6) :: deb, fin 623 643 INTEGER :: nbdim ! Number of dimensions of 624 644 ! the grid variable … … 677 697 ENDIF 678 698 679 IF (deb > fin) THEN680 debloc = deb 681 finloc = finloc - deb 699 IF (deb(i) > fin(i)) THEN 700 debloc = deb(i) 701 finloc = finloc - deb(i) 682 702 ENDIF 683 703 … … 810 830 TYPE(AGRIF_PVariable) :: child ! Variable on the child 811 831 ! grid 812 INTEGER :: deb,fin ! Positions where 813 ! interpolations are done 832 INTEGER, DIMENSION(6) :: deb, fin 814 833 INTEGER :: nbdim ! Number of dimensions of 815 834 ! the grid variable … … 859 878 DO i = 1, nbdim 860 879 coeffraf = nint(ds_Parent(i)/ds_Child(i)) 861 indtab(i,1,1) = pttab_child(i) + (deb + 1) * coeffraf862 indtab(i,1,2) = pttab_child(i) + (fin + 1) * coeffraf880 indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf 881 indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf 863 882 864 883 indtab(i,2,1) = pttab_child(i) + nbtab_child(i) 865 & - (fin + 1) * coeffraf884 & - (fin(i) + 1) * coeffraf 866 885 indtab(i,2,2) = pttab_child(i) + nbtab_child(i) 867 & - (deb + 1) * coeffraf886 & - (deb(i) + 1) * coeffraf 868 887 869 888 IF (posvartab_child(i) == 1) THEN
Note: See TracChangeset
for help on using the changeset viewer.
