1 | Module Agrif_Variables |
---|
2 | Use Agrif_CurgridFunctions |
---|
3 | |
---|
4 | Contains |
---|
5 | Subroutine Agrif_Declare_Variable(posvar,firstpoint, |
---|
6 | & raf,lb,ub,varid,torestore) |
---|
7 | character*(80) :: variablename |
---|
8 | Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep |
---|
9 | INTEGER, DIMENSION(:) :: posvar |
---|
10 | INTEGER, DIMENSION(:) :: lb,ub |
---|
11 | INTEGER, DIMENSION(:) :: firstpoint |
---|
12 | CHARACTER(*) ,DIMENSION(:) :: raf |
---|
13 | TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var |
---|
14 | INTEGER :: dimensio |
---|
15 | INTEGER :: varid |
---|
16 | LOGICAL, OPTIONAL :: torestore |
---|
17 | LOGICAL :: restaure |
---|
18 | |
---|
19 | ! if (agrif_root()) return |
---|
20 | |
---|
21 | variablename = 'xxx' |
---|
22 | |
---|
23 | restaure = .FALSE. |
---|
24 | if (agrif_mygrid%ngridstep /= 0) then |
---|
25 | if (present(torestore)) restaure = torestore |
---|
26 | endif |
---|
27 | |
---|
28 | dimensio = SIZE(posvar) |
---|
29 | C |
---|
30 | C |
---|
31 | Allocate(newvariable) |
---|
32 | Allocate(newvariable%pvar) |
---|
33 | Allocate(newvariable%pvar%var) |
---|
34 | Allocate(newvariable%pvar%var%posvar(dimensio)) |
---|
35 | Allocate(newvariable%pvar%var%interptab(dimensio)) |
---|
36 | newvariable%pvar%var%variablename = variablename |
---|
37 | newvariable%pvar%var%interptab = raf |
---|
38 | newvariable%pvar%var%nbdim = dimensio |
---|
39 | newvariable%pvar%var%posvar = posvar |
---|
40 | newvariable%pvar%var%point(1:dimensio) = firstpoint |
---|
41 | newvariable%pvar%var%restaure = restaure |
---|
42 | |
---|
43 | newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio) |
---|
44 | newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio) |
---|
45 | |
---|
46 | if (restaure) then |
---|
47 | select case(dimensio) |
---|
48 | case(1) |
---|
49 | Allocate( newvariable%pvar%var%Restore1D( |
---|
50 | & lb(1):ub(1))) |
---|
51 | newvariable%pvar%var%Restore1D = 0 |
---|
52 | case(2) |
---|
53 | Allocate( newvariable%pvar%var%Restore2D( |
---|
54 | & lb(1):ub(1),lb(2):ub(2))) |
---|
55 | newvariable%pvar%var%Restore2D = 0 |
---|
56 | case(3) |
---|
57 | Allocate( newvariable%pvar%var%Restore3D( |
---|
58 | & lb(1):ub(1),lb(2):ub(2),lb(3):ub(3))) |
---|
59 | newvariable%pvar%var%Restore3D = 0 |
---|
60 | case(4) |
---|
61 | Allocate( newvariable%pvar%var%Restore4D( |
---|
62 | & lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4))) |
---|
63 | newvariable%pvar%var%Restore4D = 0 |
---|
64 | case(5) |
---|
65 | Allocate( newvariable%pvar%var%Restore5D( |
---|
66 | & lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4), |
---|
67 | & lb(5):ub(5))) |
---|
68 | newvariable%pvar%var%Restore5D = 0 |
---|
69 | end select |
---|
70 | endif |
---|
71 | |
---|
72 | newvariable % nextvariable => Agrif_Curgrid%variables |
---|
73 | |
---|
74 | Agrif_Curgrid%variables => newvariable |
---|
75 | Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1 |
---|
76 | |
---|
77 | varid = -Agrif_Curgrid%Nbvariables |
---|
78 | |
---|
79 | ! if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables) |
---|
80 | ! & then |
---|
81 | ! Allocate(newvariablep) |
---|
82 | ! Allocate(newvariablep%pvar) |
---|
83 | ! Allocate(newvariablep%pvar%var) |
---|
84 | ! Allocate(newvariablep%pvar%var%posvar(dimensio)) |
---|
85 | ! Allocate(newvariablep%pvar%var%interptab(dimensio)) |
---|
86 | ! newvariablep%pvar%var%variablename = variablename |
---|
87 | ! newvariablep%pvar%var%interptab = raf |
---|
88 | ! newvariablep%pvar%var%nbdim = dimensio |
---|
89 | ! newvariablep%pvar%var%posvar = posvar |
---|
90 | ! newvariablep%pvar%var%point(1:dimensio) = firstpoint |
---|
91 | ! newvariablep%pvar%var%restaure = restaure |
---|
92 | ! |
---|
93 | ! newvariablep%pvar%var%lb(1:dimensio) = lb(1:dimensio) |
---|
94 | ! newvariablep%pvar%var%ub(1:dimensio) = ub(1:dimensio) |
---|
95 | ! |
---|
96 | ! newvariablep % nextvariable => Agrif_Curgrid%parent%variables |
---|
97 | ! |
---|
98 | ! Agrif_Curgrid%parent%variables => newvariablep |
---|
99 | ! |
---|
100 | ! Agrif_Curgrid%parent%Nbvariables = |
---|
101 | ! & Agrif_Curgrid%parent%Nbvariables + 1 |
---|
102 | ! parent_var=>newvariablep%pvar |
---|
103 | ! else |
---|
104 | ! parent_var=>Agrif_Search_Variable |
---|
105 | ! & (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables) |
---|
106 | ! endif |
---|
107 | |
---|
108 | if (.not.agrif_root()) then |
---|
109 | parent_var=>Agrif_Search_Variable |
---|
110 | & (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables) |
---|
111 | |
---|
112 | newvariable%pvar%parent_var=>parent_var |
---|
113 | do i=1,dimensio |
---|
114 | if (parent_var%var%interptab(i)=='N') then |
---|
115 | parent_var%var%lb(i)=lb(i) |
---|
116 | parent_var%var%ub(i)=ub(i) |
---|
117 | endif |
---|
118 | enddo |
---|
119 | endif |
---|
120 | |
---|
121 | root_var=>Agrif_Search_Variable |
---|
122 | & (Agrif_Mygrid,Agrif_Curgrid%nbvariables) |
---|
123 | |
---|
124 | newvariable%pvar%var%root_var=>root_var%var |
---|
125 | |
---|
126 | |
---|
127 | End Subroutine Agrif_Declare_Variable |
---|
128 | |
---|
129 | FUNCTION Agrif_Search_Variable(grid,varid) |
---|
130 | integer :: varid |
---|
131 | Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable |
---|
132 | Type(Agrif_grid), Pointer :: grid |
---|
133 | |
---|
134 | Type(Agrif_List_Variables), pointer :: parcours |
---|
135 | Logical :: foundvariable |
---|
136 | integer nb |
---|
137 | integer :: varidinv |
---|
138 | |
---|
139 | foundvariable = .FALSE. |
---|
140 | parcours => grid%variables |
---|
141 | varidinv = 1 + grid%nbvariables - varid |
---|
142 | |
---|
143 | do nb=1,varidinv-1 |
---|
144 | parcours => parcours%nextvariable |
---|
145 | End Do |
---|
146 | |
---|
147 | Agrif_Search_variable => parcours%pvar |
---|
148 | |
---|
149 | |
---|
150 | End Function Agrif_Search_variable |
---|
151 | |
---|
152 | End Module Agrif_Variables |
---|