 Timestamp:
 20190227T14:55:54+01:00 (19 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modcurgridfunctions.F90
r10087 r10725 29 29 implicit none 30 30 ! 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 31 41 contains 32 42 ! … … 92 102 ! 93 103 rhot = float(Agrif_IRhot()) 94 95 104 ! 96 105 end function Agrif_Rhot … … 764 773 !=================================================================================================== 765 774 ! 775 776 function Agrif_Parent_Real_4(real_variable) result(real_variable_parent) 777 real(KIND=4) :: real_variable 778 real(KIND=4) :: real_variable_parent 779 780 integer :: i 781 logical :: i_found 782 783 i_found = .FALSE. 784 785 do 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 791 enddo 792 793 IF (.NOT.i_found) THEN 794 do 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 800 enddo 801 ENDIF 802 803 if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found' 804 805 end function Agrif_Parent_Real_4 806 807 function Agrif_Parent_Real_8(real_variable) result(real_variable_parent) 808 real(KIND=8) :: real_variable 809 real(KIND=8) :: real_variable_parent 810 811 integer :: i 812 logical :: i_found 813 814 i_found = .FALSE. 815 816 do 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 822 enddo 823 824 IF (.NOT.i_found) THEN 825 do 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 831 enddo 832 ENDIF 833 834 if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found' 835 836 end function Agrif_Parent_Real_8 837 838 function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent) 839 real(KIND=8), DIMENSION(:,:) :: real_variable 840 real(KIND=8) :: real_variable_parent 841 integer :: ji,jj 842 843 integer :: i 844 logical :: i_found 845 846 i_found = .FALSE. 847 848 do 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 854 enddo 855 856 if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found' 857 858 end function Agrif_Parent_Array2_Real_8 859 860 861 function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent) 862 integer :: integer_variable 863 integer :: integer_variable_parent 864 865 integer :: i 866 logical :: i_found 867 868 i_found = .FALSE. 869 870 do 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 876 enddo 877 878 if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 879 880 end function Agrif_Parent_Integer 881 882 function Agrif_Parent_Character(character_variable) result(character_variable_parent) 883 character(*) :: character_variable 884 character(len(character_variable)) :: character_variable_parent 885 886 integer :: i 887 logical :: i_found 888 889 i_found = .FALSE. 890 891 do 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 897 enddo 898 899 if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 900 901 end function Agrif_Parent_Character 902 903 function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent) 904 logical :: logical_variable 905 logical :: logical_variable_parent 906 907 integer :: i 908 logical :: i_found 909 910 i_found = .FALSE. 911 912 do 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 918 enddo 919 920 if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' 921 922 end function Agrif_Parent_Logical 923 924 function Agrif_Irhox() result(i_val) 925 integer :: i_val 926 i_val = agrif_curgrid%spaceref(1) 927 end function Agrif_Irhox 928 929 function Agrif_Irhoy() result(i_val) 930 integer :: i_val 931 i_val = agrif_curgrid%spaceref(2) 932 end function Agrif_Irhoy 933 934 function Agrif_Irhoz() result(i_val) 935 integer :: i_val 936 i_val = agrif_curgrid%spaceref(3) 937 end function Agrif_Irhoz 938 939 function Agrif_NearCommonBorderX() result(l_val) 940 logical :: l_val 941 l_val = agrif_curgrid%nearRootBorder(1) 942 end function Agrif_NearCommonBorderX 943 944 function Agrif_NearCommonBorderY() result(l_val) 945 logical :: l_val 946 l_val = agrif_curgrid%nearRootBorder(2) 947 end function Agrif_NearCommonBorderY 948 949 function Agrif_NearCommonBorderZ() result(l_val) 950 logical :: l_val 951 l_val = agrif_curgrid%nearRootBorder(3) 952 end function Agrif_NearCommonBorderZ 953 954 function Agrif_DistantCommonBorderX() result(l_val) 955 logical :: l_val 956 l_val = agrif_curgrid%DistantRootBorder(1) 957 end function Agrif_DistantCommonBorderX 958 959 function Agrif_DistantCommonBorderY() result(l_val) 960 logical :: l_val 961 l_val = agrif_curgrid%DistantRootBorder(2) 962 end function Agrif_DistantCommonBorderY 963 964 function Agrif_DistantCommonBorderZ() result(l_val) 965 logical :: l_val 966 l_val = agrif_curgrid%DistantRootBorder(3) 967 end function Agrif_DistantCommonBorderZ 968 969 function Agrif_Ix() result(i_val) 970 integer :: i_val 971 i_val = agrif_curgrid%ix(1) 972 end function Agrif_Ix 973 974 function Agrif_Iy() result(i_val) 975 integer :: i_val 976 i_val = agrif_curgrid%ix(2) 977 end function Agrif_Iy 978 979 function Agrif_Iz() result(i_val) 980 integer :: i_val 981 i_val = agrif_curgrid%ix(3) 982 end function Agrif_Iz 983 984 function Agrif_Get_grid_id() result(i_val) 985 integer :: i_val 986 i_val = agrif_curgrid % grid_id 987 end function Agrif_Get_grid_id 988 989 function Agrif_Get_parent_id() result(i_val) 990 integer :: i_val 991 i_val = agrif_curgrid % parent % grid_id 992 end function Agrif_Get_parent_id 993 994 function Agrif_rhox() result(r_val) 995 real :: r_val 996 r_val = real(agrif_curgrid%spaceref(1)) 997 end function Agrif_rhox 998 999 function Agrif_rhoy() result(r_val) 1000 real :: r_val 1001 r_val = real(agrif_curgrid%spaceref(2)) 1002 end function Agrif_rhoy 1003 1004 function Agrif_rhoz() result(r_val) 1005 real :: r_val 1006 r_val = real(agrif_curgrid%spaceref(3)) 1007 end function Agrif_rhoz 1008 1009 function Agrif_Nb_Step() result(i_val) 1010 integer :: i_val 1011 i_val = agrif_curgrid%ngridstep 1012 end function Agrif_Nb_Step 1013 1014 function Agrif_Nb_Fine_Grids() result(i_val) 1015 integer :: i_val 1016 i_val = Agrif_nbfixedgrids 1017 end function Agrif_Nb_Fine_Grids 1018 766 1019 end module Agrif_CurgridFunctions
Note: See TracChangeset
for help on using the changeset viewer.