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