Changeset 13924 for vendors/AGRIF
- Timestamp:
- 2020-11-30T16:04:35+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modinterpbasic.F90
r13027 r13924 37 37 real, dimension(:), allocatable :: tabtest4 38 38 real, dimension(:,:), allocatable :: coeffparent 39 integer, dimension(:,:), allocatable :: indparent39 integer, private, dimension(:,:), allocatable :: indparent 40 40 integer, dimension(:,:), allocatable :: indparentppm, indchildppm 41 41 integer, dimension(:), allocatable :: indparentppm_1d, indchildppm_1d … … 56 56 integer, intent(in) :: np !< Length of input array 57 57 integer, intent(in) :: nc !< Length of output array 58 real , intent(in) :: s_parent !< Parent grid position (s_root = 0)59 real , intent(in) :: s_child !< Child grid position (s_root = 0)60 real , intent(in) :: ds_parent !< Parent grid dx (ds_root = 1)61 real , intent(in) :: ds_child !< Child grid dx (ds_root = 1)58 real(kind=8), intent(in) :: s_parent !< Parent grid position (s_root = 0) 59 real(kind=8), intent(in) :: s_child !< Child grid position (s_root = 0) 60 real(kind=8), intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) 61 real(kind=8), intent(in) :: ds_child !< Child grid dx (ds_root = 1) 62 62 ! 63 63 integer :: i, coeffraf, locind_parent_left 64 real :: globind_parent_left, globind_parent_right65 real :: invds, invds2, ypos, ypos2, diff64 real(kind=8) :: globind_parent_left, globind_parent_right 65 real(kind=8) :: invds, invds2, ypos, ypos2, diff 66 66 ! 67 67 coeffraf = nint(ds_parent/ds_child) … … 92 92 ! 93 93 diff = globind_parent_right - ypos2 94 ! quick fix for roundoff error 95 diff=nint(diff*coeffraf)/real(coeffraf) 96 94 97 y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1)) 95 98 ypos2 = ypos2 + invds2 … … 104 107 else 105 108 globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent 106 y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left) & 107 + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds 109 diff=(globind_parent_left + ds_parent - ypos)*invds 110 111 ! quick fix for roundoff error 112 diff=nint(diff*coeffraf)/real(coeffraf) 113 ! y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left) & 114 ! + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds 115 y(nc) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1)) 108 116 endif 109 117 !--------------------------------------------------------------------------------------------------- … … 120 128 !--------------------------------------------------------------------------------------------------- 121 129 integer, intent(in) :: np,nc,np2 122 real , intent(in) :: s_parent, s_child123 real , intent(in) :: ds_parent, ds_child130 real(kind=8), intent(in) :: s_parent, s_child 131 real(kind=8), intent(in) :: ds_parent, ds_child 124 132 integer, intent(in) :: dir 125 133 ! … … 127 135 integer, dimension(:,:), allocatable :: indparent_tmp 128 136 real, dimension(:,:), allocatable :: coeffparent_tmp 129 real :: ypos,globind_parent_left,globind_parent_right130 real :: invds, invds2, invds3131 real :: ypos2,diff137 real(kind=8) :: ypos,globind_parent_left,globind_parent_right 138 real(kind=8) :: invds, invds2, invds3 139 real(kind=8) :: ypos2,diff 132 140 ! 133 141 coeffraf = nint(ds_parent/ds_child) … … 164 172 if (ypos2 > globind_parent_right) then 165 173 locind_parent_left = locind_parent_left + 1 166 globind_parent_right = globind_parent_right + 1. 174 globind_parent_right = globind_parent_right + 1.d0 167 175 ypos2 = ypos*invds+(i-1)*invds2 168 176 endif … … 246 254 real, dimension(np), intent(in) :: x 247 255 real, dimension(nc), intent(out) :: y 248 real , intent(in) :: s_parent, s_child249 real , intent(in) :: ds_parent, ds_child256 real(kind=8), intent(in) :: s_parent, s_child 257 real(kind=8), intent(in) :: ds_parent, ds_child 250 258 ! 251 259 integer :: i, coeffraf, locind_parent_left 252 real :: ypos,globind_parent_left253 real :: deltax, invdsparent260 real(kind=8) :: ypos,globind_parent_left 261 real(kind=8) :: deltax, invdsparent 254 262 real :: t2,t3,t4,t5,t6,t7,t8 255 263 ! … … 311 319 real, dimension(np), intent(in) :: x 312 320 real, dimension(nc), intent(out) :: y 313 real , intent(in) :: s_parent, s_child314 real , intent(in) :: ds_parent, ds_child321 real(kind=8), intent(in) :: s_parent, s_child 322 real(kind=8), intent(in) :: ds_parent, ds_child 315 323 ! 316 324 integer :: i, coeffraf, locind_parent 317 real :: ypos325 real(kind=8) :: ypos 318 326 ! 319 327 coeffraf = nint(ds_parent/ds_child) … … 349 357 real, dimension(np), intent(in) :: x 350 358 real, dimension(nc), intent(out) :: y 351 real , intent(in) :: s_parent, s_child352 real , intent(in) :: ds_parent, ds_child359 real(kind=8), intent(in) :: s_parent, s_child 360 real(kind=8), intent(in) :: ds_parent, ds_child 353 361 ! 354 362 real, dimension(:), allocatable :: ytemp 355 363 integer :: i,coeffraf,locind_parent_left,locind_parent_last 356 real :: ypos,xdiffmod,xpmin,xpmax,slope364 real(kind=8) :: ypos,xdiffmod,xpmin,xpmax,slope 357 365 integer :: i1,i2,ii 358 366 integer :: diffmod … … 393 401 394 402 do ii = i-coeffraf/2+diffmod,i+coeffraf/2 395 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope403 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 396 404 enddo 397 405 … … 401 409 slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf) 402 410 do ii = i-coeffraf/2+diffmod,i+coeffraf/2 403 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope411 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 404 412 enddo 405 413 locind_parent_left = locind_parent_left + 1 … … 415 423 416 424 do ii = i-coeffraf/2+diffmod,nc 417 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope425 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 418 426 enddo 419 427 ! … … 436 444 real, dimension(np), intent(in) :: x 437 445 real, dimension(nc), intent(out) :: y 438 real , intent(in) :: s_parent, s_child439 real , intent(in) :: ds_parent, ds_child446 real(kind=8), intent(in) :: s_parent, s_child 447 real(kind=8), intent(in) :: ds_parent, ds_child 440 448 ! 441 449 real, dimension(:), allocatable :: ytemp 442 450 integer :: i,coeffraf,locind_parent_left,locind_parent_last 443 real :: ypos,xdiffmod,xpmin,xpmax,slope451 real(kind=8) :: ypos,xdiffmod,xpmin,xpmax,slope 444 452 integer :: i1,i2,ii 445 453 integer :: diffmod … … 486 494 487 495 do ii = i-coeffraf/2+diffmod,i+coeffraf/2 488 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope496 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 489 497 enddo 490 498 … … 495 503 slope = slope / coeffraf 496 504 do ii=i-coeffraf/2+diffmod,i+coeffraf/2 497 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope505 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 498 506 enddo 499 507 locind_parent_left = locind_parent_left + 1 … … 510 518 511 519 do ii=i-coeffraf/2+diffmod,nc 512 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod /2.)*slope520 ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope 513 521 enddo 514 522 ! … … 531 539 real, dimension(np), intent(in) :: x 532 540 real, dimension(nc), intent(out) :: y 533 real , intent(in) :: s_parent, s_child534 real , intent(in) :: ds_parent, ds_child541 real(kind=8), intent(in) :: s_parent, s_child 542 real(kind=8), intent(in) :: ds_parent, ds_child 535 543 ! 536 544 integer :: i,coeffraf,locind_parent_left,locind_parent_last 537 545 integer :: iparent,ipos,pos,nmin,nmax 538 real :: ypos546 real(kind=8) :: ypos 539 547 integer :: i1,jj 540 real :: xpmin,a 548 real(kind=8) :: xpmin 549 real :: a 541 550 ! 542 551 real, dimension(np) :: xl,delta,a6,slope … … 653 662 !--------------------------------------------------------------------------------------------------- 654 663 integer, intent(in) :: np2, np, nc 655 real , intent(in) :: s_parent, s_child656 real , intent(in) :: ds_parent, ds_child664 real(kind=8), intent(in) :: s_parent, s_child 665 real(kind=8), intent(in) :: ds_parent, ds_child 657 666 integer, intent(in) :: dir 658 667 ! … … 663 672 real :: ypos 664 673 integer :: i1,jj 665 real :: xpmin,a 674 real(kind=8) :: xpmin 675 real :: a 666 676 ! 667 677 integer :: diffmod … … 1076 1086 real, dimension(np), intent(in) :: x 1077 1087 real, dimension(nc), intent(out) :: y 1078 real , intent(in) :: s_parent, s_child1079 real , intent(in) :: ds_parent, ds_child1088 real(kind=8), intent(in) :: s_parent, s_child 1089 real(kind=8), intent(in) :: ds_parent, ds_child 1080 1090 ! 1081 1091 real, dimension(:), allocatable :: ytemp 1082 1092 integer :: i,coeffraf,locind_parent_left,locind_parent_last 1083 1093 integer :: iparent,ipos,pos,nmin,nmax 1084 real :: ypos1094 real(kind=8) :: ypos 1085 1095 integer :: i1,jj 1086 real :: xpmin1096 real(kind=8) :: xpmin 1087 1097 ! 1088 1098 real, dimension(np) :: slope … … 1173 1183 real, dimension(np), intent(in) :: x 1174 1184 real, dimension(nc), intent(out) :: y 1175 real , intent(in) :: s_parent, s_child1176 real , intent(in) :: ds_parent, ds_child1185 real(kind=8), intent(in) :: s_parent, s_child 1186 real(kind=8), intent(in) :: ds_parent, ds_child 1177 1187 ! 1178 1188 integer :: i,coeffraf,locind_parent_left,locind_parent_last 1179 1189 integer :: ipos, pos 1180 real :: ypos,xi1190 real(kind=8) :: ypos,xi 1181 1191 integer :: i1,jj 1182 real :: xpmin1192 real(kind=8) :: xpmin 1183 1193 ! 1184 1194 real, dimension(:), allocatable :: ytemp … … 1283 1293 Real, Dimension(nc) :: y 1284 1294 Real, Dimension(:),Allocatable :: ytemp 1285 Real 1295 Real(kind=8) :: s_parent,s_child,ds_parent,ds_child 1286 1296 ! 1287 1297 ! Local scalars 1288 1298 Integer :: i,coeffraf,locind_parent_left,locind_parent_last 1289 1299 Integer :: iparent,ipos,pos,nmin,nmax 1290 Real :: ypos1300 Real(kind=8) :: ypos 1291 1301 integer :: i1,jj 1292 Real :: xpmin,cavg,a,b 1302 Real(kind=8) :: xpmin 1303 real :: cavg,a,b 1293 1304 ! 1294 1305 Real :: xrmin,xrmax,am3,s2,s1
Note: See TracChangeset
for help on using the changeset viewer.
