Changeset 10725 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modarrays.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/modarrays.F90
r10087 r10725 88 88 ub_glob_index = ub_var(i) 89 89 #endif 90 91 90 lb_tab_true(i) = max(lb_tab(i), lb_glob_index) 92 91 ub_tab_true(i) = min(ub_tab(i), ub_glob_index) … … 234 233 case (1) ; call Agrif_set_array_tozero_1D(variable%array1) 235 234 case (2) ; call Agrif_set_array_tozero_2D(variable%array2) 236 case (3) ; call Agrif_set_array_tozero_reshape(variable%array3,size(variable%array3)) 237 !case (3) ; call Agrif_set_array_tozero_3D(variable%array3) 235 case (3) ; call Agrif_set_array_tozero_3D(variable%array3) 238 236 case (4) ; call Agrif_set_array_tozero_4D(variable%array4) 239 237 case (5) ; call Agrif_set_array_tozero_5D(variable%array5) … … 276 274 !=================================================================================================== 277 275 ! 278 !===================================================================================================279 !280 !===================================================================================================281 ! subroutine agrif_set_array_cond282 !283 !> Compute the masking of \b variablein, according to the required dimension.284 !---------------------------------------------------------------------------------------------------285 subroutine agrif_set_array_cond ( variablein, variableout, value, nbdim )286 !---------------------------------------------------------------------------------------------------287 type(Agrif_Variable), intent(in) :: variablein !< Variablein288 type(Agrif_Variable), intent(inout) :: variableout !< Variableout289 real,intent(in) :: value !< special value290 integer, intent(in) :: nbdim !< Dimension of the array291 292 !293 select case (nbdim)294 case (1) ; call agrif_set_array_cond_1D(variablein%array1,variableout%array1,value)295 case (2) ; call agrif_set_array_cond_2D(variablein%array2,variableout%array2,value)296 case (3) ; call agrif_set_array_cond_reshape(variablein%array3,variableout%array3,value,size(variablein%array3))297 ! case (3) ; call agrif_set_array_cond_3D(variablein%array3,variableout%array3,value)298 case (4) ; call agrif_set_array_cond_4D(variablein%array4,variableout%array4,value)299 case (5) ; call agrif_set_array_cond_5D(variablein%array5,variableout%array5,value)300 case (6) ; call agrif_set_array_cond_6D(variablein%array6,variableout%array6,value)301 end select302 !---------------------------------------------------------------------------------------------------303 contains304 !---------------------------------------------------------------------------------------------------305 subroutine agrif_set_array_cond_1D(arrayin,arrayout,value)306 real,dimension(:),intent(in) :: arrayin307 real,dimension(:),intent(out) :: arrayout308 real :: value309 310 where (arrayin == value)311 arrayout = 0.312 elsewhere313 arrayout = 1.314 end where315 316 end subroutine agrif_set_array_cond_1D317 !318 subroutine agrif_set_array_cond_2D(arrayin,arrayout,value)319 real,dimension(:,:),intent(in) :: arrayin320 real,dimension(:,:),intent(out) :: arrayout321 real :: value322 323 where (arrayin == value)324 arrayout = 0.325 elsewhere326 arrayout = 1.327 end where328 329 end subroutine agrif_set_array_cond_2D330 !331 subroutine agrif_set_array_cond_3D(arrayin,arrayout,value)332 real,dimension(:,:,:),intent(in) :: arrayin333 real,dimension(:,:,:),intent(out) :: arrayout334 real :: value335 336 where (arrayin == value)337 arrayout = 0.338 elsewhere339 arrayout = 1.340 end where341 342 end subroutine agrif_set_array_cond_3D343 !344 subroutine agrif_set_array_cond_4D(arrayin,arrayout,value)345 real,dimension(:,:,:,:),intent(in) :: arrayin346 real,dimension(:,:,:,:),intent(out) :: arrayout347 real :: value348 349 where (arrayin == value)350 arrayout = 0.351 elsewhere352 arrayout = 1.353 end where354 355 end subroutine agrif_set_array_cond_4D356 !357 subroutine agrif_set_array_cond_5D(arrayin,arrayout,value)358 real,dimension(:,:,:,:,:),intent(in) :: arrayin359 real,dimension(:,:,:,:,:),intent(out) :: arrayout360 real :: value361 362 where (arrayin == value)363 arrayout = 0.364 elsewhere365 arrayout = 1.366 end where367 368 end subroutine agrif_set_array_cond_5D369 !370 subroutine agrif_set_array_cond_6D(arrayin,arrayout,value)371 real,dimension(:,:,:,:,:,:),intent(in) :: arrayin372 real,dimension(:,:,:,:,:,:),intent(out) :: arrayout373 real :: value374 375 where (arrayin == value)376 arrayout = 0.377 elsewhere378 arrayout = 1.379 end where380 381 end subroutine agrif_set_array_cond_6D382 !---------------------------------------------------------------------------------------------------383 end subroutine agrif_set_array_cond384 276 !=================================================================================================== 385 277 ! subroutine Agrif_var_copy_array … … 446 338 real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout 447 339 real, dimension(m(1):,m(2):,m(3):), intent(in) :: tabin 448 integer :: i,j,k 449 450 451 !$OMP PARALLEL DO DEFAULT(none) PRIVATE(i,j,k) & 452 !$OMP SHARED(inf1,inf2,sup1,sup2,tabin,tabout) & 453 !$OMP SCHEDULE(RUNTIME) 454 do k=inf1(3),sup1(3) 455 do j=inf1(2),sup1(2) 456 do i=inf1(1),sup1(1) 457 ! tabout(i,j,k) = tabin(i+inf2(1)-inf1(1),j+inf2(2)-inf1(2),k+inf2(3)-inf1(3)) 458 tabout(i,j,k) = tabin(i,j,k) 459 enddo 460 enddo 461 enddo 462 !$OMP END PARALLEL DO 463 464 465 ! tabout(inf1(1):sup1(1), & 466 ! inf1(2):sup1(2), & 467 ! inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), & 468 ! inf2(2):sup2(2), & 469 ! inf2(3):sup2(3)) 340 tabout(inf1(1):sup1(1), & 341 inf1(2):sup1(2), & 342 inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), & 343 inf2(2):sup2(2), & 344 inf2(3):sup2(3)) 470 345 end subroutine Agrif_copy_array_3d 471 346 ! … … 764 639 integer, dimension(6), intent(out) :: lb_child !< Lower bound on the child grid 765 640 integer, dimension(6), intent(out) :: lb_parent !< Lower bound on the parent grid 766 real (kind=8), dimension(6), intent(out):: s_child !< Child grid position (s_root = 0)767 real (kind=8), dimension(6), intent(out):: s_parent !< Parent grid position (s_root = 0)768 real (kind=8), dimension(6), intent(out):: ds_child !< Child grid dx (ds_root = 1)769 real (kind=8), dimension(6), intent(out):: ds_parent !< Parent grid dx (ds_root = 1)641 real, dimension(6), intent(out) :: s_child !< Child grid position (s_root = 0) 642 real, dimension(6), intent(out) :: s_parent !< Parent grid position (s_root = 0) 643 real, dimension(6), intent(out) :: ds_child !< Child grid dx (ds_root = 1) 644 real, dimension(6), intent(out) :: ds_parent !< Parent grid dx (ds_root = 1) 770 645 integer, intent(out) :: nbdim !< Number of dimensions 771 646 logical, intent(in) :: interp !< .true. if preprocess for interpolation, \n … … 804 679 else 805 680 ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1 806 s_child(n) = s_child(n) + 0.5 d0*ds_child(n)807 s_parent(n) = s_parent(n) + 0.5 d0*ds_parent(n)681 s_child(n) = s_child(n) + 0.5*ds_child(n) 682 s_parent(n) = s_parent(n) + 0.5*ds_parent(n) 808 683 endif 809 684 ! … … 822 697 else 823 698 ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1 824 s_child(n) = s_child(n) + 0.5 d0*ds_child(n)825 s_parent(n) = s_parent(n) + 0.5 d0*ds_parent(n)699 s_child(n) = s_child(n) + 0.5*ds_child(n) 700 s_parent(n) = s_parent(n) + 0.5*ds_parent(n) 826 701 endif 827 702 ! … … 860 735 ! No interpolation but only a copy of the values of the grid variable 861 736 lb_parent(n) = lb_child(n) 862 s_child(n) = 0. d0863 s_parent(n) = 0. d0864 ds_child(n) = 1. d0865 ds_parent(n) = 1. d0737 s_child(n) = 0. 738 s_parent(n) = 0. 739 ds_child(n) = 1. 740 ds_parent(n) = 1. 866 741 ! 867 742 end select … … 966 841 ! 967 842 end module Agrif_Arrays 968 969 970 subroutine agrif_set_array_cond_reshape(arrayin,arrayout,value,n)971 integer :: n972 real,dimension(n) :: arrayin,arrayout973 real :: value974 975 integer :: i976 977 do i=1,n978 if (arrayin(i) == value) then979 arrayout(i) = 0.980 else981 arrayout(i) = 1.982 endif983 enddo984 985 end subroutine agrif_set_array_cond_reshape986 987 subroutine agrif_set_array_tozero_reshape(array,n)988 integer :: n989 real,dimension(n) :: array990 991 integer :: i992 993 !$OMP PARALLEL DO DEFAULT(none) PRIVATE(i) &994 !$OMP SHARED(array,n)995 do i=1,n996 array(i) = 0.997 enddo998 !$OMP END PARALLEL DO999 1000 end subroutine agrif_set_array_tozero_reshape
Note: See TracChangeset
for help on using the changeset viewer.
