wrftladj/module_linked_list2.F

   1 module module_linked_list2
   2     type linked_list
   3         integer :: id                      ! id
   4         character(len=256) :: name         ! name
   5         real, pointer :: value(:)          ! data
   6         type(linked_list), pointer :: next ! pointer to the next element
   7     end type linked_list
   8
   9     type(linked_list), pointer :: linklist_head, linklist_tail
  10
  11    INTERFACE push4backup
  12      MODULE PROCEDURE push_1_array,  push_2_arrays, push_3_arrays, push_4_arrays, push_5_arrays, &
  13                       push_6_arrays, push_7_arrays, push_8_arrays, push_9_arrays, push_10_arrays, &
  14                       push_2d_1_array,  push_2d_2_arrays, push_2d_3_arrays, push_2d_4_arrays, push_2d_5_arrays, &
  15                       push_2d_6_arrays, push_2d_7_arrays, push_2d_8_arrays, push_2d_9_arrays, push_2d_10_arrays, &
  16                       push_3d_1_array,  push_3d_2_arrays, push_3d_3_arrays, push_3d_4_arrays, push_3d_5_arrays, &
  17                       push_3d_6_arrays, push_3d_7_arrays, push_3d_8_arrays, push_3d_9_arrays, push_3d_10_arrays, &
  18                       push_4d_1_array,  push_4d_2_arrays, push_4d_3_arrays, push_4d_4_arrays, push_4d_5_arrays, &
  19                       push_4d_6_arrays, push_4d_7_arrays, push_4d_8_arrays, push_4d_9_arrays, push_4d_10_arrays
  20    END INTERFACE
  21
  22    INTERFACE pop2restore
  23      MODULE PROCEDURE pop_1_array,  pop_2_arrays, pop_3_arrays, pop_4_arrays, pop_5_arrays, &
  24                       pop_6_arrays, pop_7_arrays, pop_8_arrays, pop_9_arrays, pop_10_arrays, &
  25                       pop_2d_1_array,  pop_2d_2_arrays, pop_2d_3_arrays, pop_2d_4_arrays, pop_2d_5_arrays, &
  26                       pop_2d_6_arrays, pop_2d_7_arrays, pop_2d_8_arrays, pop_2d_9_arrays, pop_2d_10_arrays, &
  27                       pop_3d_1_array,  pop_3d_2_arrays, pop_3d_3_arrays, pop_3d_4_arrays, pop_3d_5_arrays, &
  28                       pop_3d_6_arrays, pop_3d_7_arrays, pop_3d_8_arrays, pop_3d_9_arrays, pop_3d_10_arrays, &
  29                       pop_4d_1_array,  pop_4d_2_arrays, pop_4d_3_arrays, pop_4d_4_arrays, pop_4d_5_arrays, &
  30                       pop_4d_6_arrays, pop_4d_7_arrays, pop_4d_8_arrays, pop_4d_9_arrays, pop_4d_10_arrays
  31    END INTERFACE
  32
  33    INTERFACE backup_array
  34      MODULE PROCEDURE backup_1d_array, backup_2d_array, backup_3d_array, backup_4d_array
  35    END INTERFACE
  36
  37    INTERFACE restore_array
  38      MODULE PROCEDURE restore_1d_array, restore_2d_array, restore_3d_array, restore_4d_array
  39    END INTERFACE
  40
  41 contains
  42
  43 subroutine linkedlist_initialize
  44
  45     implicit none
  46
  47     type(linked_list), pointer :: current
  48
  49     current => linklist_head
  50     do while (associated(current))
  51         linklist_head => current%next
  52         deallocate(current%value)
  53         deallocate(current)
  54         current => linklist_head
  55     enddo
  56
  57     nullify(linklist_head)
  58
  59     print *, "linkedlist_initialized."
  60
  61 end subroutine linkedlist_initialize
  62
  63 subroutine check_linkedlist
  64
  65     implicit none
  66
  67     type(linked_list), pointer :: current
  68
  69     current => linklist_head
  70     do while (associated(current))
  71         write(unit=6, fmt='(a,i4,3a)') 'check id:', current%id, ', name: <', trim(current%name), '>'
  72         current => current%next
  73     enddo
  74
  75 end subroutine check_linkedlist
  76
  77 subroutine push_1_array(a1, varname)
  78
  79     implicit none
  80
  81     real, dimension(:), intent(in) :: a1
  82     character(len=*), intent(in) :: varname
  83
  84     integer :: length
  85
  86     type(linked_list), pointer :: current
  87
  88     length = size(a1)
  89
  90     if(.not. associated(linklist_head)) then
  91         nullify(linklist_head)
  92
  93         allocate(linklist_head)
  94         allocate(linklist_head%value(length))
  95         nullify(linklist_head%next)
  96
  97         linklist_head%id = 1
  98         linklist_head%name = varname
  99         linklist_head%value(:) = a1(:)
 100
 101         linklist_tail => linklist_head
 102     else
 103         allocate(current)
 104         allocate(current%value(length))
 105         nullify(current%next)
 106         current%id = linklist_head%id + 1
 107         current%name = varname
 108         current%value(:) = a1(:)
 109         current%next => linklist_head
 110         linklist_head => current
 111     endif
 112
 113 !   write(unit=*, fmt='(a,i4,3a)') &
 114 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 115
 116 end subroutine push_1_array
 117
 118 subroutine pop_1_array(a1, varname)
 119
 120     implicit none
 121
 122     real, dimension(:), intent(out) :: a1
 123     character(len=*), intent(in) :: varname
 124
 125     integer :: length
 126
 127     type(linked_list), pointer :: current
 128
 129     length = size(a1)
 130
 131     current => linklist_head
 132
 133     if(trim(current%name) /= trim(varname)) then
 134        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 135        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 136        return
 137     endif
 138
 139 !   write(unit=*, fmt='(a,i4,3a)') &
 140 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 141
 142     a1(1:length) = current%value(1:length)
 143
 144     current => current%next
 145
 146     nullify(linklist_head%next)
 147     deallocate(linklist_head%value)
 148     deallocate(linklist_head)
 149     linklist_head => current
 150
 151 end subroutine pop_1_array
 152
 153 subroutine push_2_arrays(a1, a2, varname)
 154
 155     implicit none
 156
 157     real, dimension(:), intent(in) :: a1, a2
 158     character(len=*), intent(in) :: varname
 159
 160     type(linked_list), pointer :: current
 161
 162     integer :: n
 163     integer, dimension(2) :: len
 164     integer, dimension(0:2) :: num
 165
 166     len(1) = size(a1)
 167     len(2) = size(a2)
 168
 169     num(0) = 0
 170     do n=1, 2
 171        num(n) = num(n-1) + len(n)
 172     enddo
 173
 174     if(.not. associated(linklist_head)) then
 175         nullify(linklist_head)
 176
 177         allocate(linklist_head)
 178         allocate(linklist_head%value(num(2)))
 179         nullify(linklist_head%next)
 180
 181         linklist_head%id = 1
 182         linklist_head%name = varname
 183         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 184         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 185
 186         linklist_tail => linklist_head
 187     else
 188         allocate(current)
 189         allocate(current%value(num(2)))
 190         nullify(current%next)
 191         current%id = linklist_head%id + 1
 192         current%name = varname
 193         current%value(num(0)+1:num(1)) = a1(1:len(1))
 194         current%value(num(1)+1:num(2)) = a2(1:len(2))
 195         current%next => linklist_head
 196         linklist_head => current
 197     endif
 198
 199 !   write(unit=*, fmt='(a,i4,3a)') &
 200 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 201
 202 end subroutine push_2_arrays
 203
 204 subroutine pop_2_arrays(a1, a2, varname)
 205
 206     implicit none
 207
 208     real, dimension(:), intent(out) :: a1, a2
 209     character(len=*), intent(in) :: varname
 210
 211     type(linked_list), pointer :: current
 212
 213     integer :: n
 214     integer, dimension(2) :: len
 215     integer, dimension(0:2) :: num
 216
 217     len(1) = size(a1)
 218     len(2) = size(a2)
 219
 220     num(0) = 0
 221     do n=1, 2
 222        num(n) = num(n-1) + len(n)
 223     enddo
 224
 225     current => linklist_head
 226
 227     if(trim(current%name) /= trim(varname)) then
 228        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 229        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 230        return
 231     endif
 232
 233 !   write(unit=*, fmt='(a,i4,3a)') &
 234 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 235
 236     a1(1:len(1)) = current%value(num(0)+1:num(1))
 237     a2(1:len(2)) = current%value(num(1)+1:num(2))
 238
 239     current => current%next
 240
 241     nullify(linklist_head%next)
 242     deallocate(linklist_head%value)
 243     deallocate(linklist_head)
 244     linklist_head => current
 245
 246 end subroutine pop_2_arrays
 247
 248 subroutine push_3_arrays(a1, a2, a3, varname)
 249
 250     implicit none
 251
 252     real, dimension(:), intent(in) :: a1, a2, a3
 253     character(len=*), intent(in) :: varname
 254
 255     type(linked_list), pointer :: current
 256
 257     integer :: n
 258     integer, dimension(3) :: len
 259     integer, dimension(0:3) :: num
 260
 261     len(1) = size(a1)
 262     len(2) = size(a2)
 263     len(3) = size(a3)
 264
 265     num(0) = 0
 266     do n=1, 3
 267        num(n) = num(n-1) + len(n)
 268     enddo
 269
 270     if(.not. associated(linklist_head)) then
 271         nullify(linklist_head)
 272
 273         allocate(linklist_head)
 274         allocate(linklist_head%value(num(3)))
 275         nullify(linklist_head%next)
 276
 277         linklist_head%id = 1
 278         linklist_head%name = varname
 279         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 280         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 281         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 282
 283         linklist_tail => linklist_head
 284     else
 285         allocate(current)
 286         allocate(current%value(num(3)))
 287         nullify(current%next)
 288         current%id = linklist_head%id + 1
 289         current%name = varname
 290         current%value(num(0)+1:num(1)) = a1(1:len(1))
 291         current%value(num(1)+1:num(2)) = a2(1:len(2))
 292         current%value(num(2)+1:num(3)) = a3(1:len(3))
 293         current%next => linklist_head
 294         linklist_head => current
 295     endif
 296
 297 !   write(unit=*, fmt='(a,i4,3a)') &
 298 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 299
 300 end subroutine push_3_arrays
 301
 302 subroutine pop_3_arrays(a1, a2, a3, varname)
 303
 304     implicit none
 305
 306     real, dimension(:), intent(out) :: a1, a2, a3
 307     character(len=*), intent(in) :: varname
 308
 309     type(linked_list), pointer :: current
 310
 311     integer :: n
 312     integer, dimension(3) :: len
 313     integer, dimension(0:3) :: num
 314
 315     len(1) = size(a1)
 316     len(2) = size(a2)
 317     len(3) = size(a3)
 318
 319     num(0) = 0
 320     do n=1, 3
 321        num(n) = num(n-1) + len(n)
 322     enddo
 323
 324     current => linklist_head
 325
 326     if(trim(current%name) /= trim(varname)) then
 327        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 328        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 329        return
 330     endif
 331
 332 !   write(unit=*, fmt='(a,i4,3a)') &
 333 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 334
 335     a1(1:len(1)) = current%value(num(0)+1:num(1))
 336     a2(1:len(2)) = current%value(num(1)+1:num(2))
 337     a3(1:len(3)) = current%value(num(2)+1:num(3))
 338
 339     current => current%next
 340
 341     nullify(linklist_head%next)
 342     deallocate(linklist_head%value)
 343     deallocate(linklist_head)
 344     linklist_head => current
 345
 346 end subroutine pop_3_arrays
 347
 348 subroutine push_4_arrays(a1, a2, a3, a4, varname)
 349
 350     implicit none
 351
 352     real, dimension(:), intent(in) :: a1, a2, a3, a4
 353     character(len=*), intent(in) :: varname
 354
 355     type(linked_list), pointer :: current
 356
 357     integer :: n
 358     integer, dimension(4) :: len
 359     integer, dimension(0:4) :: num
 360
 361     len(1) = size(a1)
 362     len(2) = size(a2)
 363     len(3) = size(a3)
 364     len(4) = size(a4)
 365
 366     num(0) = 0
 367     do n=1, 4
 368        num(n) = num(n-1) + len(n)
 369     enddo
 370
 371     if(.not. associated(linklist_head)) then
 372         nullify(linklist_head)
 373
 374         allocate(linklist_head)
 375         allocate(linklist_head%value(num(4)))
 376         nullify(linklist_head%next)
 377
 378         linklist_head%id = 1
 379         linklist_head%name = varname
 380         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 381         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 382         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 383         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 384
 385         linklist_tail => linklist_head
 386     else
 387         allocate(current)
 388         allocate(current%value(num(4)))
 389         nullify(current%next)
 390         current%id = linklist_head%id + 1
 391         current%name = varname
 392         current%value(num(0)+1:num(1)) = a1(1:len(1))
 393         current%value(num(1)+1:num(2)) = a2(1:len(2))
 394         current%value(num(2)+1:num(3)) = a3(1:len(3))
 395         current%value(num(3)+1:num(4)) = a4(1:len(4))
 396         current%next => linklist_head
 397         linklist_head => current
 398     endif
 399
 400 !   write(unit=*, fmt='(a,i4,3a)') &
 401 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 402
 403 end subroutine push_4_arrays
 404
 405 subroutine pop_4_arrays(a1, a2, a3, a4, varname)
 406
 407     implicit none
 408
 409     real, dimension(:), intent(out) :: a1, a2, a3, a4
 410     character(len=*), intent(in) :: varname
 411
 412     type(linked_list), pointer :: current
 413
 414     integer :: n
 415     integer, dimension(4) :: len
 416     integer, dimension(0:4) :: num
 417
 418     len(1) = size(a1)
 419     len(2) = size(a2)
 420     len(3) = size(a3)
 421     len(4) = size(a4)
 422
 423     num(0) = 0
 424     do n=1, 4
 425        num(n) = num(n-1) + len(n)
 426     enddo
 427
 428     current => linklist_head
 429
 430     if(trim(current%name) /= trim(varname)) then
 431        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 432        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 433        return
 434     endif
 435
 436 !   write(unit=*, fmt='(a,i4,3a)') &
 437 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 438
 439     a1(1:len(1)) = current%value(num(0)+1:num(1))
 440     a2(1:len(2)) = current%value(num(1)+1:num(2))
 441     a3(1:len(3)) = current%value(num(2)+1:num(3))
 442     a4(1:len(4)) = current%value(num(3)+1:num(4))
 443
 444     current => current%next
 445
 446     nullify(linklist_head%next)
 447     deallocate(linklist_head%value)
 448     deallocate(linklist_head)
 449     linklist_head => current
 450
 451 end subroutine pop_4_arrays
 452
 453 subroutine push_5_arrays(a1, a2, a3, a4, a5, varname)
 454
 455     implicit none
 456
 457     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5
 458     character(len=*), intent(in) :: varname
 459
 460     type(linked_list), pointer :: current
 461
 462     integer :: n
 463     integer, dimension(5) :: len
 464     integer, dimension(0:5) :: num
 465
 466     len(1) = size(a1)
 467     len(2) = size(a2)
 468     len(3) = size(a3)
 469     len(4) = size(a4)
 470     len(5) = size(a5)
 471
 472     num(0) = 0
 473     do n=1, 5
 474        num(n) = num(n-1) + len(n)
 475     enddo
 476
 477     if(.not. associated(linklist_head)) then
 478         nullify(linklist_head)
 479
 480         allocate(linklist_head)
 481         allocate(linklist_head%value(num(5)))
 482         nullify(linklist_head%next)
 483
 484         linklist_head%id = 1
 485         linklist_head%name = varname
 486         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 487         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 488         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 489         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 490         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
 491
 492         linklist_tail => linklist_head
 493     else
 494         allocate(current)
 495         allocate(current%value(num(5)))
 496         nullify(current%next)
 497         current%id = linklist_head%id + 1
 498         current%name = varname
 499         current%value(num(0)+1:num(1)) = a1(1:len(1))
 500         current%value(num(1)+1:num(2)) = a2(1:len(2))
 501         current%value(num(2)+1:num(3)) = a3(1:len(3))
 502         current%value(num(3)+1:num(4)) = a4(1:len(4))
 503         current%value(num(4)+1:num(5)) = a5(1:len(5))
 504         current%next => linklist_head
 505         linklist_head => current
 506     endif
 507
 508 !   write(unit=*, fmt='(a,i4,3a)') &
 509 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 510
 511 end subroutine push_5_arrays
 512
 513 subroutine pop_5_arrays(a1, a2, a3, a4, a5, varname)
 514
 515     implicit none
 516
 517     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5
 518     character(len=*), intent(in) :: varname
 519
 520     type(linked_list), pointer :: current
 521
 522     integer :: n
 523     integer, dimension(5) :: len
 524     integer, dimension(0:5) :: num
 525
 526     len(1) = size(a1)
 527     len(2) = size(a2)
 528     len(3) = size(a3)
 529     len(4) = size(a4)
 530     len(5) = size(a5)
 531
 532     num(0) = 0
 533     do n=1, 5
 534        num(n) = num(n-1) + len(n)
 535     enddo
 536
 537     current => linklist_head
 538
 539     if(trim(current%name) /= trim(varname)) then
 540        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 541        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 542        return
 543     endif
 544
 545 !   write(unit=*, fmt='(a,i4,3a)') &
 546 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 547
 548     a1(1:len(1)) = current%value(num(0)+1:num(1))
 549     a2(1:len(2)) = current%value(num(1)+1:num(2))
 550     a3(1:len(3)) = current%value(num(2)+1:num(3))
 551     a4(1:len(4)) = current%value(num(3)+1:num(4))
 552     a5(1:len(5)) = current%value(num(4)+1:num(5))
 553
 554     current => current%next
 555
 556     nullify(linklist_head%next)
 557     deallocate(linklist_head%value)
 558     deallocate(linklist_head)
 559     linklist_head => current
 560
 561 end subroutine pop_5_arrays
 562
 563 subroutine push_6_arrays(a1, a2, a3, a4, a5, a6, varname)
 564
 565     implicit none
 566
 567     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5, a6
 568     character(len=*), intent(in) :: varname
 569
 570     type(linked_list), pointer :: current
 571
 572     integer :: n
 573     integer, dimension(6) :: len
 574     integer, dimension(0:6) :: num
 575
 576     len(1) = size(a1)
 577     len(2) = size(a2)
 578     len(3) = size(a3)
 579     len(4) = size(a4)
 580     len(5) = size(a5)
 581     len(6) = size(a6)
 582
 583     num(0) = 0
 584     do n=1, 6
 585        num(n) = num(n-1) + len(n)
 586     enddo
 587
 588     if(.not. associated(linklist_head)) then
 589         nullify(linklist_head)
 590
 591         allocate(linklist_head)
 592         allocate(linklist_head%value(num(6)))
 593         nullify(linklist_head%next)
 594
 595         linklist_head%id = 1
 596         linklist_head%name = varname
 597         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 598         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 599         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 600         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 601         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
 602         linklist_head%value(num(5)+1:num(6)) = a6(1:len(6))
 603
 604         linklist_tail => linklist_head
 605     else
 606         allocate(current)
 607         allocate(current%value(num(6)))
 608         nullify(current%next)
 609         current%id = linklist_head%id + 1
 610         current%name = varname
 611         current%value(num(0)+1:num(1)) = a1(1:len(1))
 612         current%value(num(1)+1:num(2)) = a2(1:len(2))
 613         current%value(num(2)+1:num(3)) = a3(1:len(3))
 614         current%value(num(3)+1:num(4)) = a4(1:len(4))
 615         current%value(num(4)+1:num(5)) = a5(1:len(5))
 616         current%value(num(5)+1:num(6)) = a6(1:len(6))
 617         current%next => linklist_head
 618         linklist_head => current
 619     endif
 620
 621 !   write(unit=*, fmt='(a,i4,3a)') &
 622 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 623
 624 end subroutine push_6_arrays
 625
 626 subroutine pop_6_arrays(a1, a2, a3, a4, a5, a6, varname)
 627
 628     implicit none
 629
 630     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5, a6
 631     character(len=*), intent(in) :: varname
 632
 633     type(linked_list), pointer :: current
 634
 635     integer :: n
 636     integer, dimension(6) :: len
 637     integer, dimension(0:6) :: num
 638
 639     len(1) = size(a1)
 640     len(2) = size(a2)
 641     len(3) = size(a3)
 642     len(4) = size(a4)
 643     len(5) = size(a5)
 644     len(6) = size(a6)
 645
 646     num(0) = 0
 647     do n=1, 6
 648        num(n) = num(n-1) + len(n)
 649     enddo
 650
 651     current => linklist_head
 652
 653     if(trim(current%name) /= trim(varname)) then
 654        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 655        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 656        return
 657     endif
 658
 659 !   write(unit=*, fmt='(a,i4,3a)') &
 660 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 661
 662     a1(1:len(1)) = current%value(num(0)+1:num(1))
 663     a2(1:len(2)) = current%value(num(1)+1:num(2))
 664     a3(1:len(3)) = current%value(num(2)+1:num(3))
 665     a4(1:len(4)) = current%value(num(3)+1:num(4))
 666     a5(1:len(5)) = current%value(num(4)+1:num(5))
 667     a6(1:len(6)) = current%value(num(5)+1:num(6))
 668
 669     current => current%next
 670
 671     nullify(linklist_head%next)
 672     deallocate(linklist_head%value)
 673     deallocate(linklist_head)
 674     linklist_head => current
 675
 676 end subroutine pop_6_arrays
 677
 678 subroutine push_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
 679
 680     implicit none
 681
 682     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5, a6, a7
 683     character(len=*), intent(in) :: varname
 684
 685     type(linked_list), pointer :: current
 686
 687     integer :: n
 688     integer, dimension(7) :: len
 689     integer, dimension(0:7) :: num
 690
 691     len(1) = size(a1)
 692     len(2) = size(a2)
 693     len(3) = size(a3)
 694     len(4) = size(a4)
 695     len(5) = size(a5)
 696     len(6) = size(a6)
 697     len(7) = size(a7)
 698
 699     num(0) = 0
 700     do n=1, 7
 701        num(n) = num(n-1) + len(n)
 702     enddo
 703
 704     if(.not. associated(linklist_head)) then
 705         nullify(linklist_head)
 706
 707         allocate(linklist_head)
 708         allocate(linklist_head%value(num(7)))
 709         nullify(linklist_head%next)
 710
 711         linklist_head%id = 1
 712         linklist_head%name = varname
 713         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 714         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 715         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 716         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 717         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
 718         linklist_head%value(num(5)+1:num(6)) = a6(1:len(6))
 719         linklist_head%value(num(6)+1:num(7)) = a7(1:len(7))
 720
 721         linklist_tail => linklist_head
 722     else
 723         allocate(current)
 724         allocate(current%value(num(7)))
 725         nullify(current%next)
 726         current%id = linklist_head%id + 1
 727         current%name = varname
 728         current%value(num(0)+1:num(1)) = a1(1:len(1))
 729         current%value(num(1)+1:num(2)) = a2(1:len(2))
 730         current%value(num(2)+1:num(3)) = a3(1:len(3))
 731         current%value(num(3)+1:num(4)) = a4(1:len(4))
 732         current%value(num(4)+1:num(5)) = a5(1:len(5))
 733         current%value(num(5)+1:num(6)) = a6(1:len(6))
 734         current%value(num(6)+1:num(7)) = a7(1:len(7))
 735         current%next => linklist_head
 736         linklist_head => current
 737     endif
 738
 739 !   write(unit=*, fmt='(a,i4,3a)') &
 740 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 741
 742 end subroutine push_7_arrays
 743
 744 subroutine pop_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
 745
 746     implicit none
 747
 748     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5, a6, a7
 749     character(len=*), intent(in) :: varname
 750
 751     type(linked_list), pointer :: current
 752
 753     integer :: n
 754     integer, dimension(7) :: len
 755     integer, dimension(0:7) :: num
 756
 757     len(1) = size(a1)
 758     len(2) = size(a2)
 759     len(3) = size(a3)
 760     len(4) = size(a4)
 761     len(5) = size(a5)
 762     len(6) = size(a6)
 763     len(7) = size(a7)
 764
 765     num(0) = 0
 766     do n=1, 7
 767        num(n) = num(n-1) + len(n)
 768     enddo
 769
 770     current => linklist_head
 771
 772     if(trim(current%name) /= trim(varname)) then
 773        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 774        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 775        return
 776     endif
 777
 778 !   write(unit=*, fmt='(a,i4,3a)') &
 779 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 780
 781     a1(1:len(1)) = current%value(num(0)+1:num(1))
 782     a2(1:len(2)) = current%value(num(1)+1:num(2))
 783     a3(1:len(3)) = current%value(num(2)+1:num(3))
 784     a4(1:len(4)) = current%value(num(3)+1:num(4))
 785     a5(1:len(5)) = current%value(num(4)+1:num(5))
 786     a6(1:len(6)) = current%value(num(5)+1:num(6))
 787     a7(1:len(7)) = current%value(num(6)+1:num(7))
 788
 789     current => current%next
 790
 791     nullify(linklist_head%next)
 792     deallocate(linklist_head%value)
 793     deallocate(linklist_head)
 794     linklist_head => current
 795
 796 end subroutine pop_7_arrays
 797
 798 subroutine push_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
 799
 800     implicit none
 801
 802     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8
 803     character(len=*), intent(in) :: varname
 804
 805     type(linked_list), pointer :: current
 806
 807     integer :: n
 808     integer, dimension(8) :: len
 809     integer, dimension(0:8) :: num
 810
 811     len(1) = size(a1)
 812     len(2) = size(a2)
 813     len(3) = size(a3)
 814     len(4) = size(a4)
 815     len(5) = size(a5)
 816     len(6) = size(a6)
 817     len(7) = size(a7)
 818     len(8) = size(a8)
 819
 820     num(0) = 0
 821     do n=1, 8
 822        num(n) = num(n-1) + len(n)
 823     enddo
 824
 825     if(.not. associated(linklist_head)) then
 826         nullify(linklist_head)
 827
 828         allocate(linklist_head)
 829         allocate(linklist_head%value(num(8)))
 830         nullify(linklist_head%next)
 831
 832         linklist_head%id = 1
 833         linklist_head%name = varname
 834         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 835         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 836         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 837         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 838         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
 839         linklist_head%value(num(5)+1:num(6)) = a6(1:len(6))
 840         linklist_head%value(num(6)+1:num(7)) = a7(1:len(7))
 841         linklist_head%value(num(7)+1:num(8)) = a8(1:len(8))
 842
 843         linklist_tail => linklist_head
 844     else
 845         allocate(current)
 846         allocate(current%value(num(8)))
 847         nullify(current%next)
 848         current%id = linklist_head%id + 1
 849         current%name = varname
 850         current%value(num(0)+1:num(1)) = a1(1:len(1))
 851         current%value(num(1)+1:num(2)) = a2(1:len(2))
 852         current%value(num(2)+1:num(3)) = a3(1:len(3))
 853         current%value(num(3)+1:num(4)) = a4(1:len(4))
 854         current%value(num(4)+1:num(5)) = a5(1:len(5))
 855         current%value(num(5)+1:num(6)) = a6(1:len(6))
 856         current%value(num(6)+1:num(7)) = a7(1:len(7))
 857         current%value(num(7)+1:num(8)) = a8(1:len(8))
 858         current%next => linklist_head
 859         linklist_head => current
 860     endif
 861
 862 !   write(unit=*, fmt='(a,i4,3a)') &
 863 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 864
 865 end subroutine push_8_arrays
 866
 867 subroutine pop_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
 868
 869     implicit none
 870
 871     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8
 872     character(len=*), intent(in) :: varname
 873
 874     type(linked_list), pointer :: current
 875
 876     integer :: n
 877     integer, dimension(8) :: len
 878     integer, dimension(0:8) :: num
 879
 880     len(1) = size(a1)
 881     len(2) = size(a2)
 882     len(3) = size(a3)
 883     len(4) = size(a4)
 884     len(5) = size(a5)
 885     len(6) = size(a6)
 886     len(7) = size(a7)
 887     len(8) = size(a8)
 888
 889     num(0) = 0
 890     do n=1, 8
 891        num(n) = num(n-1) + len(n)
 892     enddo
 893
 894     current => linklist_head
 895
 896     if(trim(current%name) /= trim(varname)) then
 897        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
 898        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
 899        return
 900     endif
 901
 902 !   write(unit=*, fmt='(a,i4,3a)') &
 903 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
 904
 905     a1(1:len(1)) = current%value(num(0)+1:num(1))
 906     a2(1:len(2)) = current%value(num(1)+1:num(2))
 907     a3(1:len(3)) = current%value(num(2)+1:num(3))
 908     a4(1:len(4)) = current%value(num(3)+1:num(4))
 909     a5(1:len(5)) = current%value(num(4)+1:num(5))
 910     a6(1:len(6)) = current%value(num(5)+1:num(6))
 911     a7(1:len(7)) = current%value(num(6)+1:num(7))
 912     a8(1:len(8)) = current%value(num(7)+1:num(8))
 913
 914     current => current%next
 915
 916     nullify(linklist_head%next)
 917     deallocate(linklist_head%value)
 918     deallocate(linklist_head)
 919     linklist_head => current
 920
 921 end subroutine pop_8_arrays
 922
 923 subroutine push_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
 924
 925     implicit none
 926
 927     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
 928     character(len=*), intent(in) :: varname
 929
 930     type(linked_list), pointer :: current
 931
 932     integer :: n
 933     integer, dimension(9) :: len
 934     integer, dimension(0:9) :: num
 935
 936     len(1) = size(a1)
 937     len(2) = size(a2)
 938     len(3) = size(a3)
 939     len(4) = size(a4)
 940     len(5) = size(a5)
 941     len(6) = size(a6)
 942     len(7) = size(a7)
 943     len(8) = size(a8)
 944     len(9) = size(a9)
 945
 946     num(0) = 0
 947     do n=1, 9
 948        num(n) = num(n-1) + len(n)
 949     enddo
 950
 951     if(.not. associated(linklist_head)) then
 952         nullify(linklist_head)
 953
 954         allocate(linklist_head)
 955         allocate(linklist_head%value(num(9)))
 956         nullify(linklist_head%next)
 957
 958         linklist_head%id = 1
 959         linklist_head%name = varname
 960         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
 961         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
 962         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
 963         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
 964         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
 965         linklist_head%value(num(5)+1:num(6)) = a6(1:len(6))
 966         linklist_head%value(num(6)+1:num(7)) = a7(1:len(7))
 967         linklist_head%value(num(7)+1:num(8)) = a8(1:len(8))
 968         linklist_head%value(num(8)+1:num(9)) = a9(1:len(9))
 969
 970         linklist_tail => linklist_head
 971     else
 972         allocate(current)
 973         allocate(current%value(num(9)))
 974         nullify(current%next)
 975         current%id = linklist_head%id + 1
 976         current%name = varname
 977         current%value(num(0)+1:num(1)) = a1(1:len(1))
 978         current%value(num(1)+1:num(2)) = a2(1:len(2))
 979         current%value(num(2)+1:num(3)) = a3(1:len(3))
 980         current%value(num(3)+1:num(4)) = a4(1:len(4))
 981         current%value(num(4)+1:num(5)) = a5(1:len(5))
 982         current%value(num(5)+1:num(6)) = a6(1:len(6))
 983         current%value(num(6)+1:num(7)) = a7(1:len(7))
 984         current%value(num(7)+1:num(8)) = a8(1:len(8))
 985         current%value(num(8)+1:num(9)) = a9(1:len(9))
 986         current%next => linklist_head
 987         linklist_head => current
 988     endif
 989
 990 !   write(unit=*, fmt='(a,i4,3a)') &
 991 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
 992
 993 end subroutine push_9_arrays
 994
 995 subroutine pop_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
 996
 997     implicit none
 998
 999     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
