| 1 | MODULE mod_attribut |
|---|
| 2 | USE mod_xmlio_parameters |
|---|
| 3 | USE mod_attribut_list |
|---|
| 4 | USE mod_stdtype |
|---|
| 5 | USE string_function |
|---|
| 6 | |
|---|
| 7 | TYPE, PUBLIC :: attribut |
|---|
| 8 | INTEGER :: object |
|---|
| 9 | INTEGER :: name |
|---|
| 10 | INTEGER :: type |
|---|
| 11 | INTEGER :: dim(7) |
|---|
| 12 | INTEGER :: ndim |
|---|
| 13 | INTEGER,POINTER :: integer0_ptr |
|---|
| 14 | INTEGER,POINTER :: integer1_ptr(:) |
|---|
| 15 | INTEGER,POINTER :: integer2_ptr(:,:) |
|---|
| 16 | REAL,POINTER :: real0_ptr |
|---|
| 17 | REAL,POINTER :: real1_ptr(:) |
|---|
| 18 | REAL,POINTER :: real2_ptr(:,:) |
|---|
| 19 | LOGICAL,POINTER :: logical0_ptr |
|---|
| 20 | LOGICAL,POINTER :: logical1_ptr(:) |
|---|
| 21 | LOGICAL,POINTER :: logical2_ptr(:,:) |
|---|
| 22 | |
|---|
| 23 | CHARACTER(LEN=str_len),POINTER :: string0_ptr |
|---|
| 24 | CHARACTER(LEN=str_len),POINTER :: string1_ptr(:) |
|---|
| 25 | CHARACTER(LEN=str_len),POINTER :: string2_ptr(:,:) |
|---|
| 26 | INTEGER :: string_len |
|---|
| 27 | |
|---|
| 28 | END TYPE attribut |
|---|
| 29 | |
|---|
| 30 | INTERFACE attr |
|---|
| 31 | MODULE PROCEDURE attr_int0,attr_int1,attr_int2, & |
|---|
| 32 | attr_real0,attr_real1,attr_real2, & |
|---|
| 33 | attr_logical0,attr_logical1,attr_logical2, & |
|---|
| 34 | attr_string0,attr_string1,attr_string2 |
|---|
| 35 | END INTERFACE |
|---|
| 36 | |
|---|
| 37 | CONTAINS |
|---|
| 38 | |
|---|
| 39 | FUNCTION attr_get_object(attr_name) |
|---|
| 40 | USE mod_attribut_list |
|---|
| 41 | USE mod_object |
|---|
| 42 | USE error_msg |
|---|
| 43 | IMPLICIT NONE |
|---|
| 44 | INTEGER, INTENT(IN) :: attr_name |
|---|
| 45 | INTEGER :: attr_get_object |
|---|
| 46 | |
|---|
| 47 | IF (attr_name > field__begin .AND. attr_name < field__end) THEN |
|---|
| 48 | attr_get_object=field_object |
|---|
| 49 | RETURN |
|---|
| 50 | ENDIF |
|---|
| 51 | |
|---|
| 52 | IF (attr_name > file__begin .AND. attr_name < file__end) THEN |
|---|
| 53 | attr_get_object=file_object |
|---|
| 54 | RETURN |
|---|
| 55 | ENDIF |
|---|
| 56 | |
|---|
| 57 | IF (attr_name > grid__begin .AND. attr_name < grid__end) THEN |
|---|
| 58 | attr_get_object=grid_object |
|---|
| 59 | RETURN |
|---|
| 60 | ENDIF |
|---|
| 61 | |
|---|
| 62 | IF (attr_name > axis__begin .AND. attr_name < axis__end) THEN |
|---|
| 63 | attr_get_object=axis_object |
|---|
| 64 | RETURN |
|---|
| 65 | ENDIF |
|---|
| 66 | |
|---|
| 67 | IF (attr_name > zoom__begin .AND. attr_name < zoom__end) THEN |
|---|
| 68 | attr_get_object=zoom_object |
|---|
| 69 | RETURN |
|---|
| 70 | ENDIF |
|---|
| 71 | |
|---|
| 72 | WRITE (message,*) 'Attribut name value :',attr_name,'is undefined' |
|---|
| 73 | CALL error("mod_attributd::attr_get_object") |
|---|
| 74 | |
|---|
| 75 | END FUNCTION attr_get_object |
|---|
| 76 | |
|---|
| 77 | SUBROUTINE attr_deallocate(attrib) |
|---|
| 78 | IMPLICIT NONE |
|---|
| 79 | TYPE(attribut) :: attrib |
|---|
| 80 | |
|---|
| 81 | SELECT CASE(attrib%type) |
|---|
| 82 | CASE (integer0) |
|---|
| 83 | DEALLOCATE(attrib%integer0_ptr) |
|---|
| 84 | CASE (integer1) |
|---|
| 85 | DEALLOCATE(attrib%integer1_ptr) |
|---|
| 86 | CASE (integer2) |
|---|
| 87 | DEALLOCATE(attrib%integer2_ptr) |
|---|
| 88 | CASE (real0) |
|---|
| 89 | DEALLOCATE(attrib%real0_ptr) |
|---|
| 90 | CASE (real1) |
|---|
| 91 | DEALLOCATE(attrib%real1_ptr) |
|---|
| 92 | CASE (real2) |
|---|
| 93 | DEALLOCATE(attrib%real2_ptr) |
|---|
| 94 | CASE (logical0) |
|---|
| 95 | DEALLOCATE(attrib%logical0_ptr) |
|---|
| 96 | CASE (logical1) |
|---|
| 97 | DEALLOCATE(attrib%logical1_ptr) |
|---|
| 98 | CASE (logical2) |
|---|
| 99 | DEALLOCATE(attrib%logical2_ptr) |
|---|
| 100 | CASE (string0) |
|---|
| 101 | DEALLOCATE(attrib%string0_ptr) |
|---|
| 102 | CASE (string1) |
|---|
| 103 | DEALLOCATE(attrib%string1_ptr) |
|---|
| 104 | CASE (string2) |
|---|
| 105 | DEALLOCATE(attrib%string2_ptr) |
|---|
| 106 | END SELECT |
|---|
| 107 | |
|---|
| 108 | END SUBROUTINE attr_deallocate |
|---|
| 109 | |
|---|
| 110 | FUNCTION attr_int0(attr_name,value) |
|---|
| 111 | USE mod_stdtype |
|---|
| 112 | IMPLICIT NONE |
|---|
| 113 | INTEGER :: attr_name |
|---|
| 114 | INTEGER,TARGET :: value |
|---|
| 115 | |
|---|
| 116 | TYPE(attribut) :: attr_int0 |
|---|
| 117 | attr_int0%object=attr_get_object(attr_name) |
|---|
| 118 | attr_int0%name=attr_name |
|---|
| 119 | attr_int0%type=integer0 |
|---|
| 120 | attr_int0%integer0_ptr=>value |
|---|
| 121 | |
|---|
| 122 | END FUNCTION attr_int0 |
|---|
| 123 | |
|---|
| 124 | FUNCTION attr_int1(attr_name,value) |
|---|
| 125 | USE mod_stdtype |
|---|
| 126 | IMPLICIT NONE |
|---|
| 127 | INTEGER :: attr_name |
|---|
| 128 | INTEGER,TARGET :: value(:) |
|---|
| 129 | |
|---|
| 130 | TYPE(attribut) :: attr_int1 |
|---|
| 131 | attr_int1%object=attr_get_object(attr_name) |
|---|
| 132 | attr_int1%name=attr_name |
|---|
| 133 | attr_int1%type=integer1 |
|---|
| 134 | attr_int1%integer1_ptr=>value |
|---|
| 135 | |
|---|
| 136 | END FUNCTION attr_int1 |
|---|
| 137 | |
|---|
| 138 | FUNCTION attr_int2(attr_name,value) |
|---|
| 139 | USE mod_stdtype |
|---|
| 140 | IMPLICIT NONE |
|---|
| 141 | INTEGER :: attr_name |
|---|
| 142 | INTEGER,TARGET :: value(:,:) |
|---|
| 143 | |
|---|
| 144 | TYPE(attribut) :: attr_int2 |
|---|
| 145 | attr_int2%object=attr_get_object(attr_name) |
|---|
| 146 | attr_int2%name=attr_name |
|---|
| 147 | attr_int2%type=integer2 |
|---|
| 148 | attr_int2%integer2_ptr=>value |
|---|
| 149 | |
|---|
| 150 | END FUNCTION attr_int2 |
|---|
| 151 | |
|---|
| 152 | |
|---|
| 153 | FUNCTION attr_real0(attr_name,value) |
|---|
| 154 | USE mod_stdtype |
|---|
| 155 | IMPLICIT NONE |
|---|
| 156 | INTEGER :: attr_name |
|---|
| 157 | REAL,TARGET :: value |
|---|
| 158 | |
|---|
| 159 | TYPE(attribut) :: attr_real0 |
|---|
| 160 | attr_real0%object=attr_get_object(attr_name) |
|---|
| 161 | attr_real0%name=attr_name |
|---|
| 162 | attr_real0%type=real0 |
|---|
| 163 | attr_real0%real0_ptr=>value |
|---|
| 164 | |
|---|
| 165 | END FUNCTION attr_real0 |
|---|
| 166 | |
|---|
| 167 | FUNCTION attr_real1(attr_name,value) |
|---|
| 168 | USE mod_stdtype |
|---|
| 169 | IMPLICIT NONE |
|---|
| 170 | INTEGER :: attr_name |
|---|
| 171 | REAL,TARGET :: value(:) |
|---|
| 172 | |
|---|
| 173 | TYPE(attribut) :: attr_real1 |
|---|
| 174 | attr_real1%object=attr_get_object(attr_name) |
|---|
| 175 | attr_real1%name=attr_name |
|---|
| 176 | attr_real1%type=real1 |
|---|
| 177 | attr_real1%real1_ptr=>value |
|---|
| 178 | |
|---|
| 179 | END FUNCTION attr_real1 |
|---|
| 180 | |
|---|
| 181 | FUNCTION attr_real2(attr_name,value) |
|---|
| 182 | USE mod_stdtype |
|---|
| 183 | IMPLICIT NONE |
|---|
| 184 | INTEGER :: attr_name |
|---|
| 185 | REAL,TARGET :: value(:,:) |
|---|
| 186 | |
|---|
| 187 | TYPE(attribut) :: attr_real2 |
|---|
| 188 | attr_real2%object=attr_get_object(attr_name) |
|---|
| 189 | attr_real2%name=attr_name |
|---|
| 190 | attr_real2%type=REAL2 |
|---|
| 191 | attr_real2%real2_ptr=>value |
|---|
| 192 | |
|---|
| 193 | END FUNCTION attr_real2 |
|---|
| 194 | |
|---|
| 195 | FUNCTION attr_logical0(attr_name,value) |
|---|
| 196 | USE mod_stdtype |
|---|
| 197 | IMPLICIT NONE |
|---|
| 198 | INTEGER :: attr_name |
|---|
| 199 | LOGICAL,TARGET :: value |
|---|
| 200 | |
|---|
| 201 | TYPE(attribut) :: attr_logical0 |
|---|
| 202 | attr_logical0%object=attr_get_object(attr_name) |
|---|
| 203 | attr_logical0%name=attr_name |
|---|
| 204 | attr_logical0%type=logical0 |
|---|
| 205 | attr_logical0%logical0_ptr=>value |
|---|
| 206 | |
|---|
| 207 | END FUNCTION attr_logical0 |
|---|
| 208 | |
|---|
| 209 | FUNCTION attr_logical1(attr_name,value) |
|---|
| 210 | USE mod_stdtype |
|---|
| 211 | IMPLICIT NONE |
|---|
| 212 | INTEGER :: attr_name |
|---|
| 213 | LOGICAL,TARGET :: value(:) |
|---|
| 214 | |
|---|
| 215 | TYPE(attribut) :: attr_logical1 |
|---|
| 216 | attr_logical1%object=attr_get_object(attr_name) |
|---|
| 217 | attr_logical1%name=attr_name |
|---|
| 218 | attr_logical1%type=logical1 |
|---|
| 219 | attr_logical1%logical1_ptr=>value |
|---|
| 220 | |
|---|
| 221 | END FUNCTION attr_logical1 |
|---|
| 222 | |
|---|
| 223 | FUNCTION attr_logical2(attr_name,value) |
|---|
| 224 | USE mod_stdtype |
|---|
| 225 | IMPLICIT NONE |
|---|
| 226 | INTEGER :: attr_name |
|---|
| 227 | LOGICAL,TARGET :: value(:,:) |
|---|
| 228 | |
|---|
| 229 | TYPE(attribut) :: attr_logical2 |
|---|
| 230 | attr_logical2%object=attr_get_object(attr_name) |
|---|
| 231 | attr_logical2%name=attr_name |
|---|
| 232 | attr_logical2%type=logical2 |
|---|
| 233 | attr_logical2%logical2_ptr=>value |
|---|
| 234 | |
|---|
| 235 | END FUNCTION attr_logical2 |
|---|
| 236 | |
|---|
| 237 | |
|---|
| 238 | FUNCTION attr_string0(attr_name,value) |
|---|
| 239 | USE mod_stdtype |
|---|
| 240 | IMPLICIT NONE |
|---|
| 241 | INTEGER :: attr_name |
|---|
| 242 | CHARACTER(LEN=*),TARGET :: value |
|---|
| 243 | TYPE(attribut) :: attr_string0 |
|---|
| 244 | |
|---|
| 245 | attr_string0%object=attr_get_object(attr_name) |
|---|
| 246 | attr_string0%name=attr_name |
|---|
| 247 | attr_string0%type=string0 |
|---|
| 248 | attr_string0%string_len=LEN(value) |
|---|
| 249 | attr_string0%string0_ptr=>value |
|---|
| 250 | |
|---|
| 251 | END FUNCTION attr_string0 |
|---|
| 252 | |
|---|
| 253 | FUNCTION attr_string1(attr_name,value) |
|---|
| 254 | USE mod_stdtype |
|---|
| 255 | IMPLICIT NONE |
|---|
| 256 | INTEGER :: attr_name |
|---|
| 257 | CHARACTER(LEN=*),TARGET :: value(:) |
|---|
| 258 | |
|---|
| 259 | TYPE(attribut) :: attr_string1 |
|---|
| 260 | attr_string1%object=attr_get_object(attr_name) |
|---|
| 261 | attr_string1%name=attr_name |
|---|
| 262 | attr_string1%type=string1 |
|---|
| 263 | attr_string1%string_len=LEN(value) |
|---|
| 264 | attr_string1%string1_ptr=>value |
|---|
| 265 | |
|---|
| 266 | END FUNCTION attr_string1 |
|---|
| 267 | |
|---|
| 268 | FUNCTION attr_string2(attr_name,value) |
|---|
| 269 | USE mod_stdtype |
|---|
| 270 | IMPLICIT NONE |
|---|
| 271 | INTEGER :: attr_name |
|---|
| 272 | CHARACTER(LEN=*),TARGET :: value(:,:) |
|---|
| 273 | |
|---|
| 274 | TYPE(attribut) :: attr_string2 |
|---|
| 275 | attr_string2%object=attr_get_object(attr_name) |
|---|
| 276 | attr_string2%name=attr_name |
|---|
| 277 | attr_string2%type=string2 |
|---|
| 278 | attr_string2%string_len=LEN(value) |
|---|
| 279 | attr_string2%string2_ptr=>value |
|---|
| 280 | |
|---|
| 281 | END FUNCTION attr_string2 |
|---|
| 282 | |
|---|
| 283 | END MODULE mod_attribut |
|---|
