Ignore:
Timestamp:
2019-02-27T14:55:54+01:00 (19 months ago)
Author:
rblod
Message:

Update agrif library and conv see ticket #2129

File:
1 edited

Legend:

Unmodified
Added
Removed
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modarrays.F90

    r10087 r10725  
    8888        ub_glob_index = ub_var(i) 
    8989#endif 
    90  
    9190        lb_tab_true(i) = max(lb_tab(i), lb_glob_index) 
    9291        ub_tab_true(i) = min(ub_tab(i), ub_glob_index) 
     
    234233    case (1) ; call Agrif_set_array_tozero_1D(variable%array1) 
    235234    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) 
    238236    case (4) ; call Agrif_set_array_tozero_4D(variable%array4) 
    239237    case (5) ; call Agrif_set_array_tozero_5D(variable%array5) 
     
    276274!=================================================================================================== 
    277275! 
    278 !=================================================================================================== 
    279 ! 
    280 !=================================================================================================== 
    281 !  subroutine agrif_set_array_cond 
    282 ! 
    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     !< Variablein 
    288     type(Agrif_Variable), intent(inout) :: variableout    !< Variableout 
    289     real,intent(in) :: value                            !< special value 
    290     integer, intent(in)                 :: nbdim        !< Dimension of the array 
    291  
    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 select 
    302 !--------------------------------------------------------------------------------------------------- 
    303 contains 
    304 !--------------------------------------------------------------------------------------------------- 
    305 subroutine agrif_set_array_cond_1D(arrayin,arrayout,value) 
    306 real,dimension(:),intent(in) :: arrayin 
    307 real,dimension(:),intent(out) :: arrayout 
    308 real :: value 
    309  
    310 where (arrayin == value) 
    311   arrayout = 0. 
    312 elsewhere 
    313   arrayout = 1. 
    314 end where 
    315  
    316 end subroutine agrif_set_array_cond_1D 
    317 ! 
    318 subroutine agrif_set_array_cond_2D(arrayin,arrayout,value) 
    319 real,dimension(:,:),intent(in) :: arrayin 
    320 real,dimension(:,:),intent(out) :: arrayout 
    321 real :: value 
    322  
    323 where (arrayin == value) 
    324   arrayout = 0. 
    325 elsewhere 
    326   arrayout = 1. 
    327 end where 
    328  
    329 end subroutine agrif_set_array_cond_2D 
    330 ! 
    331 subroutine agrif_set_array_cond_3D(arrayin,arrayout,value) 
    332 real,dimension(:,:,:),intent(in) :: arrayin 
    333 real,dimension(:,:,:),intent(out) :: arrayout 
    334 real :: value 
    335  
    336 where (arrayin == value) 
    337   arrayout = 0. 
    338 elsewhere 
    339   arrayout = 1. 
    340 end where 
    341  
    342 end subroutine agrif_set_array_cond_3D 
    343 ! 
    344 subroutine agrif_set_array_cond_4D(arrayin,arrayout,value) 
    345 real,dimension(:,:,:,:),intent(in) :: arrayin 
    346 real,dimension(:,:,:,:),intent(out) :: arrayout 
    347 real :: value 
    348  
    349 where (arrayin == value) 
    350   arrayout = 0. 
    351 elsewhere 
    352   arrayout = 1. 
    353 end where 
    354  
    355 end subroutine agrif_set_array_cond_4D 
    356 ! 
    357 subroutine agrif_set_array_cond_5D(arrayin,arrayout,value) 
    358 real,dimension(:,:,:,:,:),intent(in) :: arrayin 
    359 real,dimension(:,:,:,:,:),intent(out) :: arrayout 
    360 real :: value 
    361  
    362 where (arrayin == value) 
    363   arrayout = 0. 
    364 elsewhere 
    365   arrayout = 1. 
    366 end where 
    367  
    368 end subroutine agrif_set_array_cond_5D 
    369 ! 
    370 subroutine agrif_set_array_cond_6D(arrayin,arrayout,value) 
    371 real,dimension(:,:,:,:,:,:),intent(in) :: arrayin 
    372 real,dimension(:,:,:,:,:,:),intent(out) :: arrayout 
    373 real :: value 
    374  
    375 where (arrayin == value) 
    376   arrayout = 0. 
    377 elsewhere 
    378   arrayout = 1. 
    379 end where 
    380  
    381 end subroutine agrif_set_array_cond_6D 
    382 !--------------------------------------------------------------------------------------------------- 
    383 end subroutine agrif_set_array_cond 
    384276!=================================================================================================== 
    385277!  subroutine Agrif_var_copy_array 
     
    446338        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout 
    447339        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)) 
    470345    end subroutine Agrif_copy_array_3d 
    471346! 
     
    764639    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid 
    765640    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) 
    770645    integer,               intent(out)          :: nbdim        !< Number of dimensions 
    771646    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n 
     
    804679            else 
    805680                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1 
    806                 s_child(n)  = s_child(n)  + 0.5d0*ds_child(n) 
    807                 s_parent(n) = s_parent(n) + 0.5d0*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) 
    808683            endif 
    809684! 
     
    822697            else 
    823698                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1 
    824                 s_child(n)  = s_child(n)  + 0.5d0*ds_child(n) 
    825                 s_parent(n) = s_parent(n) + 0.5d0*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) 
    826701            endif 
    827702! 
     
    860735!           No interpolation but only a copy of the values of the grid variable 
    861736            lb_parent(n) = lb_child(n) 
    862             s_child(n)   = 0.d0 
    863             s_parent(n)  = 0.d0 
    864             ds_child(n)  = 1.d0 
    865             ds_parent(n) = 1.d0 
     737            s_child(n)   = 0. 
     738            s_parent(n)  = 0. 
     739            ds_child(n)  = 1. 
     740            ds_parent(n) = 1. 
    866741! 
    867742        end select 
     
    966841! 
    967842end module Agrif_Arrays 
    968  
    969  
    970 subroutine agrif_set_array_cond_reshape(arrayin,arrayout,value,n) 
    971 integer :: n 
    972 real,dimension(n) :: arrayin,arrayout 
    973 real :: value 
    974  
    975 integer :: i 
    976  
    977 do i=1,n 
    978   if (arrayin(i) == value) then 
    979     arrayout(i) = 0. 
    980   else 
    981     arrayout(i) = 1. 
    982   endif 
    983 enddo 
    984  
    985 end subroutine agrif_set_array_cond_reshape 
    986  
    987 subroutine agrif_set_array_tozero_reshape(array,n) 
    988 integer :: n 
    989 real,dimension(n) :: array 
    990  
    991 integer :: i 
    992  
    993 !$OMP PARALLEL DO DEFAULT(none) PRIVATE(i) & 
    994 !$OMP SHARED(array,n) 
    995 do i=1,n 
    996     array(i) = 0. 
    997 enddo 
    998 !$OMP END PARALLEL DO 
    999  
    1000 end subroutine agrif_set_array_tozero_reshape 
Note: See TracChangeset for help on using the changeset viewer.