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

    r10087 r10725  
    2929    implicit none 
    3030! 
     31 
     32    interface Agrif_Parent 
     33        module procedure Agrif_Parent_Real_4,   & 
     34                         Agrif_Parent_Real_8,   & 
     35                         Agrif_Parent_Array2_Real_8,   & 
     36                         Agrif_Parent_Integer, & 
     37                         Agrif_Parent_Character, & 
     38                         Agrif_Parent_Logical 
     39    end interface 
     40     
    3141contains 
    3242! 
     
    92102! 
    93103    rhot = float(Agrif_IRhot()) 
    94      
    95104!--------------------------------------------------------------------------------------------------- 
    96105end function Agrif_Rhot 
     
    764773!=================================================================================================== 
    765774! 
     775 
     776function Agrif_Parent_Real_4(real_variable) result(real_variable_parent) 
     777real(KIND=4) :: real_variable 
     778real(KIND=4) :: real_variable_parent 
     779 
     780integer :: i 
     781logical :: i_found 
     782 
     783i_found = .FALSE. 
     784 
     785do i=1,Agrif_NbVariables(2) 
     786  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     787     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 
     788     i_found = .TRUE. 
     789     EXIT 
     790  endif 
     791enddo 
     792 
     793IF (.NOT.i_found) THEN 
     794do i=1,Agrif_NbVariables(2) 
     795  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then 
     796     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0 
     797     i_found = .TRUE. 
     798     EXIT 
     799  endif 
     800enddo 
     801ENDIF 
     802 
     803if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found' 
     804 
     805end function Agrif_Parent_Real_4 
     806 
     807function Agrif_Parent_Real_8(real_variable) result(real_variable_parent) 
     808real(KIND=8) :: real_variable 
     809real(KIND=8) :: real_variable_parent 
     810 
     811integer :: i 
     812logical :: i_found 
     813 
     814i_found = .FALSE. 
     815 
     816do i=1,Agrif_NbVariables(2) 
     817  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then 
     818     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 
     819     i_found = .TRUE. 
     820     EXIT 
     821  endif 
     822enddo 
     823 
     824IF (.NOT.i_found) THEN 
     825do i=1,Agrif_NbVariables(2) 
     826  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then 
     827     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0 
     828     i_found = .TRUE. 
     829     EXIT 
     830  endif 
     831enddo 
     832ENDIF 
     833 
     834if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found' 
     835 
     836end function Agrif_Parent_Real_8 
     837 
     838function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent) 
     839real(KIND=8), DIMENSION(:,:) :: real_variable 
     840real(KIND=8) :: real_variable_parent 
     841integer :: ji,jj 
     842 
     843integer :: i 
     844logical :: i_found 
     845 
     846i_found = .FALSE. 
     847 
     848do i=1,Agrif_NbVariables(0) 
     849  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then 
     850     real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj) 
     851     i_found = .TRUE. 
     852     EXIT 
     853  endif 
     854enddo 
     855 
     856if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found' 
     857 
     858end function Agrif_Parent_Array2_Real_8 
     859 
     860 
     861function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent) 
     862integer :: integer_variable 
     863integer :: integer_variable_parent 
     864 
     865integer :: i 
     866logical :: i_found 
     867 
     868i_found = .FALSE. 
     869 
     870do i=1,Agrif_NbVariables(4) 
     871  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then 
     872     integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0 
     873     i_found = .TRUE. 
     874     EXIT 
     875  endif 
     876enddo 
     877 
     878if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     879 
     880end function Agrif_Parent_Integer 
     881 
     882function Agrif_Parent_Character(character_variable) result(character_variable_parent) 
     883character(*) :: character_variable 
     884character(len(character_variable)) :: character_variable_parent 
     885 
     886integer :: i 
     887logical :: i_found 
     888 
     889i_found = .FALSE. 
     890 
     891do i=1,Agrif_NbVariables(1) 
     892  if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then 
     893     character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0 
     894     i_found = .TRUE. 
     895     EXIT 
     896  endif 
     897enddo 
     898 
     899if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     900 
     901end function Agrif_Parent_Character 
     902 
     903function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent) 
     904logical :: logical_variable 
     905logical :: logical_variable_parent 
     906 
     907integer :: i 
     908logical :: i_found 
     909 
     910i_found = .FALSE. 
     911 
     912do i=1,Agrif_NbVariables(3) 
     913  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then 
     914     logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0 
     915     i_found = .TRUE. 
     916     EXIT 
     917  endif 
     918enddo 
     919 
     920if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 
     921 
     922end function Agrif_Parent_Logical 
     923 
     924function Agrif_Irhox() result(i_val) 
     925integer :: i_val 
     926i_val = agrif_curgrid%spaceref(1) 
     927end function Agrif_Irhox 
     928 
     929function Agrif_Irhoy() result(i_val) 
     930integer :: i_val 
     931i_val = agrif_curgrid%spaceref(2) 
     932end function Agrif_Irhoy 
     933 
     934function Agrif_Irhoz() result(i_val) 
     935integer :: i_val 
     936i_val = agrif_curgrid%spaceref(3) 
     937end function Agrif_Irhoz 
     938 
     939function Agrif_NearCommonBorderX() result(l_val) 
     940logical :: l_val 
     941l_val = agrif_curgrid%nearRootBorder(1) 
     942end function Agrif_NearCommonBorderX 
     943 
     944function Agrif_NearCommonBorderY() result(l_val) 
     945logical :: l_val 
     946l_val = agrif_curgrid%nearRootBorder(2) 
     947end function Agrif_NearCommonBorderY 
     948 
     949function Agrif_NearCommonBorderZ() result(l_val) 
     950logical :: l_val 
     951l_val = agrif_curgrid%nearRootBorder(3) 
     952end function Agrif_NearCommonBorderZ 
     953 
     954function Agrif_DistantCommonBorderX() result(l_val) 
     955logical :: l_val 
     956l_val = agrif_curgrid%DistantRootBorder(1) 
     957end function Agrif_DistantCommonBorderX 
     958 
     959function Agrif_DistantCommonBorderY() result(l_val) 
     960logical :: l_val 
     961l_val = agrif_curgrid%DistantRootBorder(2) 
     962end function Agrif_DistantCommonBorderY 
     963 
     964function Agrif_DistantCommonBorderZ() result(l_val) 
     965logical :: l_val 
     966l_val = agrif_curgrid%DistantRootBorder(3) 
     967end function Agrif_DistantCommonBorderZ 
     968 
     969function Agrif_Ix() result(i_val) 
     970integer :: i_val 
     971i_val = agrif_curgrid%ix(1) 
     972end function Agrif_Ix 
     973 
     974function Agrif_Iy() result(i_val) 
     975integer :: i_val 
     976i_val = agrif_curgrid%ix(2) 
     977end function Agrif_Iy 
     978 
     979function Agrif_Iz() result(i_val) 
     980integer :: i_val 
     981i_val = agrif_curgrid%ix(3) 
     982end function Agrif_Iz 
     983 
     984function Agrif_Get_grid_id() result(i_val) 
     985integer :: i_val 
     986i_val = agrif_curgrid % grid_id 
     987end function Agrif_Get_grid_id 
     988 
     989function Agrif_Get_parent_id() result(i_val) 
     990integer :: i_val 
     991i_val = agrif_curgrid % parent % grid_id 
     992end function Agrif_Get_parent_id 
     993 
     994function Agrif_rhox() result(r_val) 
     995real :: r_val 
     996r_val = real(agrif_curgrid%spaceref(1)) 
     997end function Agrif_rhox 
     998 
     999function Agrif_rhoy() result(r_val) 
     1000real :: r_val 
     1001r_val = real(agrif_curgrid%spaceref(2)) 
     1002end function Agrif_rhoy 
     1003 
     1004function Agrif_rhoz() result(r_val) 
     1005real :: r_val 
     1006r_val = real(agrif_curgrid%spaceref(3)) 
     1007end function Agrif_rhoz 
     1008 
     1009function Agrif_Nb_Step() result(i_val) 
     1010integer :: i_val 
     1011i_val = agrif_curgrid%ngridstep 
     1012end function Agrif_Nb_Step 
     1013 
     1014function Agrif_Nb_Fine_Grids() result(i_val) 
     1015integer :: i_val 
     1016i_val = Agrif_nbfixedgrids 
     1017end function Agrif_Nb_Fine_Grids 
     1018 
    7661019end module Agrif_CurgridFunctions 
Note: See TracChangeset for help on using the changeset viewer.