[8] | 1 | MODULE mod_dependency |
---|
| 2 | USE mod_field |
---|
| 3 | USE mod_file |
---|
| 4 | USE mod_grid |
---|
| 5 | USE mod_axis |
---|
| 6 | USE mod_sorted_list |
---|
[29] | 7 | USE mod_zoom |
---|
[8] | 8 | |
---|
| 9 | TYPE file_dep |
---|
| 10 | TYPE(file),POINTER :: file |
---|
| 11 | INTEGER :: hash |
---|
| 12 | TYPE(vector_field),POINTER :: fields |
---|
| 13 | TYPE(vector_grid),POINTER :: grids |
---|
[29] | 14 | TYPE(vector_zoom),POINTER :: zooms |
---|
[8] | 15 | TYPE(vector_axis),POINTER :: axis |
---|
| 16 | END TYPE file_dep |
---|
| 17 | |
---|
| 18 | TYPE field_dep |
---|
| 19 | TYPE(field),POINTER :: field |
---|
| 20 | INTEGER :: hash |
---|
| 21 | |
---|
| 22 | TYPE(vector_field_out),POINTER :: field_out |
---|
| 23 | END TYPE field_dep |
---|
| 24 | |
---|
| 25 | TYPE field_out |
---|
| 26 | TYPE(Field), POINTER :: field |
---|
| 27 | TYPE(file), POINTER :: file |
---|
| 28 | TYPE(axis), POINTER :: axis |
---|
| 29 | TYPE(grid), POINTER :: grid |
---|
[29] | 30 | TYPE(zoom), POINTER :: zoom |
---|
[8] | 31 | END TYPE field_out |
---|
| 32 | |
---|
| 33 | INCLUDE 'vector_field_dep_def.inc' |
---|
| 34 | INCLUDE 'vector_file_dep_def.inc' |
---|
| 35 | INCLUDE 'vector_field_out_def.inc' |
---|
| 36 | |
---|
[26] | 37 | TYPE(vector_file_dep),POINTER,SAVE :: file_enabled |
---|
| 38 | TYPE(vector_field_out),POINTER,SAVE :: field_enabled |
---|
| 39 | TYPE(vector_field_dep),POINTER,SAVE :: field_id |
---|
[8] | 40 | |
---|
| 41 | |
---|
[26] | 42 | TYPE(sorted_list),POINTER,SAVE :: sorted_id |
---|
[8] | 43 | |
---|
| 44 | CONTAINS |
---|
| 45 | |
---|
| 46 | INCLUDE 'vector_field_dep_contains.inc' |
---|
| 47 | INCLUDE 'vector_file_dep_contains.inc' |
---|
| 48 | INCLUDE 'vector_field_out_contains.inc' |
---|
| 49 | |
---|
[26] | 50 | |
---|
| 51 | SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id) |
---|
| 52 | IMPLICIT NONE |
---|
| 53 | TYPE(vector_file_dep),POINTER :: saved_file_enabled |
---|
| 54 | TYPE(vector_field_out),POINTER :: saved_field_enabled |
---|
| 55 | TYPE(vector_field_dep),POINTER :: save_field_id |
---|
| 56 | TYPE(sorted_list),POINTER :: saved_sorted_id |
---|
| 57 | |
---|
| 58 | file_enabled=>saved_file_enabled |
---|
| 59 | field_enabled=>saved_field_enabled |
---|
| 60 | field_id=>save_field_id |
---|
| 61 | sorted_id=>saved_sorted_id |
---|
| 62 | |
---|
| 63 | END SUBROUTINE dependency__swap_context |
---|
| 64 | |
---|
[8] | 65 | SUBROUTINE set_dependency |
---|
| 66 | IMPLICIT NONE |
---|
| 67 | |
---|
| 68 | CALL set_file_dependency |
---|
| 69 | CALL set_field_enabled |
---|
| 70 | CALL set_field_dependency |
---|
| 71 | |
---|
| 72 | END SUBROUTINE set_dependency |
---|
| 73 | |
---|
| 74 | |
---|
| 75 | RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group) |
---|
| 76 | USE mod_file_definition |
---|
| 77 | USE mod_file_group |
---|
| 78 | USE string_function |
---|
| 79 | USE mod_sorted_list |
---|
| 80 | IMPLICIT NONE |
---|
| 81 | TYPE (file_group),POINTER,OPTIONAL :: pt_file_group |
---|
| 82 | TYPE (file_group),POINTER :: Pt_fg |
---|
| 83 | TYPE (file) ,POINTER :: Pt_file |
---|
| 84 | TYPE (file_dep),POINTER :: Pt_file_dep |
---|
| 85 | TYPE (sorted_list),POINTER :: sorted_axis |
---|
| 86 | TYPE (sorted_list),POINTER :: sorted_grid |
---|
[29] | 87 | TYPE (sorted_list),POINTER :: sorted_zoom |
---|
[8] | 88 | INTEGER :: i |
---|
| 89 | INTEGER :: j |
---|
| 90 | |
---|
| 91 | ALLOCATE(sorted_axis) |
---|
| 92 | ALLOCATE(sorted_grid) |
---|
[29] | 93 | ALLOCATE(sorted_zoom) |
---|
[8] | 94 | |
---|
| 95 | IF (PRESENT(Pt_file_group)) THEN |
---|
| 96 | Pt_fg=>Pt_file_group |
---|
| 97 | ELSE |
---|
| 98 | CALL vector_file_dep__new(file_enabled) |
---|
| 99 | Pt_fg=>file_definition |
---|
| 100 | ENDIF |
---|
| 101 | |
---|
| 102 | DO i=1,Pt_fg%groups%size |
---|
| 103 | CALL set_file_dependency(Pt_fg%groups%at(i)%pt) |
---|
| 104 | ENDDO |
---|
| 105 | |
---|
| 106 | DO i=1,Pt_fg%files%size |
---|
| 107 | Pt_file=>pt_fg%files%at(i)%pt |
---|
| 108 | IF (Pt_file%enabled) THEN |
---|
| 109 | CALL vector_file_dep__get_new(file_enabled,Pt_file_dep) |
---|
| 110 | |
---|
| 111 | ALLOCATE(Pt_file_dep%fields) |
---|
| 112 | ALLOCATE(Pt_file_dep%grids) |
---|
[29] | 113 | ALLOCATE(Pt_file_dep%zooms) |
---|
[8] | 114 | ALLOCATE(Pt_file_dep%axis) |
---|
| 115 | pt_file_dep%file=>pt_file |
---|
| 116 | pt_file_dep%hash=hash(pt_file%id) |
---|
| 117 | CALL vector_field__new(Pt_file_dep%fields) |
---|
| 118 | CALL vector_grid__new(Pt_file_dep%grids) |
---|
[29] | 119 | CALL vector_zoom__new(Pt_file_dep%zooms) |
---|
[8] | 120 | CALL vector_axis__new(Pt_file_dep%axis) |
---|
| 121 | CALL sorted_list__new(sorted_axis) |
---|
| 122 | CALL sorted_list__new(sorted_grid) |
---|
[29] | 123 | CALL sorted_list__new(sorted_zoom) |
---|
[8] | 124 | |
---|
| 125 | CALL Treat_field_group(pt_file%field_list) |
---|
| 126 | |
---|
| 127 | CALL sorted_list__delete(sorted_axis) |
---|
| 128 | CALL sorted_list__delete(sorted_grid) |
---|
[29] | 129 | CALL sorted_list__delete(sorted_zoom) |
---|
[8] | 130 | ENDIF |
---|
| 131 | ENDDO |
---|
| 132 | |
---|
| 133 | CONTAINS |
---|
| 134 | RECURSIVE SUBROUTINE treat_field_group(pt_fg) |
---|
| 135 | IMPLICIT NONE |
---|
| 136 | TYPE(field_group),POINTER :: Pt_fg |
---|
| 137 | INTEGER :: i |
---|
| 138 | |
---|
| 139 | DO i=1,Pt_fg%groups%size |
---|
| 140 | CALL treat_field_group(Pt_fg%groups%at(i)%pt) |
---|
| 141 | ENDDO |
---|
| 142 | |
---|
| 143 | DO i=1,Pt_fg%fields%size |
---|
| 144 | CALL treat_field(Pt_fg%fields%at(i)%pt) |
---|
| 145 | ENDDO |
---|
| 146 | END SUBROUTINE treat_field_group |
---|
| 147 | |
---|
| 148 | |
---|
| 149 | SUBROUTINE treat_field(pt_field) |
---|
| 150 | IMPLICIT NONE |
---|
| 151 | TYPE(field),POINTER :: Pt_field |
---|
| 152 | LOGICAL :: found |
---|
| 153 | INTEGER :: Pos |
---|
| 154 | |
---|
| 155 | IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN |
---|
| 156 | CALL vector_field__set_new(Pt_file_dep%fields,Pt_field) |
---|
| 157 | |
---|
| 158 | IF (Pt_field%has_grid) THEN |
---|
| 159 | CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found) |
---|
| 160 | IF (.NOT. found) THEN |
---|
| 161 | CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos) |
---|
| 162 | CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos) |
---|
| 163 | ENDIF |
---|
| 164 | ENDIF |
---|
[29] | 165 | |
---|
| 166 | IF (Pt_field%has_zoom) THEN |
---|
| 167 | CALL sorted_list__find(sorted_zoom,hash(Pt_field%zoom%id),pos,found) |
---|
| 168 | IF (.NOT. found) THEN |
---|
| 169 | CALL vector_zoom__set_new(pt_file_dep%zooms,Pt_field%zoom,pos) |
---|
| 170 | CALL sorted_list__add(sorted_zoom,hash(Pt_field%zoom%id),pos) |
---|
| 171 | ENDIF |
---|
| 172 | ENDIF |
---|
[8] | 173 | |
---|
| 174 | IF (Pt_field%has_axis) THEN |
---|
| 175 | CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found) |
---|
| 176 | IF (.NOT. found) THEN |
---|
| 177 | CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos) |
---|
| 178 | CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos) |
---|
| 179 | ENDIF |
---|
| 180 | ENDIF |
---|
| 181 | ENDIF |
---|
| 182 | |
---|
| 183 | END SUBROUTINE treat_field |
---|
| 184 | |
---|
| 185 | END SUBROUTINE set_file_dependency |
---|
| 186 | |
---|
| 187 | SUBROUTINE set_field_enabled |
---|
| 188 | IMPLICIT NONE |
---|
| 189 | TYPE(file_dep),POINTER :: pt_file_dep |
---|
| 190 | TYPE(field_out),POINTER :: pt_field_out |
---|
| 191 | INTEGER :: i |
---|
| 192 | INTEGER :: j |
---|
| 193 | |
---|
| 194 | CALL vector_field_out__new(field_enabled) |
---|
| 195 | |
---|
| 196 | DO i=1,file_enabled%size |
---|
| 197 | pt_file_dep=>file_enabled%at(i)%pt |
---|
| 198 | DO j=1,pt_file_dep%fields%size |
---|
| 199 | CALL vector_field_out__get_new(field_enabled,pt_field_out) |
---|
| 200 | pt_field_out%field=>pt_file_dep%fields%at(j)%pt |
---|
| 201 | pt_field_out%file=>pt_file_dep%file |
---|
| 202 | pt_field_out%axis=>pt_field_out%field%axis |
---|
| 203 | pt_field_out%grid=>pt_field_out%field%grid |
---|
[29] | 204 | pt_field_out%zoom=>pt_field_out%field%zoom |
---|
[8] | 205 | ENDDO |
---|
| 206 | ENDDO |
---|
| 207 | |
---|
| 208 | |
---|
| 209 | END SUBROUTINE set_field_enabled |
---|
| 210 | |
---|
| 211 | SUBROUTINE set_field_dependency |
---|
| 212 | USE string_function |
---|
| 213 | IMPLICIT NONE |
---|
| 214 | TYPE(field_out),POINTER :: pt_field_out |
---|
| 215 | TYPE(field_dep),POINTER :: pt_field_dep |
---|
| 216 | TYPE(field),POINTER :: pt_field |
---|
| 217 | TYPE(field),POINTER :: pt_field_base |
---|
| 218 | INTEGER :: pos |
---|
| 219 | LOGICAL :: found |
---|
| 220 | INTEGER :: i |
---|
| 221 | |
---|
| 222 | CALL vector_field_dep__new(field_id) |
---|
| 223 | CALL sorted_list__new(sorted_id) |
---|
| 224 | |
---|
| 225 | DO i=1,field_enabled%size |
---|
| 226 | pt_field_out=>field_enabled%at(i)%pt |
---|
| 227 | pt_field=>pt_field_out%field |
---|
| 228 | pt_field_base=>pt_field%field_base |
---|
| 229 | CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found) |
---|
| 230 | IF (.NOT. found) THEN |
---|
| 231 | CALL vector_field_dep__get_new(field_id,pt_field_dep,pos) |
---|
| 232 | ALLOCATE(pt_field_dep%field_out) |
---|
| 233 | CALL vector_field_out__new(pt_field_dep%field_out) |
---|
| 234 | pt_field_dep%field=>pt_field_base |
---|
| 235 | CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos) |
---|
| 236 | ELSE |
---|
| 237 | pt_field_dep=>field_id%at(pos)%pt |
---|
| 238 | ENDIF |
---|
| 239 | |
---|
| 240 | CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) |
---|
| 241 | ENDDO |
---|
| 242 | |
---|
| 243 | END SUBROUTINE set_field_dependency |
---|
| 244 | |
---|
| 245 | |
---|
| 246 | |
---|
| 247 | END MODULE mod_dependency |
---|