Changeset 10725 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdatebasic.F90
- Timestamp:
- 2019-02-27T14:55:54+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdatebasic.F90
r10087 r10725 49 49 integer, intent(in) :: np !< Length of parent array 50 50 integer, intent(in) :: nc !< Length of child array 51 real (kind=8),intent(in) :: s_parent !< Parent grid position (s_root = 0)52 real (kind=8),intent(in) :: s_child !< Child grid position (s_root = 0)53 real (kind=8),intent(in) :: ds_parent !< Parent grid dx (ds_root = 1)54 real (kind=8),intent(in) :: ds_child !< Child grid dx (ds_root = 1)51 real, intent(in) :: s_parent !< Parent grid position (s_root = 0) 52 real, intent(in) :: s_child !< Child grid position (s_root = 0) 53 real, intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) 54 real, intent(in) :: ds_child !< Child grid dx (ds_root = 1) 55 55 !--------------------------------------------------------------------------------------------------- 56 56 integer :: i, locind_child_left, coeffraf … … 84 84 integer, intent(in) :: np !< Length of parent array 85 85 integer, intent(in) :: nc !< Length of child array 86 real (kind=8),intent(in) :: s_parent !< Parent grid position (s_root = 0)87 real (kind=8),intent(in) :: s_child !< Child grid position (s_root = 0)88 real (kind=8),intent(in) :: ds_parent !< Parent grid dx (ds_root = 1)89 real (kind=8),intent(in) :: ds_child !< Child grid dx (ds_root = 1)86 real, intent(in) :: s_parent !< Parent grid position (s_root = 0) 87 real, intent(in) :: s_child !< Child grid position (s_root = 0) 88 real, intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) 89 real, intent(in) :: ds_child !< Child grid dx (ds_root = 1) 90 90 integer, intent(in) :: dir !< Direction 91 91 !--------------------------------------------------------------------------------------------------- … … 157 157 REAL, DIMENSION(nc), intent(in) :: y 158 158 INTEGER, intent(in) :: np,nc 159 REAL (kind=8),intent(in) :: s_parent, s_child160 REAL (kind=8),intent(in) :: ds_parent, ds_child159 REAL, intent(in) :: s_parent, s_child 160 REAL, intent(in) :: ds_parent, ds_child 161 161 ! 162 162 INTEGER :: i, ii, locind_child_left, coeffraf 163 REAL(kind=8) :: xpos 164 REAL :: invcoeffraf 163 REAL :: xpos, invcoeffraf 165 164 INTEGER :: nbnonnuls 166 165 INTEGER :: diffmod … … 221 220 end subroutine Agrif_basicupdate_average1d 222 221 !=================================================================================================== 222 223 !=================================================================================================== 224 ! subroutine Agrif_basicupdate_max1d 225 ! 226 !> Carries out an update by taking the maximum on a parent grid (vector x)from its child grid (vector y). 227 !--------------------------------------------------------------------------------------------------- 228 subroutine Agrif_basicupdate_max1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) 229 !--------------------------------------------------------------------------------------------------- 230 REAL, DIMENSION(np), intent(out) :: x 231 REAL, DIMENSION(nc), intent(in) :: y 232 INTEGER, intent(in) :: np,nc 233 REAL, intent(in) :: s_parent, s_child 234 REAL, intent(in) :: ds_parent, ds_child 235 ! 236 INTEGER :: i, ii, locind_child_left, coeffraf 237 REAL :: xpos, invcoeffraf 238 INTEGER :: nbnonnuls 239 INTEGER :: diffmod 240 ! 241 coeffraf = nint(ds_parent/ds_child) 242 invcoeffraf = 1./coeffraf 243 ! 244 if (coeffraf == 1) then 245 locind_child_left = 1 + nint((s_parent - s_child)/ds_child) 246 x(1:np) = y(locind_child_left:locind_child_left+np-1) 247 return 248 endif 249 ! 250 xpos = s_parent 251 x = -HUGE(1.0) 252 ! 253 diffmod = 0 254 ! 255 IF ( mod(coeffraf,2) == 0 ) diffmod = 1 256 ! 257 locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child) 258 ! 259 IF (Agrif_UseSpecialValueInUpdate) THEN 260 do i = 1,np 261 nbnonnuls = 0 262 !CDIR NOVECTOR 263 do ii = -coeffraf/2+locind_child_left+diffmod, & 264 coeffraf/2+locind_child_left 265 IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN 266 x(i) = max(x(i),y(ii)) 267 ENDIF 268 enddo 269 locind_child_left = locind_child_left + coeffraf 270 enddo 271 ELSE 272 ! 273 !CDIR ALTCODE 274 do i = 1,np 275 !CDIR NOVECTOR 276 do ii = -coeffraf/2+locind_child_left+diffmod, & 277 coeffraf/2+locind_child_left 278 x(i) = max(x(i),y(ii)) 279 enddo 280 locind_child_left = locind_child_left + coeffraf 281 enddo 282 ENDIF 283 !--------------------------------------------------------------------------------------------------- 284 end subroutine Agrif_basicupdate_max1d 285 !=================================================================================================== 286 223 287 ! 224 288 !=================================================================================================== … … 230 294 !--------------------------------------------------------------------------------------------------- 231 295 INTEGER, intent(in) :: nc2, np, nc 232 REAL (kind=8), intent(in) :: s_parent, s_child233 REAL (kind=8), intent(in) :: ds_parent, ds_child296 REAL, intent(in) :: s_parent, s_child 297 REAL, intent(in) :: ds_parent, ds_child 234 298 INTEGER, intent(in) :: dir 235 299 ! 236 300 INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp 237 301 INTEGER :: i, locind_child_left, coeffraf 238 REAL (kind=8):: xpos302 REAL :: xpos 239 303 INTEGER :: diffmod 240 304 ! … … 282 346 REAL, DIMENSION(nc), intent(in) :: y 283 347 INTEGER, intent(in) :: np, nc 284 REAL (kind=8), intent(in) :: s_parent, s_child285 REAL (kind=8), intent(in) :: ds_parent, ds_child348 REAL, intent(in) :: s_parent, s_child 349 REAL, intent(in) :: ds_parent, ds_child 286 350 INTEGER, intent(in) :: dir 287 351 ! … … 312 376 ELSE 313 377 ! 314 315 do i = 1,np 316 do j = 1,coeffraf 378 !CDIR NOLOOPCHG 379 do j = 1,coeffraf 380 !CDIR VECTOR 381 do i= 1,np 317 382 x(i) = x(i) + y(indchildaverage(i,dir) + j-1 ) 318 enddo383 enddo 319 384 enddo 320 385 IF (.not.Agrif_Update_Weights) THEN … … 338 403 real, dimension(nc), intent(in) :: y 339 404 integer, intent(in) :: np, nc 340 real (kind=8), intent(in) :: s_parent, s_child341 real (kind=8), intent(in) :: ds_parent, ds_child342 !--------------------------------------------------------------------------------------------------- 343 REAL (kind=8):: xpos, xposfin405 real, intent(in) :: s_parent, s_child 406 real, intent(in) :: ds_parent, ds_child 407 !--------------------------------------------------------------------------------------------------- 408 REAL :: xpos, xposfin 344 409 INTEGER :: i, ii, diffmod 345 410 INTEGER :: it1, it2
Note: See TracChangeset
for help on using the changeset viewer.
