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/modupdatebasic.F90

    r10087 r10725  
    4949    integer,             intent(in)     :: np           !< Length of parent array 
    5050    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) 
    5555!--------------------------------------------------------------------------------------------------- 
    5656    integer :: i, locind_child_left, coeffraf 
     
    8484    integer,             intent(in)     :: np           !< Length of parent array 
    8585    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) 
    9090    integer,             intent(in)     :: dir          !< Direction 
    9191!--------------------------------------------------------------------------------------------------- 
     
    157157    REAL, DIMENSION(nc), intent(in)     :: y 
    158158    INTEGER,             intent(in)     :: np,nc 
    159     REAL(kind=8),        intent(in)     :: s_parent,  s_child 
    160     REAL(kind=8),        intent(in)     :: ds_parent, ds_child 
     159    REAL,                intent(in)     :: s_parent,  s_child 
     160    REAL,                intent(in)     :: ds_parent, ds_child 
    161161! 
    162162    INTEGER :: i, ii, locind_child_left, coeffraf 
    163     REAL(kind=8)    :: xpos 
    164     REAL ::  invcoeffraf 
     163    REAL    :: xpos, invcoeffraf 
    165164    INTEGER :: nbnonnuls 
    166165    INTEGER :: diffmod 
     
    221220end subroutine Agrif_basicupdate_average1d 
    222221!=================================================================================================== 
     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!--------------------------------------------------------------------------------------------------- 
     228subroutine 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!--------------------------------------------------------------------------------------------------- 
     284end subroutine Agrif_basicupdate_max1d 
     285!=================================================================================================== 
     286 
    223287! 
    224288!=================================================================================================== 
     
    230294!--------------------------------------------------------------------------------------------------- 
    231295    INTEGER, intent(in) :: nc2, np, nc 
    232     REAL(kind=8),    intent(in) :: s_parent,  s_child 
    233     REAL(kind=8),    intent(in) :: ds_parent, ds_child 
     296    REAL,    intent(in) :: s_parent,  s_child 
     297    REAL,    intent(in) :: ds_parent, ds_child 
    234298    INTEGER, intent(in) :: dir 
    235299! 
    236300    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp 
    237301    INTEGER :: i, locind_child_left, coeffraf 
    238     REAL(kind=8)    :: xpos 
     302    REAL    :: xpos 
    239303    INTEGER :: diffmod 
    240304! 
     
    282346    REAL, DIMENSION(nc), intent(in)     :: y 
    283347    INTEGER,             intent(in)     :: np, nc 
    284     REAL(kind=8),                intent(in)     :: s_parent,  s_child 
    285     REAL(kind=8),                intent(in)     :: ds_parent, ds_child 
     348    REAL,                intent(in)     :: s_parent,  s_child 
     349    REAL,                intent(in)     :: ds_parent, ds_child 
    286350    INTEGER,             intent(in)     :: dir 
    287351! 
     
    312376    ELSE 
    313377! 
    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 
    317382                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 ) 
    318         enddo 
     383            enddo 
    319384        enddo 
    320385        IF (.not.Agrif_Update_Weights) THEN 
     
    338403    real, dimension(nc), intent(in)     :: y 
    339404    integer,             intent(in)     :: np, nc 
    340     real(kind=8),                intent(in)     :: s_parent,  s_child 
    341     real(kind=8),                intent(in)     :: ds_parent, ds_child 
    342 !--------------------------------------------------------------------------------------------------- 
    343     REAL(kind=8)    :: xpos, xposfin 
     405    real,                intent(in)     :: s_parent,  s_child 
     406    real,                intent(in)     :: ds_parent, ds_child 
     407!--------------------------------------------------------------------------------------------------- 
     408    REAL    :: xpos, xposfin 
    344409    INTEGER :: i, ii, diffmod 
    345410    INTEGER :: it1, it2 
Note: See TracChangeset for help on using the changeset viewer.