[8] | 1 | MODULE mod_event_server |
---|
[192] | 2 | USE mod_pack, ONLY : unpack_data, unpack_field |
---|
[8] | 3 | USE mod_event_parameters |
---|
| 4 | USE iomanager |
---|
| 5 | |
---|
| 6 | CONTAINS |
---|
| 7 | |
---|
| 8 | SUBROUTINE Process_event(current_rank,is_terminated) |
---|
| 9 | IMPLICIT NONE |
---|
| 10 | INTEGER :: event_id |
---|
| 11 | INTEGER, INTENT(IN) :: current_rank |
---|
| 12 | LOGICAL,INTENT(OUT) :: is_terminated |
---|
| 13 | |
---|
| 14 | CALL iom__set_current_rank(current_rank) |
---|
| 15 | |
---|
| 16 | is_terminated=.FALSE. |
---|
| 17 | |
---|
[192] | 18 | CALL unpack_data(event_id) |
---|
[8] | 19 | |
---|
| 20 | SELECT CASE (event_id) |
---|
| 21 | |
---|
[26] | 22 | CASE (event_id_swap_context) |
---|
| 23 | CALL event__swap_context |
---|
| 24 | |
---|
[8] | 25 | CASE (event_id_parse_xml_file) |
---|
| 26 | CALL event__parse_xml_file |
---|
| 27 | |
---|
| 28 | CASE (event_id_set_vert_axis) |
---|
| 29 | CALL event__set_vert_axis |
---|
| 30 | |
---|
| 31 | CASE (event_id_set_grid_dimension) |
---|
| 32 | CALL event__set_grid_dimension |
---|
| 33 | |
---|
| 34 | CASE (event_id_set_grid_domain) |
---|
| 35 | CALL event__set_grid_domain |
---|
| 36 | |
---|
| 37 | CASE (event_id_set_grid_type_nemo) |
---|
| 38 | CALL event__set_grid_type_nemo |
---|
| 39 | |
---|
[26] | 40 | CASE (event_id_set_grid_type_lmdz) |
---|
| 41 | CALL event__set_grid_type_lmdz |
---|
| 42 | |
---|
[8] | 43 | CASE (event_id_set_time_parameters) |
---|
| 44 | CALL event__set_time_parameters |
---|
| 45 | |
---|
| 46 | CASE (event_id_close_io_definition) |
---|
| 47 | CALL event__close_io_definition |
---|
| 48 | |
---|
| 49 | CASE (event_id_set_timestep) |
---|
| 50 | CALL event__set_timestep |
---|
| 51 | |
---|
[50] | 52 | CASE (event_id_set_calendar) |
---|
| 53 | CALL event__set_calendar |
---|
| 54 | |
---|
[8] | 55 | CASE (event_id_enable_field) |
---|
| 56 | CALL event__enable_field |
---|
| 57 | |
---|
| 58 | CASE (event_id_disable_field) |
---|
| 59 | CALL event__disable_field |
---|
| 60 | |
---|
[26] | 61 | CASE (event_id_write_Field1d) |
---|
| 62 | CALL event__write_Field1d |
---|
| 63 | |
---|
[8] | 64 | CASE (event_id_write_Field2d) |
---|
| 65 | CALL event__write_Field2d |
---|
| 66 | |
---|
| 67 | CASE (event_id_write_Field3d) |
---|
| 68 | CALL event__write_Field3d |
---|
| 69 | |
---|
[40] | 70 | CASE (event_id_set_attribut) |
---|
| 71 | CALL event__set_attribut |
---|
| 72 | |
---|
[8] | 73 | CASE (event_id_stop_ioserver) |
---|
| 74 | is_terminated=.TRUE. |
---|
| 75 | PRINT *,"TERMINATE_EVENT RECEIVED" |
---|
[50] | 76 | |
---|
[8] | 77 | |
---|
| 78 | CASE DEFAULT |
---|
| 79 | STOP 'UNDEFINED EVENT' |
---|
| 80 | |
---|
| 81 | END SELECT |
---|
| 82 | |
---|
| 83 | END SUBROUTINE Process_event |
---|
| 84 | |
---|
[26] | 85 | SUBROUTINE event__swap_context |
---|
| 86 | IMPLICIT NONE |
---|
| 87 | INTEGER :: id_size |
---|
| 88 | |
---|
[192] | 89 | CALL unpack_data(id_size) |
---|
[26] | 90 | CALL sub_internal(id_size) |
---|
| 91 | |
---|
| 92 | CONTAINS |
---|
| 93 | |
---|
| 94 | SUBROUTINE sub_internal(id_size) |
---|
| 95 | INTEGER :: id_size |
---|
| 96 | CHARACTER(LEN=id_size) :: id |
---|
| 97 | |
---|
[192] | 98 | CALL unpack_data(id) |
---|
[26] | 99 | |
---|
| 100 | CALL iom__swap_context(id) |
---|
| 101 | |
---|
| 102 | END SUBROUTINE sub_internal |
---|
| 103 | |
---|
| 104 | END SUBROUTINE event__swap_context |
---|
| 105 | |
---|
[8] | 106 | |
---|
| 107 | SUBROUTINE event__parse_xml_file |
---|
| 108 | IMPLICIT NONE |
---|
| 109 | INTEGER :: name_size |
---|
| 110 | |
---|
[192] | 111 | CALL unpack_data(name_size) |
---|
[8] | 112 | CALL sub_internal(name_size) |
---|
| 113 | |
---|
| 114 | CONTAINS |
---|
| 115 | |
---|
| 116 | SUBROUTINE sub_internal(name_size) |
---|
| 117 | INTEGER :: name_size |
---|
| 118 | CHARACTER(LEN=name_size) :: filename |
---|
| 119 | |
---|
[192] | 120 | CALL unpack_data(filename) |
---|
[8] | 121 | |
---|
| 122 | CALL iom__parse_xml_file(filename) |
---|
| 123 | END SUBROUTINE sub_internal |
---|
| 124 | |
---|
| 125 | END SUBROUTINE event__parse_xml_file |
---|
| 126 | |
---|
| 127 | |
---|
| 128 | SUBROUTINE event__set_grid_dimension |
---|
| 129 | IMPLICIT NONE |
---|
| 130 | INTEGER :: name_size |
---|
| 131 | INTEGER :: ni_glo |
---|
| 132 | INTEGER :: nj_glo |
---|
| 133 | |
---|
[192] | 134 | CALL unpack_data(name_size) |
---|
[8] | 135 | CALL sub_internal(name_size) |
---|
| 136 | |
---|
| 137 | CONTAINS |
---|
| 138 | |
---|
| 139 | SUBROUTINE sub_internal(name_size) |
---|
| 140 | INTEGER :: name_size |
---|
| 141 | CHARACTER(LEN=name_size) :: name |
---|
| 142 | |
---|
[192] | 143 | CALL unpack_data(name) |
---|
| 144 | CALL unpack_data(ni_glo) |
---|
| 145 | CALL unpack_data(nj_glo) |
---|
[8] | 146 | |
---|
| 147 | CALL iom__set_grid_dimension(name,ni_glo,nj_glo) |
---|
| 148 | END SUBROUTINE sub_internal |
---|
| 149 | |
---|
| 150 | END SUBROUTINE event__set_grid_dimension |
---|
| 151 | |
---|
| 152 | |
---|
| 153 | SUBROUTINE event__set_grid_domain |
---|
| 154 | IMPLICIT NONE |
---|
| 155 | INTEGER :: name_size |
---|
| 156 | INTEGER :: ni |
---|
| 157 | INTEGER :: nj |
---|
| 158 | INTEGER :: ibegin |
---|
| 159 | INTEGER :: jbegin |
---|
| 160 | REAL,ALLOCATABLE :: lon(:,:) |
---|
| 161 | REAL,ALLOCATABLE :: lat(:,:) |
---|
| 162 | |
---|
[192] | 163 | CALL unpack_data(name_size) |
---|
[8] | 164 | CALL sub_internal(name_size) |
---|
| 165 | |
---|
| 166 | CONTAINS |
---|
| 167 | |
---|
| 168 | SUBROUTINE sub_internal(name_size) |
---|
| 169 | INTEGER :: name_size |
---|
| 170 | CHARACTER(LEN=name_size) :: name |
---|
| 171 | |
---|
[192] | 172 | CALL unpack_data(name) |
---|
[8] | 173 | |
---|
[192] | 174 | CALL unpack_data(ni) |
---|
| 175 | CALL unpack_data(nj) |
---|
| 176 | CALL unpack_data(ibegin) |
---|
| 177 | CALL unpack_data(jbegin) |
---|
[8] | 178 | |
---|
| 179 | ALLOCATE(lon(ni,nj)) |
---|
| 180 | ALLOCATE(lat(ni,nj)) |
---|
[192] | 181 | CALL unpack_data(lon) |
---|
| 182 | CALL unpack_data(lat) |
---|
[8] | 183 | |
---|
| 184 | CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat) |
---|
| 185 | |
---|
| 186 | END SUBROUTINE sub_internal |
---|
| 187 | |
---|
| 188 | END SUBROUTINE event__set_grid_domain |
---|
| 189 | |
---|
| 190 | |
---|
| 191 | SUBROUTINE event__set_grid_type_nemo |
---|
| 192 | IMPLICIT NONE |
---|
| 193 | INTEGER :: name_size |
---|
| 194 | |
---|
[192] | 195 | CALL unpack_data(name_size) |
---|
[8] | 196 | CALL sub_internal(name_size) |
---|
| 197 | |
---|
| 198 | CONTAINS |
---|
| 199 | |
---|
| 200 | SUBROUTINE sub_internal(name_size) |
---|
| 201 | INTEGER :: name_size |
---|
| 202 | CHARACTER(LEN=name_size) :: name |
---|
| 203 | |
---|
[192] | 204 | CALL unpack_data(name) |
---|
[8] | 205 | CALL iom__set_grid_type_nemo(name) |
---|
| 206 | |
---|
| 207 | END SUBROUTINE sub_internal |
---|
| 208 | |
---|
| 209 | END SUBROUTINE event__set_grid_type_nemo |
---|
| 210 | |
---|
[26] | 211 | SUBROUTINE event__set_grid_type_lmdz |
---|
| 212 | IMPLICIT NONE |
---|
| 213 | INTEGER :: name_size |
---|
[8] | 214 | |
---|
[192] | 215 | CALL unpack_data(name_size) |
---|
[26] | 216 | CALL sub_internal(name_size) |
---|
| 217 | |
---|
| 218 | CONTAINS |
---|
| 219 | |
---|
| 220 | SUBROUTINE sub_internal(name_size) |
---|
| 221 | INTEGER :: name_size |
---|
| 222 | CHARACTER(LEN=name_size) :: name |
---|
| 223 | INTEGER :: nbp |
---|
| 224 | INTEGER :: offset |
---|
| 225 | |
---|
[192] | 226 | CALL unpack_data(name) |
---|
| 227 | CALL unpack_data(nbp) |
---|
| 228 | CALL unpack_data(offset) |
---|
[26] | 229 | CALL iom__set_grid_type_lmdz(name,nbp,offset) |
---|
| 230 | |
---|
| 231 | END SUBROUTINE sub_internal |
---|
| 232 | |
---|
| 233 | END SUBROUTINE event__set_grid_type_lmdz |
---|
| 234 | |
---|
[8] | 235 | SUBROUTINE event__set_vert_axis |
---|
| 236 | IMPLICIT NONE |
---|
| 237 | INTEGER :: name_size |
---|
| 238 | INTEGER :: vert_size |
---|
| 239 | REAL,ALLOCATABLE :: vert_value(:) |
---|
| 240 | |
---|
[192] | 241 | CALL unpack_data(name_size) |
---|
[8] | 242 | CALL sub_internal(name_size) |
---|
| 243 | |
---|
| 244 | CONTAINS |
---|
| 245 | |
---|
| 246 | SUBROUTINE sub_internal(name_size) |
---|
| 247 | INTEGER :: name_size |
---|
| 248 | CHARACTER(LEN=name_size) :: name |
---|
| 249 | |
---|
[192] | 250 | CALL unpack_data(name) |
---|
| 251 | CALL unpack_data(vert_size) |
---|
[8] | 252 | ALLOCATE(vert_value(vert_size)) |
---|
[192] | 253 | CALL unpack_data(vert_value) |
---|
[8] | 254 | |
---|
| 255 | CALL iom__set_vert_axis(name,vert_value) |
---|
| 256 | |
---|
| 257 | END SUBROUTINE sub_internal |
---|
| 258 | END SUBROUTINE event__set_vert_axis |
---|
| 259 | |
---|
| 260 | SUBROUTINE event__set_time_parameters |
---|
| 261 | IMPLICIT NONE |
---|
| 262 | INTEGER :: itau0 |
---|
| 263 | REAL :: zjulian |
---|
| 264 | REAL :: zdt |
---|
| 265 | |
---|
[192] | 266 | CALL unpack_data(itau0) |
---|
| 267 | CALL unpack_data(zjulian) |
---|
| 268 | CALL unpack_data(zdt) |
---|
[8] | 269 | |
---|
| 270 | CALL iom__set_time_parameters(itau0,zjulian,zdt) |
---|
| 271 | |
---|
| 272 | END SUBROUTINE event__set_time_parameters |
---|
| 273 | |
---|
| 274 | |
---|
| 275 | SUBROUTINE event__enable_field |
---|
| 276 | IMPLICIT NONE |
---|
| 277 | INTEGER :: lenc |
---|
| 278 | |
---|
[192] | 279 | CALL unpack_data(lenc) |
---|
[8] | 280 | CALL sub_internal(lenc) |
---|
| 281 | |
---|
| 282 | CONTAINS |
---|
| 283 | SUBROUTINE sub_internal(lenc) |
---|
| 284 | IMPLICIT NONE |
---|
| 285 | INTEGER :: lenc |
---|
| 286 | CHARACTER(len=lenc) :: varname |
---|
| 287 | |
---|
[192] | 288 | CALL unpack_data(varname) |
---|
[8] | 289 | |
---|
| 290 | CALL iom__enable_field(varname) |
---|
| 291 | |
---|
| 292 | END SUBROUTINE sub_internal |
---|
| 293 | END SUBROUTINE event__enable_field |
---|
| 294 | |
---|
| 295 | |
---|
| 296 | SUBROUTINE event__disable_field |
---|
| 297 | IMPLICIT NONE |
---|
| 298 | INTEGER :: lenc |
---|
| 299 | |
---|
[192] | 300 | CALL unpack_data(lenc) |
---|
[8] | 301 | CALL sub_internal(lenc) |
---|
| 302 | |
---|
| 303 | CONTAINS |
---|
| 304 | SUBROUTINE sub_internal(lenc) |
---|
| 305 | IMPLICIT NONE |
---|
| 306 | INTEGER :: lenc |
---|
| 307 | CHARACTER(len=lenc) :: varname |
---|
| 308 | |
---|
[192] | 309 | CALL unpack_data(varname) |
---|
[8] | 310 | |
---|
| 311 | CALL iom__disable_field(varname) |
---|
| 312 | |
---|
| 313 | END SUBROUTINE sub_internal |
---|
| 314 | |
---|
| 315 | END SUBROUTINE event__disable_field |
---|
| 316 | |
---|
| 317 | |
---|
[26] | 318 | SUBROUTINE event__write_field1D |
---|
| 319 | IMPLICIT NONE |
---|
| 320 | INTEGER :: lenc |
---|
| 321 | INTEGER :: dim1 |
---|
| 322 | |
---|
[192] | 323 | CALL unpack_data(lenc) |
---|
| 324 | CALL unpack_data(dim1) |
---|
[26] | 325 | CALL sub_internal(lenc,dim1) |
---|
| 326 | |
---|
| 327 | CONTAINS |
---|
| 328 | SUBROUTINE sub_internal(lenc,dim1) |
---|
| 329 | IMPLICIT NONE |
---|
| 330 | INTEGER :: lenc |
---|
| 331 | INTEGER :: dim1 |
---|
| 332 | CHARACTER(len=lenc) :: varname |
---|
| 333 | REAL :: var(dim1) |
---|
| 334 | |
---|
[192] | 335 | CALL unpack_data(varname) |
---|
[26] | 336 | CALL unpack_field(var) |
---|
| 337 | |
---|
| 338 | CALL iom__write_Field1d(varname,var) |
---|
| 339 | |
---|
| 340 | END SUBROUTINE sub_internal |
---|
| 341 | END SUBROUTINE event__write_field1d |
---|
| 342 | |
---|
[8] | 343 | SUBROUTINE event__write_field2D |
---|
| 344 | IMPLICIT NONE |
---|
| 345 | INTEGER :: lenc |
---|
| 346 | INTEGER :: dim1 |
---|
| 347 | INTEGER :: dim2 |
---|
| 348 | |
---|
[192] | 349 | CALL unpack_data(lenc) |
---|
| 350 | CALL unpack_data(dim1) |
---|
| 351 | CALL unpack_data(dim2) |
---|
[8] | 352 | CALL sub_internal(lenc,dim1,dim2) |
---|
| 353 | |
---|
| 354 | CONTAINS |
---|
| 355 | SUBROUTINE sub_internal(lenc,dim1,dim2) |
---|
| 356 | IMPLICIT NONE |
---|
| 357 | INTEGER :: lenc |
---|
| 358 | INTEGER :: dim1 |
---|
| 359 | INTEGER :: dim2 |
---|
| 360 | CHARACTER(len=lenc) :: varname |
---|
| 361 | REAL :: var(dim1,dim2) |
---|
| 362 | |
---|
[192] | 363 | CALL unpack_data(varname) |
---|
[8] | 364 | CALL unpack_field(var) |
---|
| 365 | |
---|
| 366 | CALL iom__write_Field2d(varname,var) |
---|
| 367 | |
---|
| 368 | END SUBROUTINE sub_internal |
---|
| 369 | END SUBROUTINE event__write_field2d |
---|
| 370 | |
---|
| 371 | |
---|
| 372 | SUBROUTINE event__write_field3d |
---|
| 373 | IMPLICIT NONE |
---|
| 374 | INTEGER :: lenc |
---|
| 375 | INTEGER :: dim1 |
---|
| 376 | INTEGER :: dim2 |
---|
| 377 | INTEGER :: dim3 |
---|
| 378 | |
---|
[192] | 379 | CALL unpack_data(lenc) |
---|
| 380 | CALL unpack_data(dim1) |
---|
| 381 | CALL unpack_data(dim2) |
---|
| 382 | CALL unpack_data(dim3) |
---|
[8] | 383 | CALL sub_internal(lenc,dim1,dim2,dim3) |
---|
| 384 | |
---|
| 385 | CONTAINS |
---|
| 386 | |
---|
| 387 | SUBROUTINE sub_internal(lenc,dim1,dim2,dim3) |
---|
| 388 | IMPLICIT NONE |
---|
| 389 | INTEGER :: lenc |
---|
| 390 | INTEGER :: dim1 |
---|
| 391 | INTEGER :: dim2 |
---|
| 392 | INTEGER :: dim3 |
---|
| 393 | |
---|
| 394 | CHARACTER(len=lenc) :: varname |
---|
| 395 | REAL :: var(dim1,dim2,dim3) |
---|
| 396 | |
---|
[192] | 397 | CALL unpack_data(varname) |
---|
[8] | 398 | CALL unpack_field(var) |
---|
| 399 | |
---|
| 400 | CALL iom__write_field3d(varname,var) |
---|
| 401 | |
---|
| 402 | END SUBROUTINE sub_internal |
---|
| 403 | |
---|
| 404 | END SUBROUTINE event__write_field3d |
---|
| 405 | |
---|
| 406 | |
---|
| 407 | SUBROUTINE event__set_timestep |
---|
| 408 | IMPLICIT NONE |
---|
| 409 | INTEGER :: timestep |
---|
| 410 | |
---|
[192] | 411 | CALL unpack_data(timestep) |
---|
[8] | 412 | CALL iom__set_timestep(timestep) |
---|
| 413 | |
---|
| 414 | END SUBROUTINE event__set_timestep |
---|
| 415 | |
---|
[50] | 416 | |
---|
| 417 | SUBROUTINE event__set_calendar |
---|
| 418 | IMPLICIT NONE |
---|
| 419 | INTEGER :: lenc |
---|
| 420 | |
---|
[192] | 421 | CALL unpack_data(lenc) |
---|
[50] | 422 | CALL sub_internal(lenc) |
---|
| 423 | |
---|
| 424 | CONTAINS |
---|
| 425 | SUBROUTINE sub_internal(lenc) |
---|
| 426 | IMPLICIT NONE |
---|
| 427 | INTEGER :: lenc |
---|
| 428 | CHARACTER(len=lenc) :: str_calendar |
---|
| 429 | |
---|
[192] | 430 | CALL unpack_data(str_calendar) |
---|
[50] | 431 | |
---|
| 432 | CALL iom__set_calendar(str_calendar) |
---|
| 433 | |
---|
| 434 | END SUBROUTINE sub_internal |
---|
| 435 | END SUBROUTINE event__set_calendar |
---|
| 436 | |
---|
[8] | 437 | |
---|
| 438 | SUBROUTINE event__close_io_definition |
---|
| 439 | IMPLICIT NONE |
---|
| 440 | |
---|
| 441 | CALL iom__close_io_definition |
---|
| 442 | |
---|
| 443 | END SUBROUTINE event__close_io_definition |
---|
[40] | 444 | |
---|
| 445 | SUBROUTINE event__set_attribut |
---|
| 446 | USE mod_attribut |
---|
| 447 | IMPLICIT NONE |
---|
| 448 | TYPE(attribut) :: attrib |
---|
| 449 | INTEGER :: len_id |
---|
| 450 | |
---|
[192] | 451 | CALL unpack_data(len_id) |
---|
[40] | 452 | CALL sub_internal |
---|
| 453 | CONTAINS |
---|
| 454 | |
---|
| 455 | SUBROUTINE sub_internal |
---|
| 456 | CHARACTER(LEN=len_id) :: id |
---|
| 457 | |
---|
[192] | 458 | CALL unpack_data(id) |
---|
| 459 | CALL unpack_data(attrib) |
---|
[40] | 460 | CALL iom__set_attribut(id,attrib) |
---|
| 461 | CALL attr_deallocate(attrib) |
---|
| 462 | END SUBROUTINE sub_internal |
---|
| 463 | END SUBROUTINE event__set_attribut |
---|
| 464 | |
---|
[8] | 465 | END MODULE mod_event_server |
---|