[2671] | 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 | |
---|
[2731] | 152 | End Module Agrif_Variables |
---|