Changeset 1200 for trunk/AGRIF/AGRIF_FILES/modbc.F
- Timestamp:
- 2008-09-24T15:05:20+02:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.