1000     character(len=*), intent(in) :: varname
1001
1002     type(linked_list), pointer :: current
1003
1004     integer :: n
1005     integer, dimension(9) :: len
1006     integer, dimension(0:9) :: num
1007
1008     len(1) = size(a1)
1009     len(2) = size(a2)
1010     len(3) = size(a3)
1011     len(4) = size(a4)
1012     len(5) = size(a5)
1013     len(6) = size(a6)
1014     len(7) = size(a7)
1015     len(8) = size(a8)
1016     len(9) = size(a9)
1017
1018     num(0) = 0
1019     do n=1, 9
1020        num(n) = num(n-1) + len(n)
1021     enddo
1022
1023     current => linklist_head
1024
1025     if(trim(current%name) /= trim(varname)) then
1026        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1027        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1028        return
1029     endif
1030
1031 !   write(unit=*, fmt='(a,i4,3a)') &
1032 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1033
1034     a1(1:len(1)) = current%value(num(0)+1:num(1))
1035     a2(1:len(2)) = current%value(num(1)+1:num(2))
1036     a3(1:len(3)) = current%value(num(2)+1:num(3))
1037     a4(1:len(4)) = current%value(num(3)+1:num(4))
1038     a5(1:len(5)) = current%value(num(4)+1:num(5))
1039     a6(1:len(6)) = current%value(num(5)+1:num(6))
1040     a7(1:len(7)) = current%value(num(6)+1:num(7))
1041     a8(1:len(8)) = current%value(num(7)+1:num(8))
1042     a9(1:len(9)) = current%value(num(8)+1:num(9))
1043
1044     current => current%next
1045
1046     nullify(linklist_head%next)
1047     deallocate(linklist_head%value)
1048     deallocate(linklist_head)
1049     linklist_head => current
1050
1051 end subroutine pop_9_arrays
1052
1053 subroutine push_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
1054
1055     implicit none
1056
1057     real, dimension(:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
1058     character(len=*), intent(in) :: varname
1059
1060     type(linked_list), pointer :: current
1061
1062     integer :: n
1063     integer, dimension(10) :: len
1064     integer, dimension(0:10) :: num
1065
1066     len(1) = size(a1)
1067     len(2) = size(a2)
1068     len(3) = size(a3)
1069     len(4) = size(a4)
1070     len(5) = size(a5)
1071     len(6) = size(a6)
1072     len(7) = size(a7)
1073     len(8) = size(a8)
1074     len(9) = size(a9)
1075     len(10) = size(a10)
1076
1077     num(0) = 0
1078     do n=1, 10
1079        num(n) = num(n-1) + len(n)
1080     enddo
1081
1082     if(.not. associated(linklist_head)) then
1083         nullify(linklist_head)
1084
1085         allocate(linklist_head)
1086         allocate(linklist_head%value(num(10)))
1087         nullify(linklist_head%next)
1088
1089         linklist_head%id = 1
1090         linklist_head%name = varname
1091         linklist_head%value(num(0)+1:num(1)) = a1(1:len(1))
1092         linklist_head%value(num(1)+1:num(2)) = a2(1:len(2))
1093         linklist_head%value(num(2)+1:num(3)) = a3(1:len(3))
1094         linklist_head%value(num(3)+1:num(4)) = a4(1:len(4))
1095         linklist_head%value(num(4)+1:num(5)) = a5(1:len(5))
1096         linklist_head%value(num(5)+1:num(6)) = a6(1:len(6))
1097         linklist_head%value(num(6)+1:num(7)) = a7(1:len(7))
1098         linklist_head%value(num(7)+1:num(8)) = a8(1:len(8))
1099         linklist_head%value(num(8)+1:num(9)) = a9(1:len(9))
1100         linklist_head%value(num(9)+1:num(10)) = a10(1:len(10))
1101
1102         linklist_tail => linklist_head
1103     else
1104         allocate(current)
1105         allocate(current%value(num(10)))
1106         nullify(current%next)
1107         current%id = linklist_head%id + 1
1108         current%name = varname
1109         current%value(num(0)+1:num(1)) = a1(1:len(1))
1110         current%value(num(1)+1:num(2)) = a2(1:len(2))
1111         current%value(num(2)+1:num(3)) = a3(1:len(3))
1112         current%value(num(3)+1:num(4)) = a4(1:len(4))
1113         current%value(num(4)+1:num(5)) = a5(1:len(5))
1114         current%value(num(5)+1:num(6)) = a6(1:len(6))
1115         current%value(num(6)+1:num(7)) = a7(1:len(7))
1116         current%value(num(7)+1:num(8)) = a8(1:len(8))
1117         current%value(num(8)+1:num(9)) = a9(1:len(9))
1118         current%value(num(9)+1:num(10)) = a10(1:len(10))
1119         current%next => linklist_head
1120         linklist_head => current
1121     endif
1122
1123 !   write(unit=*, fmt='(a,i4,3a)') &
1124 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1125
1126 end subroutine push_10_arrays
1127
1128 subroutine pop_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
1129
1130     implicit none
1131
1132     real, dimension(:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
1133     character(len=*), intent(in) :: varname
1134
1135     type(linked_list), pointer :: current
1136
1137     integer :: n
1138     integer, dimension(10) :: len
1139     integer, dimension(0:10) :: num
1140
1141     len(1) = size(a1)
1142     len(2) = size(a2)
1143     len(3) = size(a3)
1144     len(4) = size(a4)
1145     len(5) = size(a5)
1146     len(6) = size(a6)
1147     len(7) = size(a7)
1148     len(8) = size(a8)
1149     len(9) = size(a9)
1150     len(10) = size(a10)
1151
1152     num(0) = 0
1153     do n=1, 10
1154        num(n) = num(n-1) + len(n)
1155     enddo
1156
1157     current => linklist_head
1158
1159     if(trim(current%name) /= trim(varname)) then
1160        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1161        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1162        return
1163     endif
1164
1165 !   write(unit=*, fmt='(a,i4,3a)') &
1166 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1167
1168     a1(1:len(1)) = current%value(num(0)+1:num(1))
1169     a2(1:len(2)) = current%value(num(1)+1:num(2))
1170     a3(1:len(3)) = current%value(num(2)+1:num(3))
1171     a4(1:len(4)) = current%value(num(3)+1:num(4))
1172     a5(1:len(5)) = current%value(num(4)+1:num(5))
1173     a6(1:len(6)) = current%value(num(5)+1:num(6))
1174     a7(1:len(7)) = current%value(num(6)+1:num(7))
1175     a8(1:len(8)) = current%value(num(7)+1:num(8))
1176     a9(1:len(9)) = current%value(num(8)+1:num(9))
1177     a10(1:len(10)) = current%value(num(9)+1:num(10))
1178
1179     current => current%next
1180
1181     nullify(linklist_head%next)
1182     deallocate(linklist_head%value)
1183     deallocate(linklist_head)
1184     linklist_head => current
1185
1186 end subroutine pop_10_arrays
1187
1188 subroutine push_2d_1_array(a1, varname)
1189
1190     implicit none
1191
1192     real, dimension(:,:), intent(in) :: a1
1193     character(len=*), intent(in) :: varname
1194
1195     integer :: length
1196
1197     type(linked_list), pointer :: current
1198
1199     length = size(a1)
1200
1201     if(.not. associated(linklist_head)) then
1202         nullify(linklist_head)
1203
1204         allocate(linklist_head)
1205         allocate(linklist_head%value(length))
1206         nullify(linklist_head%next)
1207
1208         linklist_head%id = 1
1209         linklist_head%name = varname
1210         call backup_array(linklist_head%value, a1, length)
1211
1212         linklist_tail => linklist_head
1213     else
1214         allocate(current)
1215         allocate(current%value(length))
1216         nullify(current%next)
1217         current%id = linklist_head%id + 1
1218         current%name = varname
1219         call backup_array(current%value, a1, length)
1220         current%next => linklist_head
1221         linklist_head => current
1222     endif
1223
1224 !   write(unit=*, fmt='(a,i4,3a)') &
1225 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1226
1227 end subroutine push_2d_1_array
1228
1229 subroutine pop_2d_1_array(a1, varname)
1230
1231     implicit none
1232
1233     real, dimension(:,:), intent(out) :: a1
1234     character(len=*), intent(in) :: varname
1235
1236     integer :: length
1237
1238     type(linked_list), pointer :: current
1239
1240     length = size(a1)
1241
1242     current => linklist_head
1243
1244     if(trim(current%name) /= trim(varname)) then
1245        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1246        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1247        return
1248     endif
1249
1250 !   write(unit=*, fmt='(a,i4,3a)') &
1251 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1252
1253     call restore_array(a1, current%value, length)
1254
1255     current => current%next
1256
1257     nullify(linklist_head%next)
1258     deallocate(linklist_head%value)
1259     deallocate(linklist_head)
1260     linklist_head => current
1261
1262 end subroutine pop_2d_1_array
1263
1264 subroutine push_2d_2_arrays(a1, a2, varname)
1265
1266     implicit none
1267
1268     real, dimension(:,:), intent(in) :: a1, a2
1269     character(len=*), intent(in) :: varname
1270
1271     type(linked_list), pointer :: current
1272
1273     integer :: n
1274     integer, dimension(2) :: len
1275     integer, dimension(0:2) :: num
1276
1277     len(1) = size(a1)
1278     len(2) = size(a2)
1279
1280     num(0) = 0
1281     do n=1, 2
1282        num(n) = num(n-1) + len(n)
1283     enddo
1284
1285     if(.not. associated(linklist_head)) then
1286         nullify(linklist_head)
1287
1288         allocate(linklist_head)
1289         allocate(linklist_head%value(num(2)))
1290         nullify(linklist_head%next)
1291
1292         linklist_head%id = 1
1293         linklist_head%name = varname
1294         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1295         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1296
1297         linklist_tail => linklist_head
1298     else
1299         allocate(current)
1300         allocate(current%value(num(2)))
1301         nullify(current%next)
1302         current%id = linklist_head%id + 1
1303         current%name = varname
1304         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1305         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1306         current%next => linklist_head
1307         linklist_head => current
1308     endif
1309
1310 !   write(unit=*, fmt='(a,i4,3a)') &
1311 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1312
1313 end subroutine push_2d_2_arrays
1314
1315 subroutine pop_2d_2_arrays(a1, a2, varname)
1316
1317     implicit none
1318
1319     real, dimension(:,:), intent(out) :: a1, a2
1320     character(len=*), intent(in) :: varname
1321
1322     type(linked_list), pointer :: current
1323
1324     integer :: n
1325     integer, dimension(2) :: len
1326     integer, dimension(0:2) :: num
1327
1328     len(1) = size(a1)
1329     len(2) = size(a2)
1330
1331     num(0) = 0
1332     do n=1, 2
1333        num(n) = num(n-1) + len(n)
1334     enddo
1335
1336     current => linklist_head
1337
1338     if(trim(current%name) /= trim(varname)) then
1339        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1340        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1341        return
1342     endif
1343
1344 !   write(unit=*, fmt='(a,i4,3a)') &
1345 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1346
1347     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1348     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1349
1350     current => current%next
1351
1352     nullify(linklist_head%next)
1353     deallocate(linklist_head%value)
1354     deallocate(linklist_head)
1355     linklist_head => current
1356
1357 end subroutine pop_2d_2_arrays
1358
1359 subroutine push_2d_3_arrays(a1, a2, a3, varname)
1360
1361     implicit none
1362
1363     real, dimension(:,:), intent(in) :: a1, a2, a3
1364     character(len=*), intent(in) :: varname
1365
1366     type(linked_list), pointer :: current
1367
1368     integer :: n
1369     integer, dimension(3) :: len
1370     integer, dimension(0:3) :: num
1371
1372     len(1) = size(a1)
1373     len(2) = size(a2)
1374     len(3) = size(a3)
1375
1376     num(0) = 0
1377     do n=1, 3
1378        num(n) = num(n-1) + len(n)
1379     enddo
1380
1381     if(.not. associated(linklist_head)) then
1382         nullify(linklist_head)
1383
1384         allocate(linklist_head)
1385         allocate(linklist_head%value(num(3)))
1386         nullify(linklist_head%next)
1387
1388         linklist_head%id = 1
1389         linklist_head%name = varname
1390         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1391         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1392         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1393
1394         linklist_tail => linklist_head
1395     else
1396         allocate(current)
1397         allocate(current%value(num(3)))
1398         nullify(current%next)
1399         current%id = linklist_head%id + 1
1400         current%name = varname
1401         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1402         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1403         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1404         current%next => linklist_head
1405         linklist_head => current
1406     endif
1407
1408 !   write(unit=*, fmt='(a,i4,3a)') &
1409 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1410
1411 end subroutine push_2d_3_arrays
1412
1413 subroutine pop_2d_3_arrays(a1, a2, a3, varname)
1414
1415     implicit none
1416
1417     real, dimension(:,:), intent(out) :: a1, a2, a3
1418     character(len=*), intent(in) :: varname
1419
1420     type(linked_list), pointer :: current
1421
1422     integer :: n
1423     integer, dimension(3) :: len
1424     integer, dimension(0:3) :: num
1425
1426     len(1) = size(a1)
1427     len(2) = size(a2)
1428     len(3) = size(a3)
1429
1430     num(0) = 0
1431     do n=1, 3
1432        num(n) = num(n-1) + len(n)
1433     enddo
1434
1435     current => linklist_head
1436
1437     if(trim(current%name) /= trim(varname)) then
1438        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1439        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1440        return
1441     endif
1442
1443 !   write(unit=*, fmt='(a,i4,3a)') &
1444 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1445
1446     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1447     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1448     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
1449
1450     current => current%next
1451
1452     nullify(linklist_head%next)
1453     deallocate(linklist_head%value)
1454     deallocate(linklist_head)
1455     linklist_head => current
1456
1457 end subroutine pop_2d_3_arrays
1458
1459 subroutine push_2d_4_arrays(a1, a2, a3, a4, varname)
1460
1461     implicit none
1462
1463     real, dimension(:,:), intent(in) :: a1, a2, a3, a4
1464     character(len=*), intent(in) :: varname
1465
1466     type(linked_list), pointer :: current
1467
1468     integer :: n
1469     integer, dimension(4) :: len
1470     integer, dimension(0:4) :: num
1471
1472     len(1) = size(a1)
1473     len(2) = size(a2)
1474     len(3) = size(a3)
1475     len(4) = size(a4)
1476
1477     num(0) = 0
1478     do n=1, 4
1479        num(n) = num(n-1) + len(n)
1480     enddo
1481
1482     if(.not. associated(linklist_head)) then
1483         nullify(linklist_head)
1484
1485         allocate(linklist_head)
1486         allocate(linklist_head%value(num(4)))
1487         nullify(linklist_head%next)
1488
1489         linklist_head%id = 1
1490         linklist_head%name = varname
1491         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1492         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1493         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1494         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
1495
1496         linklist_tail => linklist_head
1497     else
1498         allocate(current)
1499         allocate(current%value(num(4)))
1500         nullify(current%next)
1501         current%id = linklist_head%id + 1
1502         current%name = varname
1503         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1504         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1505         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1506         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
1507         current%next => linklist_head
1508         linklist_head => current
1509     endif
1510
1511 !   write(unit=*, fmt='(a,i4,3a)') &
1512 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1513
1514 end subroutine push_2d_4_arrays
1515
1516 subroutine pop_2d_4_arrays(a1, a2, a3, a4, varname)
1517
1518     implicit none
1519
1520     real, dimension(:,:), intent(out) :: a1, a2, a3, a4
1521     character(len=*), intent(in) :: varname
1522
1523     type(linked_list), pointer :: current
1524
1525     integer :: n
1526     integer, dimension(4) :: len
1527     integer, dimension(0:4) :: num
1528
1529     len(1) = size(a1)
1530     len(2) = size(a2)
1531     len(3) = size(a3)
1532     len(4) = size(a4)
1533
1534     num(0) = 0
1535     do n=1, 4
1536        num(n) = num(n-1) + len(n)
1537     enddo
1538
1539     current => linklist_head
1540
1541     if(trim(current%name) /= trim(varname)) then
1542        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1543        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1544        return
1545     endif
1546
1547 !   write(unit=*, fmt='(a,i4,3a)') &
1548 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1549
1550     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1551     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1552     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
1553     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
1554
1555     current => current%next
1556
1557     nullify(linklist_head%next)
1558     deallocate(linklist_head%value)
1559     deallocate(linklist_head)
1560     linklist_head => current
1561
1562 end subroutine pop_2d_4_arrays
1563
1564 subroutine push_2d_5_arrays(a1, a2, a3, a4, a5, varname)
1565
1566     implicit none
1567
1568     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5
1569     character(len=*), intent(in) :: varname
1570
1571     type(linked_list), pointer :: current
1572
1573     integer :: n
1574     integer, dimension(5) :: len
1575     integer, dimension(0:5) :: num
1576
1577     len(1) = size(a1)
1578     len(2) = size(a2)
1579     len(3) = size(a3)
1580     len(4) = size(a4)
1581     len(5) = size(a5)
1582
1583     num(0) = 0
1584     do n=1, 5
1585        num(n) = num(n-1) + len(n)
1586     enddo
1587
1588     if(.not. associated(linklist_head)) then
1589         nullify(linklist_head)
1590
1591         allocate(linklist_head)
1592         allocate(linklist_head%value(num(5)))
1593         nullify(linklist_head%next)
1594
1595         linklist_head%id = 1
1596         linklist_head%name = varname
1597         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1598         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1599         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1600         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
1601         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
1602
1603         linklist_tail => linklist_head
1604     else
1605         allocate(current)
1606         allocate(current%value(num(5)))
1607         nullify(current%next)
1608         current%id = linklist_head%id + 1
1609         current%name = varname
1610         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1611         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1612         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1613         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
1614         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
1615         current%next => linklist_head
1616         linklist_head => current
1617     endif
1618
1619 !   write(unit=*, fmt='(a,i4,3a)') &
1620 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1621
1622 end subroutine push_2d_5_arrays
1623
1624 subroutine pop_2d_5_arrays(a1, a2, a3, a4, a5, varname)
1625
1626     implicit none
1627
1628     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5
1629     character(len=*), intent(in) :: varname
1630
1631     type(linked_list), pointer :: current
1632
1633     integer :: n
1634     integer, dimension(5) :: len
1635     integer, dimension(0:5) :: num
1636
1637     len(1) = size(a1)
1638     len(2) = size(a2)
1639     len(3) = size(a3)
1640     len(4) = size(a4)
1641     len(5) = size(a5)
1642
1643     num(0) = 0
1644     do n=1, 5
1645        num(n) = num(n-1) + len(n)
1646     enddo
1647
1648     current => linklist_head
1649
1650     if(trim(current%name) /= trim(varname)) then
1651        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1652        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1653        return
1654     endif
1655
1656 !   write(unit=*, fmt='(a,i4,3a)') &
1657 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1658
1659     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1660     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1661     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
1662     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
1663     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
1664
1665     current => current%next
1666
1667     nullify(linklist_head%next)
1668     deallocate(linklist_head%value)
1669     deallocate(linklist_head)
1670     linklist_head => current
1671
1672 end subroutine pop_2d_5_arrays
1673
1674 subroutine push_2d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
1675
1676     implicit none
1677
1678     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5, a6
1679     character(len=*), intent(in) :: varname
1680
1681     type(linked_list), pointer :: current
1682
1683     integer :: n
1684     integer, dimension(6) :: len
1685     integer, dimension(0:6) :: num
1686
1687     len(1) = size(a1)
1688     len(2) = size(a2)
1689     len(3) = size(a3)
1690     len(4) = size(a4)
1691     len(5) = size(a5)
1692     len(6) = size(a6)
1693
1694     num(0) = 0
1695     do n=1, 6
1696        num(n) = num(n-1) + len(n)
1697     enddo
1698
1699     if(.not. associated(linklist_head)) then
1700         nullify(linklist_head)
1701
1702         allocate(linklist_head)
1703         allocate(linklist_head%value(num(6)))
1704         nullify(linklist_head%next)
1705
1706         linklist_head%id = 1
1707         linklist_head%name = varname
1708         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1709         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1710         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1711         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
1712         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
1713         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
1714
1715         linklist_tail => linklist_head
1716     else
1717         allocate(current)
1718         allocate(current%value(num(6)))
1719         nullify(current%next)
1720         current%id = linklist_head%id + 1
1721         current%name = varname
1722         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1723         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1724         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1725         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
1726         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
1727         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
1728         current%next => linklist_head
1729         linklist_head => current
1730     endif
1731
1732 !   write(unit=*, fmt='(a,i4,3a)') &
1733 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1734
1735 end subroutine push_2d_6_arrays
1736
1737 subroutine pop_2d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
1738
1739     implicit none
1740
1741     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5, a6
1742     character(len=*), intent(in) :: varname
1743
1744     type(linked_list), pointer :: current
1745
1746     integer :: n
1747     integer, dimension(6) :: len
1748     integer, dimension(0:6) :: num
1749
1750     len(1) = size(a1)
1751     len(2) = size(a2)
1752     len(3) = size(a3)
1753     len(4) = size(a4)
1754     len(5) = size(a5)
1755     len(6) = size(a6)
1756
1757     num(0) = 0
1758     do n=1, 6
1759        num(n) = num(n-1) + len(n)
1760     enddo
1761
1762     current => linklist_head
1763
1764     if(trim(current%name) /= trim(varname)) then
1765        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1766        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1767        return
1768     endif
1769
1770 !   write(unit=*, fmt='(a,i4,3a)') &
1771 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1772
1773     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1774     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1775     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
1776     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
1777     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
1778     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
1779
1780     current => current%next
1781
1782     nullify(linklist_head%next)
1783     deallocate(linklist_head%value)
1784     deallocate(linklist_head)
1785     linklist_head => current
1786
1787 end subroutine pop_2d_6_arrays
1788
1789 subroutine push_2d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
1790
1791     implicit none
1792
1793     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7
1794     character(len=*), intent(in) :: varname
1795
1796     type(linked_list), pointer :: current
1797
1798     integer :: n
1799     integer, dimension(7) :: len
1800     integer, dimension(0:7) :: num
1801
1802     len(1) = size(a1)
1803     len(2) = size(a2)
1804     len(3) = size(a3)
1805     len(4) = size(a4)
1806     len(5) = size(a5)
1807     len(6) = size(a6)
1808     len(7) = size(a7)
1809
1810     num(0) = 0
1811     do n=1, 7
1812        num(n) = num(n-1) + len(n)
1813     enddo
1814
1815     if(.not. associated(linklist_head)) then
1816         nullify(linklist_head)
1817
1818         allocate(linklist_head)
1819         allocate(linklist_head%value(num(7)))
1820         nullify(linklist_head%next)
1821
1822         linklist_head%id = 1
1823         linklist_head%name = varname
1824         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1825         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1826         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1827         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
1828         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
1829         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
1830         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
1831
1832         linklist_tail => linklist_head
1833     else
1834         allocate(current)
1835         allocate(current%value(num(7)))
1836         nullify(current%next)
1837         current%id = linklist_head%id + 1
1838         current%name = varname
1839         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1840         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1841         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1842         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
1843         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
1844         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
1845         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
1846         current%next => linklist_head
1847         linklist_head => current
1848     endif
1849
1850 !   write(unit=*, fmt='(a,i4,3a)') &
1851 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1852
1853 end subroutine push_2d_7_arrays
1854
1855 subroutine pop_2d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
1856
1857     implicit none
1858
1859     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7
1860     character(len=*), intent(in) :: varname
1861
1862     type(linked_list), pointer :: current
1863
1864     integer :: n
1865     integer, dimension(7) :: len
1866     integer, dimension(0:7) :: num
1867
1868     len(1) = size(a1)
1869     len(2) = size(a2)
1870     len(3) = size(a3)
1871     len(4) = size(a4)
1872     len(5) = size(a5)
1873     len(6) = size(a6)
1874     len(7) = size(a7)
1875
1876     num(0) = 0
1877     do n=1, 7
1878        num(n) = num(n-1) + len(n)
1879     enddo
1880
1881     current => linklist_head
1882
1883     if(trim(current%name) /= trim(varname)) then
1884        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
1885        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
1886        return
1887     endif
1888
1889 !   write(unit=*, fmt='(a,i4,3a)') &
1890 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
1891
1892     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
1893     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
1894     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
1895     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
1896     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
1897     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
1898     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
1899
1900     current => current%next
1901
1902     nullify(linklist_head%next)
1903     deallocate(linklist_head%value)
1904     deallocate(linklist_head)
1905     linklist_head => current
1906
1907 end subroutine pop_2d_7_arrays
1908
1909 subroutine push_2d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
1910
1911     implicit none
1912
1913     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8
1914     character(len=*), intent(in) :: varname
1915
1916     type(linked_list), pointer :: current
1917
1918     integer :: n
1919     integer, dimension(8) :: len
1920     integer, dimension(0:8) :: num
1921
1922     len(1) = size(a1)
1923     len(2) = size(a2)
1924     len(3) = size(a3)
1925     len(4) = size(a4)
1926     len(5) = size(a5)
1927     len(6) = size(a6)
1928     len(7) = size(a7)
1929     len(8) = size(a8)
1930
1931     num(0) = 0
1932     do n=1, 8
1933        num(n) = num(n-1) + len(n)
1934     enddo
1935
1936     if(.not. associated(linklist_head)) then
1937         nullify(linklist_head)
1938
1939         allocate(linklist_head)
1940         allocate(linklist_head%value(num(8)))
1941         nullify(linklist_head%next)
1942
1943         linklist_head%id = 1
1944         linklist_head%name = varname
1945         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
1946         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
1947         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
1948         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
1949         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
1950         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
1951         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
1952         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
1953
1954         linklist_tail => linklist_head
1955     else
1956         allocate(current)
1957         allocate(current%value(num(8)))
1958         nullify(current%next)
1959         current%id = linklist_head%id + 1
1960         current%name = varname
1961         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
1962         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
1963         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
1964         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
1965         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
1966         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
1967         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
1968         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
1969         current%next => linklist_head
1970         linklist_head => current
1971     endif
1972
1973 !   write(unit=*, fmt='(a,i4,3a)') &
1974 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
1975
1976 end subroutine push_2d_8_arrays
1977
1978 subroutine pop_2d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
1979
1980     implicit none
1981
1982     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8
1983     character(len=*), intent(in) :: varname
1984
1985     type(linked_list), pointer :: current
1986
1987     integer :: n
1988     integer, dimension(8) :: len
1989     integer, dimension(0:8) :: num
1990
1991     len(1) = size(a1)
1992     len(2) = size(a2)
1993     len(3) = size(a3)
1994     len(4) = size(a4)
1995     len(5) = size(a5)
1996     len(6) = size(a6)
1997     len(7) = size(a7)
1998     len(8) = size(a8)
1999
2000     num(0) = 0
2001     do n=1, 8
2002        num(n) = num(n-1) + len(n)
2003     enddo
2004
2005     current => linklist_head
2006
2007     if(trim(current%name) /= trim(varname)) then
2008        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2009        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2010        return
2011     endif
2012
2013 !   write(unit=*, fmt='(a,i4,3a)') &
2014 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2015
2016     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2017     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2018     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2019     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2020     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
2021     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
2022     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
2023     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
2024
2025     current => current%next
2026
2027     nullify(linklist_head%next)
2028     deallocate(linklist_head%value)
2029     deallocate(linklist_head)
2030     linklist_head => current
2031
2032 end subroutine pop_2d_8_arrays
2033
2034 subroutine push_2d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
2035
2036     implicit none
2037
2038     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
2039     character(len=*), intent(in) :: varname
2040
2041     type(linked_list), pointer :: current
2042
2043     integer :: n
2044     integer, dimension(9) :: len
2045     integer, dimension(0:9) :: num
2046
2047     len(1) = size(a1)
2048     len(2) = size(a2)
2049     len(3) = size(a3)
2050     len(4) = size(a4)
2051     len(5) = size(a5)
2052     len(6) = size(a6)
2053     len(7) = size(a7)
2054     len(8) = size(a8)
2055     len(9) = size(a9)
2056
2057     num(0) = 0
2058     do n=1, 9
2059        num(n) = num(n-1) + len(n)
2060     enddo
2061
2062     if(.not. associated(linklist_head)) then
2063         nullify(linklist_head)
2064
2065         allocate(linklist_head)
2066         allocate(linklist_head%value(num(9)))
2067         nullify(linklist_head%next)
2068
2069         linklist_head%id = 1
2070         linklist_head%name = varname
2071         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2072         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2073         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2074         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2075         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
2076         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
2077         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
2078         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
2079         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
2080
2081         linklist_tail => linklist_head
2082     else
2083         allocate(current)
2084         allocate(current%value(num(9)))
2085         nullify(current%next)
2086         current%id = linklist_head%id + 1
2087         current%name = varname
2088         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2089         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2090         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2091         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2092         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
2093         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
2094         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
2095         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
2096         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
2097         current%next => linklist_head
2098         linklist_head => current
2099     endif
2100
2101 !   write(unit=*, fmt='(a,i4,3a)') &
2102 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2103
2104 end subroutine push_2d_9_arrays
2105
2106 subroutine pop_2d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
2107
2108     implicit none
2109
2110     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
2111     character(len=*), intent(in) :: varname
2112
2113     type(linked_list), pointer :: current
2114
2115     integer :: n
2116     integer, dimension(9) :: len
2117     integer, dimension(0:9) :: num
2118
2119     len(1) = size(a1)
2120     len(2) = size(a2)
2121     len(3) = size(a3)
2122     len(4) = size(a4)
2123     len(5) = size(a5)
2124     len(6) = size(a6)
2125     len(7) = size(a7)
2126     len(8) = size(a8)
2127     len(9) = size(a9)
2128
2129     num(0) = 0
2130     do n=1, 9
2131        num(n) = num(n-1) + len(n)
2132     enddo
2133
2134     current => linklist_head
2135
2136     if(trim(current%name) /= trim(varname)) then
2137        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2138        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2139        return
2140     endif
2141
2142 !   write(unit=*, fmt='(a,i4,3a)') &
2143 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2144
2145     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2146     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2147     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2148     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2149     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
2150     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
2151     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
2152     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
2153     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
2154
2155     current => current%next
2156
2157     nullify(linklist_head%next)
2158     deallocate(linklist_head%value)
2159     deallocate(linklist_head)
2160     linklist_head => current
2161
2162 end subroutine pop_2d_9_arrays
2163
2164 subroutine push_2d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
2165
2166     implicit none
2167
2168     real, dimension(:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
2169     character(len=*), intent(in) :: varname
2170
2171     type(linked_list), pointer :: current
2172
2173     integer :: n
2174     integer, dimension(10) :: len
2175     integer, dimension(0:10) :: num
2176
2177     len(1) = size(a1)
2178     len(2) = size(a2)
2179     len(3) = size(a3)
2180     len(4) = size(a4)
2181     len(5) = size(a5)
2182     len(6) = size(a6)
2183     len(7) = size(a7)
2184     len(8) = size(a8)
2185     len(9) = size(a9)
2186     len(10) = size(a10)
2187
2188     num(0) = 0
2189     do n=1, 10
2190        num(n) = num(n-1) + len(n)
2191     enddo
2192
2193     if(.not. associated(linklist_head)) then
2194         nullify(linklist_head)
2195
2196         allocate(linklist_head)
2197         allocate(linklist_head%value(num(10)))
2198         nullify(linklist_head%next)
2199
2200         linklist_head%id = 1
2201         linklist_head%name = varname
2202         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2203         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2204         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2205         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2206         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
2207         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
2208         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
2209         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
2210         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
2211         call backup_array(linklist_head%value(num(9)+1:num(10)), a10, len(10))
2212
2213         linklist_tail => linklist_head
2214     else
2215         allocate(current)
2216         allocate(current%value(num(10)))
2217         nullify(current%next)
2218         current%id = linklist_head%id + 1
2219         current%name = varname
2220         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2221         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2222         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2223         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2224         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
2225         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
2226         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
2227         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
2228         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
2229         call backup_array(current%value(num(9)+1:num(10)), a10, len(10))
2230         current%next => linklist_head
2231         linklist_head => current
2232     endif
2233
2234 !   write(unit=*, fmt='(a,i4,3a)') &
2235 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2236
2237 end subroutine push_2d_10_arrays
2238
2239 subroutine pop_2d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
2240
2241     implicit none
2242
2243     real, dimension(:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
2244     character(len=*), intent(in) :: varname
2245
2246     type(linked_list), pointer :: current
2247
2248     integer :: n
2249     integer, dimension(10) :: len
2250     integer, dimension(0:10) :: num
2251
2252     len(1) = size(a1)
2253     len(2) = size(a2)
2254     len(3) = size(a3)
2255     len(4) = size(a4)
2256     len(5) = size(a5)
2257     len(6) = size(a6)
2258     len(7) = size(a7)
2259     len(8) = size(a8)
2260     len(9) = size(a9)
2261     len(10) = size(a10)
2262
2263     num(0) = 0
2264     do n=1, 10
2265        num(n) = num(n-1) + len(n)
2266     enddo
2267
2268     current => linklist_head
2269
2270     if(trim(current%name) /= trim(varname)) then
2271        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2272        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2273        return
2274     endif
2275
2276 !   write(unit=*, fmt='(a,i4,3a)') &
2277 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2278
2279     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2280     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2281     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2282     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2283     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
2284     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
2285     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
2286     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
2287     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
2288     call restore_array(a10, current%value(num(9)+1:num(10)), len(10))
2289
2290     current => current%next
2291
2292     nullify(linklist_head%next)
2293     deallocate(linklist_head%value)
2294     deallocate(linklist_head)
2295     linklist_head => current
2296
2297 end subroutine pop_2d_10_arrays
2298
2299 subroutine push_3d_1_array(a1, varname)
2300
2301     implicit none
2302
2303     real, dimension(:,:,:), intent(in) :: a1
2304     character(len=*), intent(in) :: varname
2305
2306     integer :: length
2307
2308     type(linked_list), pointer :: current
2309
2310     length = size(a1)
2311
2312     if(.not. associated(linklist_head)) then
2313         nullify(linklist_head)
2314
2315         allocate(linklist_head)
2316         allocate(linklist_head%value(length))
2317         nullify(linklist_head%next)
2318
2319         linklist_head%id = 1
2320         linklist_head%name = varname
2321         call backup_array(linklist_head%value, a1, length)
2322
2323         linklist_tail => linklist_head
2324     else
2325         allocate(current)
2326         allocate(current%value(length))
2327         nullify(current%next)
2328         current%id = linklist_head%id + 1
2329         current%name = varname
2330         call backup_array(current%value, a1, length)
2331         current%next => linklist_head
2332         linklist_head => current
2333     endif
2334
2335 !   write(unit=*, fmt='(a,i4,3a)') &
2336 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2337
2338 end subroutine push_3d_1_array
2339
2340 subroutine pop_3d_1_array(a1, varname)
2341
2342     implicit none
2343
2344     real, dimension(:,:,:), intent(out) :: a1
2345     character(len=*), intent(in) :: varname
2346
2347     integer :: length
2348
2349     type(linked_list), pointer :: current
2350
2351     length = size(a1)
2352
2353     current => linklist_head
2354
2355     if(trim(current%name) /= trim(varname)) then
2356        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2357        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2358        return
2359     endif
2360
2361 !   write(unit=*, fmt='(a,i4,3a)') &
2362 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2363
2364     call restore_array(a1, current%value, length)
2365
2366     current => current%next
2367
2368     nullify(linklist_head%next)
2369     deallocate(linklist_head%value)
2370     deallocate(linklist_head)
2371     linklist_head => current
2372
2373 end subroutine pop_3d_1_array
2374
2375 subroutine push_3d_2_arrays(a1, a2, varname)
2376
2377     implicit none
2378
2379     real, dimension(:,:,:), intent(in) :: a1, a2
2380     character(len=*), intent(in) :: varname
2381
2382     type(linked_list), pointer :: current
2383
2384     integer :: n
2385     integer, dimension(2) :: len
2386     integer, dimension(0:2) :: num
2387
2388     len(1) = size(a1)
2389     len(2) = size(a2)
2390
2391     num(0) = 0
2392     do n=1, 2
2393        num(n) = num(n-1) + len(n)
2394     enddo
2395
2396     if(.not. associated(linklist_head)) then
2397         nullify(linklist_head)
2398
2399         allocate(linklist_head)
2400         allocate(linklist_head%value(num(2)))
2401         nullify(linklist_head%next)
2402
2403         linklist_head%id = 1
2404         linklist_head%name = varname
2405         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2406         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2407
2408         linklist_tail => linklist_head
2409     else
2410         allocate(current)
2411         allocate(current%value(num(2)))
2412         nullify(current%next)
2413         current%id = linklist_head%id + 1
2414         current%name = varname
2415         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2416         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2417         current%next => linklist_head
2418         linklist_head => current
2419     endif
2420
2421 !   write(unit=*, fmt='(a,i4,3a)') &
2422 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2423
2424 end subroutine push_3d_2_arrays
2425
2426 subroutine pop_3d_2_arrays(a1, a2, varname)
2427
2428     implicit none
2429
2430     real, dimension(:,:,:), intent(out) :: a1, a2
2431     character(len=*), intent(in) :: varname
2432
2433     type(linked_list), pointer :: current
2434
2435     integer :: n
2436     integer, dimension(2) :: len
2437     integer, dimension(0:2) :: num
2438
2439     len(1) = size(a1)
2440     len(2) = size(a2)
2441
2442     num(0) = 0
2443     do n=1, 2
2444        num(n) = num(n-1) + len(n)
2445     enddo
2446
2447     current => linklist_head
2448
2449     if(trim(current%name) /= trim(varname)) then
2450        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2451        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2452        return
2453     endif
2454
2455 !   write(unit=*, fmt='(a,i4,3a)') &
2456 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2457
2458     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2459     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2460
2461     current => current%next
2462
2463     nullify(linklist_head%next)
2464     deallocate(linklist_head%value)
2465     deallocate(linklist_head)
2466     linklist_head => current
2467
2468 end subroutine pop_3d_2_arrays
2469
2470 subroutine push_3d_3_arrays(a1, a2, a3, varname)
2471
2472     implicit none
2473
2474     real, dimension(:,:,:), intent(in) :: a1, a2, a3
2475     character(len=*), intent(in) :: varname
2476
2477     type(linked_list), pointer :: current
2478
2479     integer :: n
2480     integer, dimension(3) :: len
2481     integer, dimension(0:3) :: num
2482
2483     len(1) = size(a1)
2484     len(2) = size(a2)
2485     len(3) = size(a3)
2486
2487     num(0) = 0
2488     do n=1, 3
2489        num(n) = num(n-1) + len(n)
2490     enddo
2491
2492     if(.not. associated(linklist_head)) then
2493         nullify(linklist_head)
2494
2495         allocate(linklist_head)
2496         allocate(linklist_head%value(num(3)))
2497         nullify(linklist_head%next)
2498
2499         linklist_head%id = 1
2500         linklist_head%name = varname
2501         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2502         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2503         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2504
2505         linklist_tail => linklist_head
2506     else
2507         allocate(current)
2508         allocate(current%value(num(3)))
2509         nullify(current%next)
2510         current%id = linklist_head%id + 1
2511         current%name = varname
2512         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2513         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2514         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2515         current%next => linklist_head
2516         linklist_head => current
2517     endif
2518
2519 !   write(unit=*, fmt='(a,i4,3a)') &
2520 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2521
2522 end subroutine push_3d_3_arrays
2523
2524 subroutine pop_3d_3_arrays(a1, a2, a3, varname)
2525
2526     implicit none
2527
2528     real, dimension(:,:,:), intent(out) :: a1, a2, a3
2529     character(len=*), intent(in) :: varname
2530
2531     type(linked_list), pointer :: current
2532
2533     integer :: n
2534     integer, dimension(3) :: len
2535     integer, dimension(0:3) :: num
2536
2537     len(1) = size(a1)
2538     len(2) = size(a2)
2539     len(3) = size(a3)
2540
2541     num(0) = 0
2542     do n=1, 3
2543        num(n) = num(n-1) + len(n)
2544     enddo
2545
2546     current => linklist_head
2547
2548     if(trim(current%name) /= trim(varname)) then
2549        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2550        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2551        return
2552     endif
2553
2554 !   write(unit=*, fmt='(a,i4,3a)') &
2555 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2556
2557     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2558     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2559     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2560
2561     current => current%next
2562
2563     nullify(linklist_head%next)
2564     deallocate(linklist_head%value)
2565     deallocate(linklist_head)
2566     linklist_head => current
2567
2568 end subroutine pop_3d_3_arrays
2569
2570 subroutine push_3d_4_arrays(a1, a2, a3, a4, varname)
2571
2572     implicit none
2573
2574     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4
2575     character(len=*), intent(in) :: varname
2576
2577     type(linked_list), pointer :: current
2578
2579     integer :: n
2580     integer, dimension(4) :: len
2581     integer, dimension(0:4) :: num
2582
2583     len(1) = size(a1)
2584     len(2) = size(a2)
2585     len(3) = size(a3)
2586     len(4) = size(a4)
2587
2588     num(0) = 0
2589     do n=1, 4
2590        num(n) = num(n-1) + len(n)
2591     enddo
2592
2593     if(.not. associated(linklist_head)) then
2594         nullify(linklist_head)
2595
2596         allocate(linklist_head)
2597         allocate(linklist_head%value(num(4)))
2598         nullify(linklist_head%next)
2599
2600         linklist_head%id = 1
2601         linklist_head%name = varname
2602         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2603         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2604         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2605         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2606
2607         linklist_tail => linklist_head
2608     else
2609         allocate(current)
2610         allocate(current%value(num(4)))
2611         nullify(current%next)
2612         current%id = linklist_head%id + 1
2613         current%name = varname
2614         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2615         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2616         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2617         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2618         current%next => linklist_head
2619         linklist_head => current
2620     endif
2621
2622 !   write(unit=*, fmt='(a,i4,3a)') &
2623 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2624
2625 end subroutine push_3d_4_arrays
2626
2627 subroutine pop_3d_4_arrays(a1, a2, a3, a4, varname)
2628
2629     implicit none
2630
2631     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4
2632     character(len=*), intent(in) :: varname
2633
2634     type(linked_list), pointer :: current
2635
2636     integer :: n
2637     integer, dimension(4) :: len
2638     integer, dimension(0:4) :: num
2639
2640     len(1) = size(a1)
2641     len(2) = size(a2)
2642     len(3) = size(a3)
2643     len(4) = size(a4)
2644
2645     num(0) = 0
2646     do n=1, 4
2647        num(n) = num(n-1) + len(n)
2648     enddo
2649
2650     current => linklist_head
2651
2652     if(trim(current%name) /= trim(varname)) then
2653        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2654        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2655        return
2656     endif
2657
2658 !   write(unit=*, fmt='(a,i4,3a)') &
2659 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2660
2661     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2662     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2663     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2664     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2665
2666     current => current%next
2667
2668     nullify(linklist_head%next)
2669     deallocate(linklist_head%value)
2670     deallocate(linklist_head)
2671     linklist_head => current
2672
2673 end subroutine pop_3d_4_arrays
2674
2675 subroutine push_3d_5_arrays(a1, a2, a3, a4, a5, varname)
2676
2677     implicit none
2678
2679     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5
2680     character(len=*), intent(in) :: varname
2681
2682     type(linked_list), pointer :: current
2683
2684     integer :: n
2685     integer, dimension(5) :: len
2686     integer, dimension(0:5) :: num
2687
2688     len(1) = size(a1)
2689     len(2) = size(a2)
2690     len(3) = size(a3)
2691     len(4) = size(a4)
2692     len(5) = size(a5)
2693
2694     num(0) = 0
2695     do n=1, 5
2696        num(n) = num(n-1) + len(n)
2697     enddo
2698
2699     if(.not. associated(linklist_head)) then
2700         nullify(linklist_head)
2701
2702         allocate(linklist_head)
2703         allocate(linklist_head%value(num(5)))
2704         nullify(linklist_head%next)
2705
2706         linklist_head%id = 1
2707         linklist_head%name = varname
2708         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2709         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2710         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2711         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2712         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
2713
2714         linklist_tail => linklist_head
2715     else
2716         allocate(current)
2717         allocate(current%value(num(5)))
2718         nullify(current%next)
2719         current%id = linklist_head%id + 1
2720         current%name = varname
2721         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2722         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2723         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2724         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2725         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
2726         current%next => linklist_head
2727         linklist_head => current
2728     endif
2729
2730 !   write(unit=*, fmt='(a,i4,3a)') &
2731 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2732
2733 end subroutine push_3d_5_arrays
2734
2735 subroutine pop_3d_5_arrays(a1, a2, a3, a4, a5, varname)
2736
2737     implicit none
2738
2739     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5
2740     character(len=*), intent(in) :: varname
2741
2742     type(linked_list), pointer :: current
2743
2744     integer :: n
2745     integer, dimension(5) :: len
2746     integer, dimension(0:5) :: num
2747
2748     len(1) = size(a1)
2749     len(2) = size(a2)
2750     len(3) = size(a3)
2751     len(4) = size(a4)
2752     len(5) = size(a5)
2753
2754     num(0) = 0
2755     do n=1, 5
2756        num(n) = num(n-1) + len(n)
2757     enddo
2758
2759     current => linklist_head
2760
2761     if(trim(current%name) /= trim(varname)) then
2762        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2763        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2764        return
2765     endif
2766
2767 !   write(unit=*, fmt='(a,i4,3a)') &
2768 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2769
2770     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2771     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2772     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2773     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2774     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
2775
2776     current => current%next
2777
2778     nullify(linklist_head%next)
2779     deallocate(linklist_head%value)
2780     deallocate(linklist_head)
2781     linklist_head => current
2782
2783 end subroutine pop_3d_5_arrays
2784
2785 subroutine push_3d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
2786
2787     implicit none
2788
2789     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6
2790     character(len=*), intent(in) :: varname
2791
2792     type(linked_list), pointer :: current
2793
2794     integer :: n
2795     integer, dimension(6) :: len
2796     integer, dimension(0:6) :: num
2797
2798     len(1) = size(a1)
2799     len(2) = size(a2)
2800     len(3) = size(a3)
2801     len(4) = size(a4)
2802     len(5) = size(a5)
2803     len(6) = size(a6)
2804
2805     num(0) = 0
2806     do n=1, 6
2807        num(n) = num(n-1) + len(n)
2808     enddo
2809
2810     if(.not. associated(linklist_head)) then
2811         nullify(linklist_head)
2812
2813         allocate(linklist_head)
2814         allocate(linklist_head%value(num(6)))
2815         nullify(linklist_head%next)
2816
2817         linklist_head%id = 1
2818         linklist_head%name = varname
2819         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2820         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2821         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2822         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2823         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
2824         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
2825
2826         linklist_tail => linklist_head
2827     else
2828         allocate(current)
2829         allocate(current%value(num(6)))
2830         nullify(current%next)
2831         current%id = linklist_head%id + 1
2832         current%name = varname
2833         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2834         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2835         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2836         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2837         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
2838         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
2839         current%next => linklist_head
2840         linklist_head => current
2841     endif
2842
2843 !   write(unit=*, fmt='(a,i4,3a)') &
2844 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2845
2846 end subroutine push_3d_6_arrays
2847
2848 subroutine pop_3d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
2849
2850     implicit none
2851
2852     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6
2853     character(len=*), intent(in) :: varname
2854
2855     type(linked_list), pointer :: current
2856
2857     integer :: n
2858     integer, dimension(6) :: len
2859     integer, dimension(0:6) :: num
2860
2861     len(1) = size(a1)
2862     len(2) = size(a2)
2863     len(3) = size(a3)
2864     len(4) = size(a4)
2865     len(5) = size(a5)
2866     len(6) = size(a6)
2867
2868     num(0) = 0
2869     do n=1, 6
2870        num(n) = num(n-1) + len(n)
2871     enddo
2872
2873     current => linklist_head
2874
2875     if(trim(current%name) /= trim(varname)) then
2876        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2877        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2878        return
2879     endif
2880
2881 !   write(unit=*, fmt='(a,i4,3a)') &
2882 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
2883
2884     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
2885     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
2886     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
2887     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
2888     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
2889     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
2890
2891     current => current%next
2892
2893     nullify(linklist_head%next)
2894     deallocate(linklist_head%value)
2895     deallocate(linklist_head)
2896     linklist_head => current
2897
2898 end subroutine pop_3d_6_arrays
2899
2900 subroutine push_3d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
2901
2902     implicit none
2903
2904     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7
2905     character(len=*), intent(in) :: varname
2906
2907     type(linked_list), pointer :: current
2908
2909     integer :: n
2910     integer, dimension(7) :: len
2911     integer, dimension(0:7) :: num
2912
2913     len(1) = size(a1)
2914     len(2) = size(a2)
2915     len(3) = size(a3)
2916     len(4) = size(a4)
2917     len(5) = size(a5)
2918     len(6) = size(a6)
2919     len(7) = size(a7)
2920
2921     num(0) = 0
2922     do n=1, 7
2923        num(n) = num(n-1) + len(n)
2924     enddo
2925
2926     if(.not. associated(linklist_head)) then
2927         nullify(linklist_head)
2928
2929         allocate(linklist_head)
2930         allocate(linklist_head%value(num(7)))
2931         nullify(linklist_head%next)
2932
2933         linklist_head%id = 1
2934         linklist_head%name = varname
2935         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
2936         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
2937         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
2938         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
2939         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
2940         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
2941         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
2942
2943         linklist_tail => linklist_head
2944     else
2945         allocate(current)
2946         allocate(current%value(num(7)))
2947         nullify(current%next)
2948         current%id = linklist_head%id + 1
2949         current%name = varname
2950         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
2951         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
2952         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
2953         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
2954         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
2955         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
2956         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
2957         current%next => linklist_head
2958         linklist_head => current
2959     endif
2960
2961 !   write(unit=*, fmt='(a,i4,3a)') &
2962 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
2963
2964 end subroutine push_3d_7_arrays
2965
2966 subroutine pop_3d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
2967
2968     implicit none
2969
2970     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7
2971     character(len=*), intent(in) :: varname
2972
2973     type(linked_list), pointer :: current
2974
2975     integer :: n
2976     integer, dimension(7) :: len
2977     integer, dimension(0:7) :: num
2978
2979     len(1) = size(a1)
2980     len(2) = size(a2)
2981     len(3) = size(a3)
2982     len(4) = size(a4)
2983     len(5) = size(a5)
2984     len(6) = size(a6)
2985     len(7) = size(a7)
2986
2987     num(0) = 0
2988     do n=1, 7
2989        num(n) = num(n-1) + len(n)
2990     enddo
2991
2992     current => linklist_head
2993
2994     if(trim(current%name) /= trim(varname)) then
2995        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
2996        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
2997        return
2998     endif
2999
3000 !   write(unit=*, fmt='(a,i4,3a)') &
3001 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3002
3003     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3004     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3005     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3006     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3007     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
3008     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
3009     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
3010
3011     current => current%next
3012
3013     nullify(linklist_head%next)
3014     deallocate(linklist_head%value)
3015     deallocate(linklist_head)
3016     linklist_head => current
3017
3018 end subroutine pop_3d_7_arrays
3019
3020 subroutine push_3d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
3021
3022     implicit none
3023
3024     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8
3025     character(len=*), intent(in) :: varname
3026
3027     type(linked_list), pointer :: current
3028
3029     integer :: n
3030     integer, dimension(8) :: len
3031     integer, dimension(0:8) :: num
3032
3033     len(1) = size(a1)
3034     len(2) = size(a2)
3035     len(3) = size(a3)
3036     len(4) = size(a4)
3037     len(5) = size(a5)
3038     len(6) = size(a6)
3039     len(7) = size(a7)
3040     len(8) = size(a8)
3041
3042     num(0) = 0
3043     do n=1, 8
3044        num(n) = num(n-1) + len(n)
3045     enddo
3046
3047     if(.not. associated(linklist_head)) then
3048         nullify(linklist_head)
3049
3050         allocate(linklist_head)
3051         allocate(linklist_head%value(num(8)))
3052         nullify(linklist_head%next)
3053
3054         linklist_head%id = 1
3055         linklist_head%name = varname
3056         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3057         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3058         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3059         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3060         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
3061         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
3062         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
3063         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
3064
3065         linklist_tail => linklist_head
3066     else
3067         allocate(current)
3068         allocate(current%value(num(8)))
3069         nullify(current%next)
3070         current%id = linklist_head%id + 1
3071         current%name = varname
3072         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3073         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3074         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3075         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3076         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
3077         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
3078         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
3079         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
3080         current%next => linklist_head
3081         linklist_head => current
3082     endif
3083
3084 !   write(unit=*, fmt='(a,i4,3a)') &
3085 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3086
3087 end subroutine push_3d_8_arrays
3088
3089 subroutine pop_3d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
3090
3091     implicit none
3092
3093     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8
3094     character(len=*), intent(in) :: varname
3095
3096     type(linked_list), pointer :: current
3097
3098     integer :: n
3099     integer, dimension(8) :: len
3100     integer, dimension(0:8) :: num
3101
3102     len(1) = size(a1)
3103     len(2) = size(a2)
3104     len(3) = size(a3)
3105     len(4) = size(a4)
3106     len(5) = size(a5)
3107     len(6) = size(a6)
3108     len(7) = size(a7)
3109     len(8) = size(a8)
3110
3111     num(0) = 0
3112     do n=1, 8
3113        num(n) = num(n-1) + len(n)
3114     enddo
3115
3116     current => linklist_head
3117
3118     if(trim(current%name) /= trim(varname)) then
3119        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3120        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3121        return
3122     endif
3123
3124 !   write(unit=*, fmt='(a,i4,3a)') &
3125 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3126
3127     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3128     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3129     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3130     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3131     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
3132     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
3133     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
3134     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
3135
3136     current => current%next
3137
3138     nullify(linklist_head%next)
3139     deallocate(linklist_head%value)
3140     deallocate(linklist_head)
3141     linklist_head => current
3142
3143 end subroutine pop_3d_8_arrays
3144
3145 subroutine push_3d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
3146
3147     implicit none
3148
3149     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
3150     character(len=*), intent(in) :: varname
3151
3152     type(linked_list), pointer :: current
3153
3154     integer :: n
3155     integer, dimension(9) :: len
3156     integer, dimension(0:9) :: num
3157
3158     len(1) = size(a1)
3159     len(2) = size(a2)
3160     len(3) = size(a3)
3161     len(4) = size(a4)
3162     len(5) = size(a5)
3163     len(6) = size(a6)
3164     len(7) = size(a7)
3165     len(8) = size(a8)
3166     len(9) = size(a9)
3167
3168     num(0) = 0
3169     do n=1, 9
3170        num(n) = num(n-1) + len(n)
3171     enddo
3172
3173     if(.not. associated(linklist_head)) then
3174         nullify(linklist_head)
3175
3176         allocate(linklist_head)
3177         allocate(linklist_head%value(num(9)))
3178         nullify(linklist_head%next)
3179
3180         linklist_head%id = 1
3181         linklist_head%name = varname
3182         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3183         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3184         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3185         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3186         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
3187         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
3188         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
3189         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
3190         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
3191
3192         linklist_tail => linklist_head
3193     else
3194         allocate(current)
3195         allocate(current%value(num(9)))
3196         nullify(current%next)
3197         current%id = linklist_head%id + 1
3198         current%name = varname
3199         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3200         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3201         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3202         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3203         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
3204         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
3205         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
3206         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
3207         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
3208         current%next => linklist_head
3209         linklist_head => current
3210     endif
3211
3212 !   write(unit=*, fmt='(a,i4,3a)') &
3213 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3214
3215 end subroutine push_3d_9_arrays
3216
3217 subroutine pop_3d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
3218
3219     implicit none
3220
3221     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
3222     character(len=*), intent(in) :: varname
3223
3224     type(linked_list), pointer :: current
3225
3226     integer :: n
3227     integer, dimension(9) :: len
3228     integer, dimension(0:9) :: num
3229
3230     len(1) = size(a1)
3231     len(2) = size(a2)
3232     len(3) = size(a3)
3233     len(4) = size(a4)
3234     len(5) = size(a5)
3235     len(6) = size(a6)
3236     len(7) = size(a7)
3237     len(8) = size(a8)
3238     len(9) = size(a9)
3239
3240     num(0) = 0
3241     do n=1, 9
3242        num(n) = num(n-1) + len(n)
3243     enddo
3244
3245     current => linklist_head
3246
3247     if(trim(current%name) /= trim(varname)) then
3248        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3249        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3250        return
3251     endif
3252
3253 !   write(unit=*, fmt='(a,i4,3a)') &
3254 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3255
3256     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3257     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3258     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3259     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3260     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
3261     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
3262     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
3263     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
3264     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
3265
3266     current => current%next
3267
3268     nullify(linklist_head%next)
3269     deallocate(linklist_head%value)
3270     deallocate(linklist_head)
3271     linklist_head => current
3272
3273 end subroutine pop_3d_9_arrays
3274
3275 subroutine push_3d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
3276
3277     implicit none
3278
3279     real, dimension(:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
3280     character(len=*), intent(in) :: varname
3281
3282     type(linked_list), pointer :: current
3283
3284     integer :: n
3285     integer, dimension(10) :: len
3286     integer, dimension(0:10) :: num
3287
3288     len(1) = size(a1)
3289     len(2) = size(a2)
3290     len(3) = size(a3)
3291     len(4) = size(a4)
3292     len(5) = size(a5)
3293     len(6) = size(a6)
3294     len(7) = size(a7)
3295     len(8) = size(a8)
3296     len(9) = size(a9)
3297     len(10) = size(a10)
3298
3299     num(0) = 0
3300     do n=1, 10
3301        num(n) = num(n-1) + len(n)
3302     enddo
3303
3304     if(.not. associated(linklist_head)) then
3305         nullify(linklist_head)
3306
3307         allocate(linklist_head)
3308         allocate(linklist_head%value(num(10)))
3309         nullify(linklist_head%next)
3310
3311         linklist_head%id = 1
3312         linklist_head%name = varname
3313         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3314         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3315         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3316         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3317         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
3318         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
3319         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
3320         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
3321         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
3322         call backup_array(linklist_head%value(num(9)+1:num(10)), a10, len(10))
3323
3324         linklist_tail => linklist_head
3325     else
3326         allocate(current)
3327         allocate(current%value(num(10)))
3328         nullify(current%next)
3329         current%id = linklist_head%id + 1
3330         current%name = varname
3331         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3332         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3333         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3334         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3335         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
3336         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
3337         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
3338         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
3339         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
3340         call backup_array(current%value(num(9)+1:num(10)), a10, len(10))
3341         current%next => linklist_head
3342         linklist_head => current
3343     endif
3344
3345 !   write(unit=*, fmt='(a,i4,3a)') &
3346 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3347
3348 end subroutine push_3d_10_arrays
3349
3350 subroutine pop_3d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
3351
3352     implicit none
3353
3354     real, dimension(:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
3355     character(len=*), intent(in) :: varname
3356
3357     type(linked_list), pointer :: current
3358
3359     integer :: n
3360     integer, dimension(10) :: len
3361     integer, dimension(0:10) :: num
3362
3363     len(1) = size(a1)
3364     len(2) = size(a2)
3365     len(3) = size(a3)
3366     len(4) = size(a4)
3367     len(5) = size(a5)
3368     len(6) = size(a6)
3369     len(7) = size(a7)
3370     len(8) = size(a8)
3371     len(9) = size(a9)
3372     len(10) = size(a10)
3373
3374     num(0) = 0
3375     do n=1, 10
3376        num(n) = num(n-1) + len(n)
3377     enddo
3378
3379     current => linklist_head
3380
3381     if(trim(current%name) /= trim(varname)) then
3382        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3383        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3384        return
3385     endif
3386
3387 !   write(unit=*, fmt='(a,i4,3a)') &
3388 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3389
3390     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3391     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3392     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3393     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3394     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
3395     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
3396     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
3397     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
3398     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
3399     call restore_array(a10, current%value(num(9)+1:num(10)), len(10))
3400
3401     current => current%next
3402
3403     nullify(linklist_head%next)
3404     deallocate(linklist_head%value)
3405     deallocate(linklist_head)
3406     linklist_head => current
3407
3408 end subroutine pop_3d_10_arrays
3409
3410 subroutine push_4d_1_array(a1, varname)
3411
3412     implicit none
3413
3414     real, dimension(:,:,:,:), intent(in) :: a1
3415     character(len=*), intent(in) :: varname
3416
3417     integer :: length
3418
3419     type(linked_list), pointer :: current
3420
3421     length = size(a1)
3422
3423     if(.not. associated(linklist_head)) then
3424         nullify(linklist_head)
3425
3426         allocate(linklist_head)
3427         allocate(linklist_head%value(length))
3428         nullify(linklist_head%next)
3429
3430         linklist_head%id = 1
3431         linklist_head%name = varname
3432         call backup_array(linklist_head%value, a1, length)
3433
3434         linklist_tail => linklist_head
3435     else
3436         allocate(current)
3437         allocate(current%value(length))
3438         nullify(current%next)
3439         current%id = linklist_head%id + 1
3440         current%name = varname
3441         call backup_array(current%value, a1, length)
3442         current%next => linklist_head
3443         linklist_head => current
3444     endif
3445
3446 !   write(unit=*, fmt='(a,i4,3a)') &
3447 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3448
3449 end subroutine push_4d_1_array
3450
3451 subroutine pop_4d_1_array(a1, varname)
3452
3453     implicit none
3454
3455     real, dimension(:,:,:,:), intent(out) :: a1
3456     character(len=*), intent(in) :: varname
3457
3458     integer :: length
3459
3460     type(linked_list), pointer :: current
3461
3462     length = size(a1)
3463
3464     current => linklist_head
3465
3466     if(trim(current%name) /= trim(varname)) then
3467        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3468        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3469        return
3470     endif
3471
3472 !   write(unit=*, fmt='(a,i4,3a)') &
3473 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3474
3475     call restore_array(a1, current%value, length)
3476
3477     current => current%next
3478
3479     nullify(linklist_head%next)
3480     deallocate(linklist_head%value)
3481     deallocate(linklist_head)
3482     linklist_head => current
3483
3484 end subroutine pop_4d_1_array
3485
3486 subroutine push_4d_2_arrays(a1, a2, varname)
3487
3488     implicit none
3489
3490     real, dimension(:,:,:,:), intent(in) :: a1, a2
3491     character(len=*), intent(in) :: varname
3492
3493     type(linked_list), pointer :: current
3494
3495     integer :: n
3496     integer, dimension(2) :: len
3497     integer, dimension(0:2) :: num
3498
3499     len(1) = size(a1)
3500     len(2) = size(a2)
3501
3502     num(0) = 0
3503     do n=1, 2
3504        num(n) = num(n-1) + len(n)
3505     enddo
3506
3507     if(.not. associated(linklist_head)) then
3508         nullify(linklist_head)
3509
3510         allocate(linklist_head)
3511         allocate(linklist_head%value(num(2)))
3512         nullify(linklist_head%next)
3513
3514         linklist_head%id = 1
3515         linklist_head%name = varname
3516         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3517         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3518
3519         linklist_tail => linklist_head
3520     else
3521         allocate(current)
3522         allocate(current%value(num(2)))
3523         nullify(current%next)
3524         current%id = linklist_head%id + 1
3525         current%name = varname
3526         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3527         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3528         current%next => linklist_head
3529         linklist_head => current
3530     endif
3531
3532 !   write(unit=*, fmt='(a,i4,3a)') &
3533 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3534
3535 end subroutine push_4d_2_arrays
3536
3537 subroutine pop_4d_2_arrays(a1, a2, varname)
3538
3539     implicit none
3540
3541     real, dimension(:,:,:,:), intent(out) :: a1, a2
3542     character(len=*), intent(in) :: varname
3543
3544     type(linked_list), pointer :: current
3545
3546     integer :: n
3547     integer, dimension(2) :: len
3548     integer, dimension(0:2) :: num
3549
3550     len(1) = size(a1)
3551     len(2) = size(a2)
3552
3553     num(0) = 0
3554     do n=1, 2
3555        num(n) = num(n-1) + len(n)
3556     enddo
3557
3558     current => linklist_head
3559
3560     if(trim(current%name) /= trim(varname)) then
3561        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3562        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3563        return
3564     endif
3565
3566 !   write(unit=*, fmt='(a,i4,3a)') &
3567 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3568
3569     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3570     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3571
3572     current => current%next
3573
3574     nullify(linklist_head%next)
3575     deallocate(linklist_head%value)
3576     deallocate(linklist_head)
3577     linklist_head => current
3578
3579 end subroutine pop_4d_2_arrays
3580
3581 subroutine push_4d_3_arrays(a1, a2, a3, varname)
3582
3583     implicit none
3584
3585     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3
3586     character(len=*), intent(in) :: varname
3587
3588     type(linked_list), pointer :: current
3589
3590     integer :: n
3591     integer, dimension(3) :: len
3592     integer, dimension(0:3) :: num
3593
3594     len(1) = size(a1)
3595     len(2) = size(a2)
3596     len(3) = size(a3)
3597
3598     num(0) = 0
3599     do n=1, 3
3600        num(n) = num(n-1) + len(n)
3601     enddo
3602
3603     if(.not. associated(linklist_head)) then
3604         nullify(linklist_head)
3605
3606         allocate(linklist_head)
3607         allocate(linklist_head%value(num(3)))
3608         nullify(linklist_head%next)
3609
3610         linklist_head%id = 1
3611         linklist_head%name = varname
3612         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3613         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3614         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3615
3616         linklist_tail => linklist_head
3617     else
3618         allocate(current)
3619         allocate(current%value(num(3)))
3620         nullify(current%next)
3621         current%id = linklist_head%id + 1
3622         current%name = varname
3623         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3624         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3625         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3626         current%next => linklist_head
3627         linklist_head => current
3628     endif
3629
3630 !   write(unit=*, fmt='(a,i4,3a)') &
3631 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3632
3633 end subroutine push_4d_3_arrays
3634
3635 subroutine pop_4d_3_arrays(a1, a2, a3, varname)
3636
3637     implicit none
3638
3639     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3
3640     character(len=*), intent(in) :: varname
3641
3642     type(linked_list), pointer :: current
3643
3644     integer :: n
3645     integer, dimension(3) :: len
3646     integer, dimension(0:3) :: num
3647
3648     len(1) = size(a1)
3649     len(2) = size(a2)
3650     len(3) = size(a3)
3651
3652     num(0) = 0
3653     do n=1, 3
3654        num(n) = num(n-1) + len(n)
3655     enddo
3656
3657     current => linklist_head
3658
3659     if(trim(current%name) /= trim(varname)) then
3660        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3661        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3662        return
3663     endif
3664
3665 !   write(unit=*, fmt='(a,i4,3a)') &
3666 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3667
3668     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3669     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3670     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3671
3672     current => current%next
3673
3674     nullify(linklist_head%next)
3675     deallocate(linklist_head%value)
3676     deallocate(linklist_head)
3677     linklist_head => current
3678
3679 end subroutine pop_4d_3_arrays
3680
3681 subroutine push_4d_4_arrays(a1, a2, a3, a4, varname)
3682
3683     implicit none
3684
3685     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4
3686     character(len=*), intent(in) :: varname
3687
3688     type(linked_list), pointer :: current
3689
3690     integer :: n
3691     integer, dimension(4) :: len
3692     integer, dimension(0:4) :: num
3693
3694     len(1) = size(a1)
3695     len(2) = size(a2)
3696     len(3) = size(a3)
3697     len(4) = size(a4)
3698
3699     num(0) = 0
3700     do n=1, 4
3701        num(n) = num(n-1) + len(n)
3702     enddo
3703
3704     if(.not. associated(linklist_head)) then
3705         nullify(linklist_head)
3706
3707         allocate(linklist_head)
3708         allocate(linklist_head%value(num(4)))
3709         nullify(linklist_head%next)
3710
3711         linklist_head%id = 1
3712         linklist_head%name = varname
3713         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3714         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3715         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3716         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3717
3718         linklist_tail => linklist_head
3719     else
3720         allocate(current)
3721         allocate(current%value(num(4)))
3722         nullify(current%next)
3723         current%id = linklist_head%id + 1
3724         current%name = varname
3725         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3726         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3727         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3728         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3729         current%next => linklist_head
3730         linklist_head => current
3731     endif
3732
3733 !   write(unit=*, fmt='(a,i4,3a)') &
3734 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3735
3736 end subroutine push_4d_4_arrays
3737
3738 subroutine pop_4d_4_arrays(a1, a2, a3, a4, varname)
3739
3740     implicit none
3741
3742     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4
3743     character(len=*), intent(in) :: varname
3744
3745     type(linked_list), pointer :: current
3746
3747     integer :: n
3748     integer, dimension(4) :: len
3749     integer, dimension(0:4) :: num
3750
3751     len(1) = size(a1)
3752     len(2) = size(a2)
3753     len(3) = size(a3)
3754     len(4) = size(a4)
3755
3756     num(0) = 0
3757     do n=1, 4
3758        num(n) = num(n-1) + len(n)
3759     enddo
3760
3761     current => linklist_head
3762
3763     if(trim(current%name) /= trim(varname)) then
3764        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3765        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3766        return
3767     endif
3768
3769 !   write(unit=*, fmt='(a,i4,3a)') &
3770 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3771
3772     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3773     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3774     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3775     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3776
3777     current => current%next
3778
3779     nullify(linklist_head%next)
3780     deallocate(linklist_head%value)
3781     deallocate(linklist_head)
3782     linklist_head => current
3783
3784 end subroutine pop_4d_4_arrays
3785
3786 subroutine push_4d_5_arrays(a1, a2, a3, a4, a5, varname)
3787
3788     implicit none
3789
3790     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5
3791     character(len=*), intent(in) :: varname
3792
3793     type(linked_list), pointer :: current
3794
3795     integer :: n
3796     integer, dimension(5) :: len
3797     integer, dimension(0:5) :: num
3798
3799     len(1) = size(a1)
3800     len(2) = size(a2)
3801     len(3) = size(a3)
3802     len(4) = size(a4)
3803     len(5) = size(a5)
3804
3805     num(0) = 0
3806     do n=1, 5
3807        num(n) = num(n-1) + len(n)
3808     enddo
3809
3810     if(.not. associated(linklist_head)) then
3811         nullify(linklist_head)
3812
3813         allocate(linklist_head)
3814         allocate(linklist_head%value(num(5)))
3815         nullify(linklist_head%next)
3816
3817         linklist_head%id = 1
3818         linklist_head%name = varname
3819         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3820         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3821         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3822         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3823         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
3824
3825         linklist_tail => linklist_head
3826     else
3827         allocate(current)
3828         allocate(current%value(num(5)))
3829         nullify(current%next)
3830         current%id = linklist_head%id + 1
3831         current%name = varname
3832         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3833         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3834         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3835         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3836         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
3837         current%next => linklist_head
3838         linklist_head => current
3839     endif
3840
3841 !   write(unit=*, fmt='(a,i4,3a)') &
3842 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3843
3844 end subroutine push_4d_5_arrays
3845
3846 subroutine pop_4d_5_arrays(a1, a2, a3, a4, a5, varname)
3847
3848     implicit none
3849
3850     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5
3851     character(len=*), intent(in) :: varname
3852
3853     type(linked_list), pointer :: current
3854
3855     integer :: n
3856     integer, dimension(5) :: len
3857     integer, dimension(0:5) :: num
3858
3859     len(1) = size(a1)
3860     len(2) = size(a2)
3861     len(3) = size(a3)
3862     len(4) = size(a4)
3863     len(5) = size(a5)
3864
3865     num(0) = 0
3866     do n=1, 5
3867        num(n) = num(n-1) + len(n)
3868     enddo
3869
3870     current => linklist_head
3871
3872     if(trim(current%name) /= trim(varname)) then
3873        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3874        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3875        return
3876     endif
3877
3878 !   write(unit=*, fmt='(a,i4,3a)') &
3879 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3880
3881     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3882     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3883     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3884     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3885     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
3886
3887     current => current%next
3888
3889     nullify(linklist_head%next)
3890     deallocate(linklist_head%value)
3891     deallocate(linklist_head)
3892     linklist_head => current
3893
3894 end subroutine pop_4d_5_arrays
3895
3896 subroutine push_4d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
3897
3898     implicit none
3899
3900     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6
3901     character(len=*), intent(in) :: varname
3902
3903     type(linked_list), pointer :: current
3904
3905     integer :: n
3906     integer, dimension(6) :: len
3907     integer, dimension(0:6) :: num
3908
3909     len(1) = size(a1)
3910     len(2) = size(a2)
3911     len(3) = size(a3)
3912     len(4) = size(a4)
3913     len(5) = size(a5)
3914     len(6) = size(a6)
3915
3916     num(0) = 0
3917     do n=1, 6
3918        num(n) = num(n-1) + len(n)
3919     enddo
3920
3921     if(.not. associated(linklist_head)) then
3922         nullify(linklist_head)
3923
3924         allocate(linklist_head)
3925         allocate(linklist_head%value(num(6)))
3926         nullify(linklist_head%next)
3927
3928         linklist_head%id = 1
3929         linklist_head%name = varname
3930         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
3931         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
3932         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
3933         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
3934         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
3935         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
3936
3937         linklist_tail => linklist_head
3938     else
3939         allocate(current)
3940         allocate(current%value(num(6)))
3941         nullify(current%next)
3942         current%id = linklist_head%id + 1
3943         current%name = varname
3944         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
3945         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
3946         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
3947         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
3948         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
3949         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
3950         current%next => linklist_head
3951         linklist_head => current
3952     endif
3953
3954 !   write(unit=*, fmt='(a,i4,3a)') &
3955 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
3956
3957 end subroutine push_4d_6_arrays
3958
3959 subroutine pop_4d_6_arrays(a1, a2, a3, a4, a5, a6, varname)
3960
3961     implicit none
3962
3963     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6
3964     character(len=*), intent(in) :: varname
3965
3966     type(linked_list), pointer :: current
3967
3968     integer :: n
3969     integer, dimension(6) :: len
3970     integer, dimension(0:6) :: num
3971
3972     len(1) = size(a1)
3973     len(2) = size(a2)
3974     len(3) = size(a3)
3975     len(4) = size(a4)
3976     len(5) = size(a5)
3977     len(6) = size(a6)
3978
3979     num(0) = 0
3980     do n=1, 6
3981        num(n) = num(n-1) + len(n)
3982     enddo
3983
3984     current => linklist_head
3985
3986     if(trim(current%name) /= trim(varname)) then
3987        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
3988        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
3989        return
3990     endif
3991
3992 !   write(unit=*, fmt='(a,i4,3a)') &
3993 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
3994
3995     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
3996     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
3997     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
3998     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
3999     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
4000     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
4001
4002     current => current%next
4003
4004     nullify(linklist_head%next)
4005     deallocate(linklist_head%value)
4006     deallocate(linklist_head)
4007     linklist_head => current
4008
4009 end subroutine pop_4d_6_arrays
4010
4011 subroutine push_4d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
4012
4013     implicit none
4014
4015     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7
4016     character(len=*), intent(in) :: varname
4017
4018     type(linked_list), pointer :: current
4019
4020     integer :: n
4021     integer, dimension(7) :: len
4022     integer, dimension(0:7) :: num
4023
4024     len(1) = size(a1)
4025     len(2) = size(a2)
4026     len(3) = size(a3)
4027     len(4) = size(a4)
4028     len(5) = size(a5)
4029     len(6) = size(a6)
4030     len(7) = size(a7)
4031
4032     num(0) = 0
4033     do n=1, 7
4034        num(n) = num(n-1) + len(n)
4035     enddo
4036
4037     if(.not. associated(linklist_head)) then
4038         nullify(linklist_head)
4039
4040         allocate(linklist_head)
4041         allocate(linklist_head%value(num(7)))
4042         nullify(linklist_head%next)
4043
4044         linklist_head%id = 1
4045         linklist_head%name = varname
4046         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
4047         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
4048         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
4049         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
4050         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
4051         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
4052         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
4053
4054         linklist_tail => linklist_head
4055     else
4056         allocate(current)
4057         allocate(current%value(num(7)))
4058         nullify(current%next)
4059         current%id = linklist_head%id + 1
4060         current%name = varname
4061         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
4062         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
4063         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
4064         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
4065         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
4066         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
4067         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
4068         current%next => linklist_head
4069         linklist_head => current
4070     endif
4071
4072 !   write(unit=*, fmt='(a,i4,3a)') &
4073 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
4074
4075 end subroutine push_4d_7_arrays
4076
4077 subroutine pop_4d_7_arrays(a1, a2, a3, a4, a5, a6, a7, varname)
4078
4079     implicit none
4080
4081     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7
4082     character(len=*), intent(in) :: varname
4083
4084     type(linked_list), pointer :: current
4085
4086     integer :: n
4087     integer, dimension(7) :: len
4088     integer, dimension(0:7) :: num
4089
4090     len(1) = size(a1)
4091     len(2) = size(a2)
4092     len(3) = size(a3)
4093     len(4) = size(a4)
4094     len(5) = size(a5)
4095     len(6) = size(a6)
4096     len(7) = size(a7)
4097
4098     num(0) = 0
4099     do n=1, 7
4100        num(n) = num(n-1) + len(n)
4101     enddo
4102
4103     current => linklist_head
4104
4105     if(trim(current%name) /= trim(varname)) then
4106        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
4107        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
4108        return
4109     endif
4110
4111 !   write(unit=*, fmt='(a,i4,3a)') &
4112 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
4113
4114     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
4115     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
4116     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
4117     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
4118     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
4119     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
4120     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
4121
4122     current => current%next
4123
4124     nullify(linklist_head%next)
4125     deallocate(linklist_head%value)
4126     deallocate(linklist_head)
4127     linklist_head => current
4128
4129 end subroutine pop_4d_7_arrays
4130
4131 subroutine push_4d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
4132
4133     implicit none
4134
4135     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8
4136     character(len=*), intent(in) :: varname
4137
4138     type(linked_list), pointer :: current
4139
4140     integer :: n
4141     integer, dimension(8) :: len
4142     integer, dimension(0:8) :: num
4143
4144     len(1) = size(a1)
4145     len(2) = size(a2)
4146     len(3) = size(a3)
4147     len(4) = size(a4)
4148     len(5) = size(a5)
4149     len(6) = size(a6)
4150     len(7) = size(a7)
4151     len(8) = size(a8)
4152
4153     num(0) = 0
4154     do n=1, 8
4155        num(n) = num(n-1) + len(n)
4156     enddo
4157
4158     if(.not. associated(linklist_head)) then
4159         nullify(linklist_head)
4160
4161         allocate(linklist_head)
4162         allocate(linklist_head%value(num(8)))
4163         nullify(linklist_head%next)
4164
4165         linklist_head%id = 1
4166         linklist_head%name = varname
4167         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
4168         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
4169         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
4170         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
4171         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
4172         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
4173         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
4174         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
4175
4176         linklist_tail => linklist_head
4177     else
4178         allocate(current)
4179         allocate(current%value(num(8)))
4180         nullify(current%next)
4181         current%id = linklist_head%id + 1
4182         current%name = varname
4183         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
4184         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
4185         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
4186         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
4187         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
4188         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
4189         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
4190         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
4191         current%next => linklist_head
4192         linklist_head => current
4193     endif
4194
4195 !   write(unit=*, fmt='(a,i4,3a)') &
4196 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
4197
4198 end subroutine push_4d_8_arrays
4199
4200 subroutine pop_4d_8_arrays(a1, a2, a3, a4, a5, a6, a7, a8, varname)
4201
4202     implicit none
4203
4204     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8
4205     character(len=*), intent(in) :: varname
4206
4207     type(linked_list), pointer :: current
4208
4209     integer :: n
4210     integer, dimension(8) :: len
4211     integer, dimension(0:8) :: num
4212
4213     len(1) = size(a1)
4214     len(2) = size(a2)
4215     len(3) = size(a3)
4216     len(4) = size(a4)
4217     len(5) = size(a5)
4218     len(6) = size(a6)
4219     len(7) = size(a7)
4220     len(8) = size(a8)
4221
4222     num(0) = 0
4223     do n=1, 8
4224        num(n) = num(n-1) + len(n)
4225     enddo
4226
4227     current => linklist_head
4228
4229     if(trim(current%name) /= trim(varname)) then
4230        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
4231        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
4232        return
4233     endif
4234
4235 !   write(unit=*, fmt='(a,i4,3a)') &
4236 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
4237
4238     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
4239     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
4240     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
4241     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
4242     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
4243     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
4244     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
4245     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
4246
4247     current => current%next
4248
4249     nullify(linklist_head%next)
4250     deallocate(linklist_head%value)
4251     deallocate(linklist_head)
4252     linklist_head => current
4253
4254 end subroutine pop_4d_8_arrays
4255
4256 subroutine push_4d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
4257
4258     implicit none
4259
4260     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
4261     character(len=*), intent(in) :: varname
4262
4263     type(linked_list), pointer :: current
4264
4265     integer :: n
4266     integer, dimension(9) :: len
4267     integer, dimension(0:9) :: num
4268
4269     len(1) = size(a1)
4270     len(2) = size(a2)
4271     len(3) = size(a3)
4272     len(4) = size(a4)
4273     len(5) = size(a5)
4274     len(6) = size(a6)
4275     len(7) = size(a7)
4276     len(8) = size(a8)
4277     len(9) = size(a9)
4278
4279     num(0) = 0
4280     do n=1, 9
4281        num(n) = num(n-1) + len(n)
4282     enddo
4283
4284     if(.not. associated(linklist_head)) then
4285         nullify(linklist_head)
4286
4287         allocate(linklist_head)
4288         allocate(linklist_head%value(num(9)))
4289         nullify(linklist_head%next)
4290
4291         linklist_head%id = 1
4292         linklist_head%name = varname
4293         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
4294         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
4295         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
4296         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
4297         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
4298         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
4299         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
4300         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
4301         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
4302
4303         linklist_tail => linklist_head
4304     else
4305         allocate(current)
4306         allocate(current%value(num(9)))
4307         nullify(current%next)
4308         current%id = linklist_head%id + 1
4309         current%name = varname
4310         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
4311         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
4312         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
4313         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
4314         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
4315         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
4316         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
4317         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
4318         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
4319         current%next => linklist_head
4320         linklist_head => current
4321     endif
4322
4323 !   write(unit=*, fmt='(a,i4,3a)') &
4324 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
4325
4326 end subroutine push_4d_9_arrays
4327
4328 subroutine pop_4d_9_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, varname)
4329
4330     implicit none
4331
4332     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9
4333     character(len=*), intent(in) :: varname
4334
4335     type(linked_list), pointer :: current
4336
4337     integer :: n
4338     integer, dimension(9) :: len
4339     integer, dimension(0:9) :: num
4340
4341     len(1) = size(a1)
4342     len(2) = size(a2)
4343     len(3) = size(a3)
4344     len(4) = size(a4)
4345     len(5) = size(a5)
4346     len(6) = size(a6)
4347     len(7) = size(a7)
4348     len(8) = size(a8)
4349     len(9) = size(a9)
4350
4351     num(0) = 0
4352     do n=1, 9
4353        num(n) = num(n-1) + len(n)
4354     enddo
4355
4356     current => linklist_head
4357
4358     if(trim(current%name) /= trim(varname)) then
4359        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
4360        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
4361        return
4362     endif
4363
4364 !   write(unit=*, fmt='(a,i4,3a)') &
4365 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
4366
4367     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
4368     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
4369     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
4370     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
4371     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
4372     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
4373     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
4374     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
4375     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
4376
4377     current => current%next
4378
4379     nullify(linklist_head%next)
4380     deallocate(linklist_head%value)
4381     deallocate(linklist_head)
4382     linklist_head => current
4383
4384 end subroutine pop_4d_9_arrays
4385
4386 subroutine push_4d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
4387
4388     implicit none
4389
4390     real, dimension(:,:,:,:), intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
4391     character(len=*), intent(in) :: varname
4392
4393     type(linked_list), pointer :: current
4394
4395     integer :: n
4396     integer, dimension(10) :: len
4397     integer, dimension(0:10) :: num
4398
4399     len(1) = size(a1)
4400     len(2) = size(a2)
4401     len(3) = size(a3)
4402     len(4) = size(a4)
4403     len(5) = size(a5)
4404     len(6) = size(a6)
4405     len(7) = size(a7)
4406     len(8) = size(a8)
4407     len(9) = size(a9)
4408     len(10) = size(a10)
4409
4410     num(0) = 0
4411     do n=1, 10
4412        num(n) = num(n-1) + len(n)
4413     enddo
4414
4415     if(.not. associated(linklist_head)) then
4416         nullify(linklist_head)
4417
4418         allocate(linklist_head)
4419         allocate(linklist_head%value(num(10)))
4420         nullify(linklist_head%next)
4421
4422         linklist_head%id = 1
4423         linklist_head%name = varname
4424         call backup_array(linklist_head%value(num(0)+1:num(1)), a1, len(1))
4425         call backup_array(linklist_head%value(num(1)+1:num(2)), a2, len(2))
4426         call backup_array(linklist_head%value(num(2)+1:num(3)), a3, len(3))
4427         call backup_array(linklist_head%value(num(3)+1:num(4)), a4, len(4))
4428         call backup_array(linklist_head%value(num(4)+1:num(5)), a5, len(5))
4429         call backup_array(linklist_head%value(num(5)+1:num(6)), a6, len(6))
4430         call backup_array(linklist_head%value(num(6)+1:num(7)), a7, len(7))
4431         call backup_array(linklist_head%value(num(7)+1:num(8)), a8, len(8))
4432         call backup_array(linklist_head%value(num(8)+1:num(9)), a9, len(9))
4433         call backup_array(linklist_head%value(num(9)+1:num(10)), a10, len(10))
4434
4435         linklist_tail => linklist_head
4436     else
4437         allocate(current)
4438         allocate(current%value(num(10)))
4439         nullify(current%next)
4440         current%id = linklist_head%id + 1
4441         current%name = varname
4442         call backup_array(current%value(num(0)+1:num(1)), a1, len(1))
4443         call backup_array(current%value(num(1)+1:num(2)), a2, len(2))
4444         call backup_array(current%value(num(2)+1:num(3)), a3, len(3))
4445         call backup_array(current%value(num(3)+1:num(4)), a4, len(4))
4446         call backup_array(current%value(num(4)+1:num(5)), a5, len(5))
4447         call backup_array(current%value(num(5)+1:num(6)), a6, len(6))
4448         call backup_array(current%value(num(6)+1:num(7)), a7, len(7))
4449         call backup_array(current%value(num(7)+1:num(8)), a8, len(8))
4450         call backup_array(current%value(num(8)+1:num(9)), a9, len(9))
4451         call backup_array(current%value(num(9)+1:num(10)), a10, len(10))
4452         current%next => linklist_head
4453         linklist_head => current
4454     endif
4455
4456 !   write(unit=*, fmt='(a,i4,3a)') &
4457 !        'Push id:', current%id, ', name: <', trim(current%name), '>'
4458
4459 end subroutine push_4d_10_arrays
4460
4461 subroutine pop_4d_10_arrays(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, varname)
4462
4463     implicit none
4464
4465     real, dimension(:,:,:,:), intent(out) :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10
4466     character(len=*), intent(in) :: varname
4467
4468     type(linked_list), pointer :: current
4469
4470     integer :: n
4471     integer, dimension(10) :: len
4472     integer, dimension(0:10) :: num
4473
4474     len(1) = size(a1)
4475     len(2) = size(a2)
4476     len(3) = size(a3)
4477     len(4) = size(a4)
4478     len(5) = size(a5)
4479     len(6) = size(a6)
4480     len(7) = size(a7)
4481     len(8) = size(a8)
4482     len(9) = size(a9)
4483     len(10) = size(a10)
4484
4485     num(0) = 0
4486     do n=1, 10
4487        num(n) = num(n-1) + len(n)
4488     enddo
4489
4490     current => linklist_head
4491
4492     if(trim(current%name) /= trim(varname)) then
4493        write(unit=6, fmt='(3a)') "Want var: <", trim(varname), ">"
4494        write(unit=6, fmt='(3a)') "But first var in list is: <", trim(current%name), ">"
4495        return
4496     endif
4497
4498 !   write(unit=*, fmt='(a,i4,3a)') &
4499 !        'Pop  id:', current%id, ', name: <', trim(current%name), '>'
4500
4501     call restore_array(a1, current%value(num(0)+1:num(1)), len(1))
4502     call restore_array(a2, current%value(num(1)+1:num(2)), len(2))
4503     call restore_array(a3, current%value(num(2)+1:num(3)), len(3))
4504     call restore_array(a4, current%value(num(3)+1:num(4)), len(4))
4505     call restore_array(a5, current%value(num(4)+1:num(5)), len(5))
4506     call restore_array(a6, current%value(num(5)+1:num(6)), len(6))
4507     call restore_array(a7, current%value(num(6)+1:num(7)), len(7))
4508     call restore_array(a8, current%value(num(7)+1:num(8)), len(8))
4509     call restore_array(a9, current%value(num(8)+1:num(9)), len(9))
4510     call restore_array(a10, current%value(num(9)+1:num(10)), len(10))
4511
4512     current => current%next
4513
4514     nullify(linklist_head%next)
4515     deallocate(linklist_head%value)
4516     deallocate(linklist_head)
4517     linklist_head => current
4518
4519 end subroutine pop_4d_10_arrays
4520
4521 subroutine backup_1d_array(vout, vin, len)
4522     implicit none
4523     integer, intent(in) :: len
4524     real, dimension(:), intent(in ) :: vin
4525     real, dimension(:), intent(out) :: vout
4526
4527     vout(1:len) = vin(1:len)
4528 end subroutine backup_1d_array
4529
4530 subroutine backup_2d_array(vout, vin, len)
4531     implicit none
4532     integer, intent(in) :: len
4533     real, dimension(:), intent(out) :: vout
4534     real, dimension(:,:),   intent(in ) :: vin
4535     integer :: n1, n2, i, j, n
4536     n1 = size(vin, dim=1)
4537     n2 = size(vin, dim=2)
4538     do j=1,n2
4539        n = (j-1)*n1
4540        do i=1, n1
4541           vout(n+i) = vin(i,j)
4542        enddo
4543     enddo
4544 end subroutine backup_2d_array
4545
4546 subroutine backup_3d_array(vout, vin, len)
4547     implicit none
4548     integer, intent(in) :: len
4549     real, dimension(:), intent(out) :: vout
4550     real, dimension(:,:,:),   intent(in ) :: vin
4551     integer :: n1, n2, n3, i, j, k, n
4552     n1 = size(vin, dim=1)
4553     n2 = size(vin, dim=2)
4554     n3 = size(vin, dim=3)
4555     do k=1,n3
4556     do j=1,n2
4557        n = n1*(j-1 + n2*(k-1))
4558        do i=1, n1
4559           vout(n+i) = vin(i,j,k)
4560        enddo
4561     enddo
4562     enddo
4563 end subroutine backup_3d_array
4564
4565 subroutine backup_4d_array(vout, vin, len)
4566     implicit none
4567     integer, intent(in) :: len
4568     real, dimension(:), intent(out) :: vout
4569     real, dimension(:,:,:,:),   intent(in ) :: vin
4570     integer :: n1, n2, n3, n4, i, j, k, m, n
4571     n1 = size(vin, dim=1)
4572     n2 = size(vin, dim=2)
4573     n3 = size(vin, dim=3)
4574     n4 = size(vin, dim=4)
4575     do m=1,n4
4576     do k=1,n3
4577     do j=1,n2
4578        n = n1*(j-1 + n2*(k-1 + n3*(m-1)))
4579        do i=1, n1
4580           vout(n+i) = vin(i,j,k,m)
4581        enddo
4582     enddo
4583     enddo
4584     enddo
4585 end subroutine backup_4d_array
4586
4587 subroutine restore_1d_array(vout, vin, len)
4588     implicit none
4589     integer, intent(in) :: len
4590     real, dimension(:), intent(in ) :: vin
4591     real, dimension(:), intent(out) :: vout
4592
4593     vout(1:len) = vin(1:len)
4594 end subroutine restore_1d_array
4595
4596 subroutine restore_2d_array(vout, vin, len)
4597     implicit none
4598     integer, intent(in) :: len
4599     real, dimension(:,:), intent(out) :: vout
4600     real, dimension(:),   intent(in ) :: vin
4601     integer :: n1, n2, i, j, n
4602     n1 = size(vout, dim=1)
4603     n2 = size(vout, dim=2)
4604     do j=1,n2
4605        n = (j-1)*n1
4606        do i=1, n1
4607           vout(i,j) = vin(n+i)
4608        enddo
4609     enddo
4610 end subroutine restore_2d_array
4611
4612 subroutine restore_3d_array(vout, vin, len)
4613     implicit none
4614     integer, intent(in) :: len
4615     real, dimension(:,:,:), intent(out) :: vout
4616     real, dimension(:),   intent(in ) :: vin
4617     integer :: n1, n2, n3, i, j, k, n
4618     n1 = size(vout, dim=1)
4619     n2 = size(vout, dim=2)
4620     n3 = size(vout, dim=3)
4621     do k=1,n3
4622     do j=1,n2
4623        n = n1*(j-1 + n2*(k-1))
4624        do i=1, n1
4625           vout(i,j,k) = vin(n+i)
4626        enddo
4627     enddo
4628     enddo
4629 end subroutine restore_3d_array
4630
4631 subroutine restore_4d_array(vout, vin, len)
4632     implicit none
4633     integer, intent(in) :: len
4634     real, dimension(:,:,:,:), intent(out) :: vout
4635     real, dimension(:),   intent(in ) :: vin
4636     integer :: n1, n2, n3, n4, i, j, k, m, n
4637     n1 = size(vout, dim=1)
4638     n2 = size(vout, dim=2)
4639     n3 = size(vout, dim=3)
4640     n4 = size(vout, dim=4)
4641     do m=1,n4
4642     do k=1,n3
4643     do j=1,n2
4644        n = n1*(j-1 + n2*(k-1 + n3*(m-1)))
4645        do i=1, n1
4646           vout(i,j,k,m) = vin(n+i)
4647        enddo
4648     enddo
4649     enddo
4650     enddo
4651 end subroutine restore_4d_array
4652
4653 end module module_linked_list2
4654