external/RSL_LITE/f_pack.F90

   1       MODULE duplicate_of_driver_constants
   2 ! These definitions must be the same as frame/module_driver_constants
   3 ! and also the same as the definitions in rsl_lite.h
   4          INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
   5          INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
   6          INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
   7          INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
   8          INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
   9          INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
  10       END MODULE duplicate_of_driver_constants
  11
  12       SUBROUTINE f_pack_int ( inbuf, outbuf, memorder, js, je, ks, ke,            &
  13      &                    is, ie, jms, jme, kms, kme, ims, ime, curs )
  14         USE duplicate_of_driver_constants
  15         IMPLICIT NONE
  16         INTEGER, INTENT(IN) ::  memorder
  17         INTEGER ims, ime, jms, jme, kms, kme
  18         INTEGER inbuf(*), outbuf(*)
  19         INTEGER js, je, ks, ke, is, ie, curs
  20         SELECT CASE ( memorder )
  21           CASE ( DATA_ORDER_XYZ )
  22             CALL f_pack_int_ijk( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  23      &                           jms, jme, kms, kme, ims, ime, curs )
  24           CASE ( DATA_ORDER_YXZ )
  25             CALL f_pack_int_jik( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  26      &                           jms, jme, kms, kme, ims, ime, curs )
  27           CASE ( DATA_ORDER_XZY )
  28             CALL f_pack_int_ikj( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  29      &                           jms, jme, kms, kme, ims, ime, curs )
  30           CASE ( DATA_ORDER_YZX )
  31             CALL f_pack_int_jki( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  32      &                           jms, jme, kms, kme, ims, ime, curs )
  33           CASE ( DATA_ORDER_ZXY )
  34             CALL f_pack_int_kij( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  35      &                           jms, jme, kms, kme, ims, ime, curs )
  36           CASE ( DATA_ORDER_ZYX )
  37             CALL f_pack_int_kji( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  38      &                           jms, jme, kms, kme, ims, ime, curs )
  39         END SELECT
  40         RETURN
  41       END SUBROUTINE f_pack_int
  42
  43       SUBROUTINE f_pack_lint ( inbuf, outbuf, memorder, js, je, ks, ke,           &
  44      &                     is, ie, jms, jme, kms, kme, ims, ime, curs )
  45         USE duplicate_of_driver_constants
  46         IMPLICIT NONE
  47         INTEGER, INTENT(IN) ::  memorder
  48         INTEGER jms, jme, kms, kme, ims, ime
  49         INTEGER*8 inbuf(*), outbuf(*)
  50         INTEGER js, je, ks, ke, is, ie, curs
  51         SELECT CASE ( memorder )
  52           CASE ( DATA_ORDER_XYZ )
  53             CALL f_pack_lint_ijk( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  54      &                           jms, jme, kms, kme, ims, ime, curs )
  55           CASE ( DATA_ORDER_YXZ )
  56             CALL f_pack_lint_jik( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  57      &                           jms, jme, kms, kme, ims, ime, curs )
  58           CASE ( DATA_ORDER_XZY )
  59             CALL f_pack_lint_ikj( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  60      &                           jms, jme, kms, kme, ims, ime, curs )
  61           CASE ( DATA_ORDER_YZX )
  62             CALL f_pack_lint_jki( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  63      &                           jms, jme, kms, kme, ims, ime, curs )
  64           CASE ( DATA_ORDER_ZXY )
  65             CALL f_pack_lint_kij( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  66      &                           jms, jme, kms, kme, ims, ime, curs )
  67           CASE ( DATA_ORDER_ZYX )
  68             CALL f_pack_lint_kji( inbuf, outbuf, js, je, ks, ke, is, ie,           &
  69      &                           jms, jme, kms, kme, ims, ime, curs )
  70         END SELECT
  71         RETURN
  72       END SUBROUTINE f_pack_lint
  73
  74       SUBROUTINE f_unpack_int ( inbuf, outbuf, memorder, js, je, ks, ke,           &
  75      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  76         USE duplicate_of_driver_constants
  77         IMPLICIT NONE
  78         INTEGER, INTENT(IN) ::  memorder
  79         INTEGER jms, jme, kms, kme, ims, ime
  80         INTEGER outbuf(*), inbuf(*)
  81         INTEGER js, je, ks, ke, is, ie, curs
  82         SELECT CASE ( memorder )
  83           CASE ( DATA_ORDER_XYZ )
  84             CALL f_unpack_int_ijk( inbuf, outbuf, js, je, ks, ke,                   &
  85      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  86           CASE ( DATA_ORDER_YXZ )
  87             CALL f_unpack_int_jik( inbuf, outbuf, js, je, ks, ke,                   &
  88      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  89           CASE ( DATA_ORDER_XZY )
  90             CALL f_unpack_int_ikj( inbuf, outbuf, js, je, ks, ke,                   &
  91      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  92           CASE ( DATA_ORDER_YZX )
  93             CALL f_unpack_int_jki( inbuf, outbuf, js, je, ks, ke,                   &
  94      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  95           CASE ( DATA_ORDER_ZXY )
  96             CALL f_unpack_int_kij( inbuf, outbuf, js, je, ks, ke,                   &
  97      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
  98           CASE ( DATA_ORDER_ZYX )
  99             CALL f_unpack_int_kji( inbuf, outbuf, js, je, ks, ke,                   &
 100      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 101         END SELECT
 102         RETURN
 103       END SUBROUTINE f_unpack_int
 104
 105       SUBROUTINE f_unpack_lint ( inbuf, outbuf, memorder, js, je, ks,               &
 106      &                 ke, is, ie, jms, jme, kms, kme, ims, ime, curs )
 107         USE duplicate_of_driver_constants
 108         IMPLICIT NONE
 109         INTEGER, INTENT(IN) ::  memorder
 110         INTEGER jms, jme, kms, kme, ims, ime
 111         INTEGER*8 outbuf(*), inbuf(*)
 112         INTEGER js, je, ks, ke, is, ie, curs
 113         SELECT CASE ( memorder )
 114           CASE ( DATA_ORDER_XYZ )
 115             CALL f_unpack_lint_ijk( inbuf, outbuf, js, je, ks, ke,                   &
 116      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 117           CASE ( DATA_ORDER_YXZ )
 118             CALL f_unpack_lint_jik( inbuf, outbuf, js, je, ks, ke,                   &
 119      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 120           CASE ( DATA_ORDER_XZY )
 121             CALL f_unpack_lint_ikj( inbuf, outbuf, js, je, ks, ke,                   &
 122      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 123           CASE ( DATA_ORDER_YZX )
 124             CALL f_unpack_lint_jki( inbuf, outbuf, js, je, ks, ke,                   &
 125      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 126           CASE ( DATA_ORDER_ZXY )
 127             CALL f_unpack_lint_kij( inbuf, outbuf, js, je, ks, ke,                   &
 128      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 129           CASE ( DATA_ORDER_ZYX )
 130             CALL f_unpack_lint_kji( inbuf, outbuf, js, je, ks, ke,                   &
 131      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 132         END SELECT
 133         RETURN
 134       END SUBROUTINE f_unpack_lint
 135
 136 !ikj
 137       SUBROUTINE f_pack_int_ikj ( inbuf, outbuf, js, je, ks, ke,              &
 138      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 139         IMPLICIT NONE
 140         INTEGER jms, jme, kms, kme, ims, ime
 141         INTEGER inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
 142         INTEGER js, je, ks, ke, is, ie, curs
 143         ! Local
 144         INTEGER i,j,k,p
 145 !$OMP PARALLEL PRIVATE (i,j,k,p)
 146 #ifndef _OPENMP
 147         p = 1
 148 #endif
 149 !$OMP DO SCHEDULE(RUNTIME)
 150         DO j = js, je
 151 #ifdef _OPENMP
 152         p = (j-js)*(ie-is+1)*(ke-ks+1)+1
 153 #endif
 154           DO k = ks, ke
 155             DO i = is, ie
 156               outbuf(p) = inbuf(i,k,j)
 157               p = p + 1
 158             ENDDO
 159           ENDDO
 160         ENDDO
 161 !$OMP END DO
 162 !$OMP END PARALLEL
 163
 164         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 165         RETURN
 166       END SUBROUTINE f_pack_int_ikj
 167
 168       SUBROUTINE f_pack_lint_ikj ( inbuf, outbuf, js, je, ks, ke,            &
 169      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 170         IMPLICIT NONE
 171         INTEGER jms, jme, kms, kme, ims, ime
 172         INTEGER*8 inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
 173         INTEGER js, je, ks, ke, is, ie, curs
 174         ! Local
 175         INTEGER i,j,k,p
 176 !$OMP PARALLEL PRIVATE (i,j,k,p)
 177 #ifndef _OPENMP
 178         p = 1
 179 #endif
 180 !$OMP DO SCHEDULE(RUNTIME)
 181         DO j = js, je
 182 #ifdef _OPENMP
 183         p = (j-js)*(ie-is+1)*(ke-ks+1)+1
 184 #endif
 185           DO k = ks, ke
 186             DO i = is, ie
 187               outbuf(p) = inbuf(i,k,j)
 188               p = p + 1
 189             ENDDO
 190           ENDDO
 191         ENDDO
 192 !$OMP END DO
 193 !$OMP END PARALLEL
 194         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 195         RETURN
 196       END SUBROUTINE f_pack_lint_ikj
 197
 198       SUBROUTINE f_unpack_int_ikj ( inbuf, outbuf, js, je, ks, ke,            &
 199      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 200         IMPLICIT NONE
 201         INTEGER jms, jme, kms, kme, ims, ime
 202         INTEGER outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
 203         INTEGER js, je, ks, ke, is, ie, curs
 204         ! Local
 205         INTEGER i,j,k,p
 206 !$OMP PARALLEL PRIVATE (i,j,k,p)
 207 #ifndef _OPENMP
 208         p = 1
 209 #endif
 210 !$OMP DO SCHEDULE(RUNTIME)
 211         DO j = js, je
 212 #ifdef _OPENMP
 213         p = (j-js)*(ie-is+1)*(ke-ks+1)+1
 214 #endif
 215           DO k = ks, ke
 216             DO i = is, ie
 217               outbuf(i,k,j) = inbuf(p)
 218               p = p + 1
 219             ENDDO
 220           ENDDO
 221         ENDDO
 222 !$OMP END DO
 223 !$OMP END PARALLEL
 224         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 225         RETURN
 226       END SUBROUTINE f_unpack_int_ikj
 227
 228       SUBROUTINE f_unpack_lint_ikj ( inbuf, outbuf, js, je, ks, ke,            &
 229      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 230         IMPLICIT NONE
 231         INTEGER jms, jme, kms, kme, ims, ime
 232         INTEGER*8 outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
 233         INTEGER js, je, ks, ke, is, ie, curs
 234         ! Local
 235         INTEGER i,j,k,p
 236 !$OMP PARALLEL PRIVATE (i,j,k,p)
 237 #ifndef _OPENMP
 238         p = 1
 239 #endif
 240 !$OMP DO SCHEDULE(RUNTIME)
 241         DO j = js, je
 242 #ifdef _OPENMP
 243         p = (j-js)*(ie-is+1)*(ke-ks+1)+1
 244 #endif
 245           DO k = ks, ke
 246             DO i = is, ie
 247               outbuf(i,k,j) = inbuf(p)
 248               p = p + 1
 249             ENDDO
 250           ENDDO
 251         ENDDO
 252 !$OMP END DO
 253 !$OMP END PARALLEL
 254         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 255         RETURN
 256       END SUBROUTINE f_unpack_lint_ikj
 257
 258 !jki
 259       SUBROUTINE f_pack_int_jki ( inbuf, outbuf, js, je, ks, ke,              &
 260      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 261         IMPLICIT NONE
 262         INTEGER jms, jme, kms, kme, ims, ime
 263         INTEGER inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
 264         INTEGER js, je, ks, ke, is, ie, curs
 265         ! Local
 266         INTEGER i,j,k,p
 267 !$OMP PARALLEL PRIVATE (i,j,k,p)
 268 #ifndef _OPENMP
 269         p = 1
 270 #endif
 271 !$OMP DO SCHEDULE(RUNTIME)
 272             DO i = is, ie
 273 #ifdef _OPENMP
 274         p = (i-is)*(je-js+1)*(ke-ks+1)+1
 275 #endif
 276           DO k = ks, ke
 277         DO j = js, je
 278               outbuf(p) = inbuf(j,k,i)
 279               p = p + 1
 280             ENDDO
 281           ENDDO
 282         ENDDO
 283 !$OMP END DO
 284 !$OMP END PARALLEL
 285         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 286         RETURN
 287       END SUBROUTINE f_pack_int_jki
 288
 289       SUBROUTINE f_pack_lint_jki ( inbuf, outbuf, js, je, ks, ke,            &
 290      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 291         IMPLICIT NONE
 292         INTEGER jms, jme, kms, kme, ims, ime
 293         INTEGER*8 inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
 294         INTEGER js, je, ks, ke, is, ie, curs
 295         ! Local
 296         INTEGER i,j,k,p
 297 !$OMP PARALLEL PRIVATE (i,j,k,p)
 298 #ifndef _OPENMP
 299         p = 1
 300 #endif
 301 !$OMP DO SCHEDULE(RUNTIME)
 302             DO i = is, ie
 303 #ifdef _OPENMP
 304         p = (i-is)*(je-js+1)*(ke-ks+1)+1
 305 #endif
 306           DO k = ks, ke
 307         DO j = js, je
 308               outbuf(p) = inbuf(j,k,i)
 309               p = p + 1
 310             ENDDO
 311           ENDDO
 312         ENDDO
 313 !$OMP END DO
 314 !$OMP END PARALLEL
 315         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 316         RETURN
 317       END SUBROUTINE f_pack_lint_jki
 318
 319       SUBROUTINE f_unpack_int_jki ( inbuf, outbuf, js, je, ks, ke,            &
 320      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 321         IMPLICIT NONE
 322         INTEGER jms, jme, kms, kme, ims, ime
 323         INTEGER outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
 324         INTEGER js, je, ks, ke, is, ie, curs
 325         ! Local
 326         INTEGER i,j,k,p
 327 !$OMP PARALLEL PRIVATE (i,j,k,p)
 328 #ifndef _OPENMP
 329         p = 1
 330 #endif
 331 !$OMP DO SCHEDULE(RUNTIME)
 332             DO i = is, ie
 333 #ifdef _OPENMP
 334         p = (i-is)*(je-js+1)*(ke-ks+1)+1
 335 #endif
 336           DO k = ks, ke
 337         DO j = js, je
 338               outbuf(j,k,i) = inbuf(p)
 339               p = p + 1
 340             ENDDO
 341           ENDDO
 342         ENDDO
 343 !$OMP END DO
 344 !$OMP END PARALLEL
 345         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 346         RETURN
 347       END SUBROUTINE f_unpack_int_jki
 348
 349       SUBROUTINE f_unpack_lint_jki ( inbuf, outbuf, js, je, ks, ke,            &
 350      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 351         IMPLICIT NONE
 352         INTEGER jms, jme, kms, kme, ims, ime
 353         INTEGER*8 outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
 354         INTEGER js, je, ks, ke, is, ie, curs
 355         ! Local
 356         INTEGER i,j,k,p
 357 !$OMP PARALLEL PRIVATE (i,j,k,p)
 358 #ifndef _OPENMP
 359         p = 1
 360 #endif
 361 !$OMP DO SCHEDULE(RUNTIME)
 362             DO i = is, ie
 363 #ifdef _OPENMP
 364         p = (i-is)*(je-js+1)*(ke-ks+1)+1
 365 #endif
 366           DO k = ks, ke
 367         DO j = js, je
 368               outbuf(j,k,i) = inbuf(p)
 369               p = p + 1
 370             ENDDO
 371           ENDDO
 372         ENDDO
 373 !$OMP END DO
 374 !$OMP END PARALLEL
 375         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 376         RETURN
 377       END SUBROUTINE f_unpack_lint_jki
 378
 379 !ijk
 380       SUBROUTINE f_pack_int_ijk ( inbuf, outbuf, js, je, ks, ke,              &
 381      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 382         IMPLICIT NONE
 383         INTEGER jms, jme, kms, kme, ims, ime
 384         INTEGER inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
 385         INTEGER js, je, ks, ke, is, ie, curs
 386         ! Local
 387         INTEGER i,j,k,p
 388 !$OMP PARALLEL PRIVATE (i,j,k,p)
 389 #ifndef _OPENMP
 390         p = 1
 391 #endif
 392 !$OMP DO SCHEDULE(RUNTIME)
 393         DO k = ks, ke
 394 #ifdef _OPENMP
 395         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 396 #endif
 397           DO j = js, je
 398             DO i = is, ie
 399               outbuf(p) = inbuf(i,j,k)
 400               p = p + 1
 401             ENDDO
 402           ENDDO
 403         ENDDO
 404 !$OMP END DO
 405 !$OMP END PARALLEL
 406         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 407         RETURN
 408       END SUBROUTINE f_pack_int_ijk
 409
 410       SUBROUTINE f_pack_lint_ijk ( inbuf, outbuf, js, je, ks, ke,            &
 411      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 412         IMPLICIT NONE
 413         INTEGER jms, jme, kms, kme, ims, ime
 414         INTEGER*8 inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
 415         INTEGER js, je, ks, ke, is, ie, curs
 416         ! Local
 417         INTEGER i,j,k,p
 418 !$OMP PARALLEL PRIVATE (i,j,k,p)
 419 #ifndef _OPENMP
 420         p = 1
 421 #endif
 422 !$OMP DO SCHEDULE(RUNTIME)
 423         DO k = ks, ke
 424 #ifdef _OPENMP
 425         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 426 #endif
 427           DO j = js, je
 428             DO i = is, ie
 429               outbuf(p) = inbuf(i,j,k)
 430               p = p + 1
 431             ENDDO
 432           ENDDO
 433         ENDDO
 434 !$OMP END DO
 435 !$OMP END PARALLEL
 436         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 437         RETURN
 438       END SUBROUTINE f_pack_lint_ijk
 439
 440       SUBROUTINE f_unpack_int_ijk ( inbuf, outbuf, js, je, ks, ke,            &
 441      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 442         IMPLICIT NONE
 443         INTEGER jms, jme, kms, kme, ims, ime
 444         INTEGER outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
 445         INTEGER js, je, ks, ke, is, ie, curs
 446         ! Local
 447         INTEGER i,j,k,p
 448 !$OMP PARALLEL PRIVATE (i,j,k,p)
 449 #ifndef _OPENMP
 450         p = 1
 451 #endif
 452 !$OMP DO SCHEDULE(RUNTIME)
 453         DO k = ks, ke
 454 #ifdef _OPENMP
 455         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 456 #endif
 457           DO j = js, je
 458             DO i = is, ie
 459               outbuf(i,j,k) = inbuf(p)
 460               p = p + 1
 461             ENDDO
 462           ENDDO
 463         ENDDO
 464 !$OMP END DO
 465 !$OMP END PARALLEL
 466         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 467         RETURN
 468       END SUBROUTINE f_unpack_int_ijk
 469
 470       SUBROUTINE f_unpack_lint_ijk ( inbuf, outbuf, js, je, ks, ke,            &
 471      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 472         IMPLICIT NONE
 473         INTEGER jms, jme, kms, kme, ims, ime
 474         INTEGER*8 outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
 475         INTEGER js, je, ks, ke, is, ie, curs
 476         ! Local
 477         INTEGER i,j,k,p
 478 !$OMP PARALLEL PRIVATE (i,j,k,p)
 479 #ifndef _OPENMP
 480         p = 1
 481 #endif
 482 !$OMP DO SCHEDULE(RUNTIME)
 483         DO k = ks, ke
 484 #ifdef _OPENMP
 485         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 486 #endif
 487           DO j = js, je
 488             DO i = is, ie
 489               outbuf(i,j,k) = inbuf(p)
 490               p = p + 1
 491             ENDDO
 492           ENDDO
 493         ENDDO
 494 !$OMP END DO
 495 !$OMP END PARALLEL
 496         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 497         RETURN
 498       END SUBROUTINE f_unpack_lint_ijk
 499
 500 !jik
 501       SUBROUTINE f_pack_int_jik ( inbuf, outbuf, js, je, ks, ke,              &
 502      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 503         IMPLICIT NONE
 504         INTEGER jms, jme, kms, kme, ims, ime
 505         INTEGER inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
 506         INTEGER js, je, ks, ke, is, ie, curs
 507         ! Local
 508         INTEGER i,j,k,p
 509 !$OMP PARALLEL PRIVATE (i,j,k,p)
 510 #ifndef _OPENMP
 511         p = 1
 512 #endif
 513 !$OMP DO SCHEDULE(RUNTIME)
 514         DO k = ks, ke
 515 #ifdef _OPENMP
 516         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 517 #endif
 518           DO i = is, ie
 519             DO j = js, je
 520               outbuf(p) = inbuf(j,i,k)
 521               p = p + 1
 522             ENDDO
 523           ENDDO
 524         ENDDO
 525 !$OMP END DO
 526 !$OMP END PARALLEL
 527         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 528         RETURN
 529       END SUBROUTINE f_pack_int_jik
 530
 531       SUBROUTINE f_pack_lint_jik ( inbuf, outbuf, js, je, ks, ke,            &
 532      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 533         IMPLICIT NONE
 534         INTEGER jms, jme, kms, kme, ims, ime
 535         INTEGER*8 inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
 536         INTEGER js, je, ks, ke, is, ie, curs
 537         ! Local
 538         INTEGER i,j,k,p
 539 !$OMP PARALLEL PRIVATE (i,j,k,p)
 540 #ifndef _OPENMP
 541         p = 1
 542 #endif
 543 !$OMP DO SCHEDULE(RUNTIME)
 544         DO k = ks, ke
 545 #ifdef _OPENMP
 546         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 547 #endif
 548           DO i = is, ie
 549             DO j = js, je
 550               outbuf(p) = inbuf(j,i,k)
 551               p = p + 1
 552             ENDDO
 553           ENDDO
 554         ENDDO
 555 !$OMP END DO
 556 !$OMP END PARALLEL
 557         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 558         RETURN
 559       END SUBROUTINE f_pack_lint_jik
 560
 561       SUBROUTINE f_unpack_int_jik ( inbuf, outbuf, js, je, ks, ke,            &
 562      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 563         IMPLICIT NONE
 564         INTEGER jms, jme, kms, kme, ims, ime
 565         INTEGER outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
 566         INTEGER js, je, ks, ke, is, ie, curs
 567         ! Local
 568         INTEGER i,j,k,p
 569 !$OMP PARALLEL PRIVATE (i,j,k,p)
 570 #ifndef _OPENMP
 571         p = 1
 572 #endif
 573 !$OMP DO SCHEDULE(RUNTIME)
 574         DO k = ks, ke
 575 #ifdef _OPENMP
 576         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 577 #endif
 578           DO i = is, ie
 579             DO j = js, je
 580               outbuf(j,i,k) = inbuf(p)
 581               p = p + 1
 582             ENDDO
 583           ENDDO
 584         ENDDO
 585 !$OMP END DO
 586 !$OMP END PARALLEL
 587         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 588         RETURN
 589       END SUBROUTINE f_unpack_int_jik
 590
 591       SUBROUTINE f_unpack_lint_jik ( inbuf, outbuf, js, je, ks, ke,            &
 592      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 593         IMPLICIT NONE
 594         INTEGER jms, jme, kms, kme, ims, ime
 595         INTEGER*8 outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
 596         INTEGER js, je, ks, ke, is, ie, curs
 597         ! Local
 598         INTEGER i,j,k,p
 599 !$OMP PARALLEL PRIVATE (i,j,k,p)
 600 #ifndef _OPENMP
 601         p = 1
 602 #endif
 603 !$OMP DO SCHEDULE(RUNTIME)
 604         DO k = ks, ke
 605 #ifdef _OPENMP
 606         p = (k-ks)*(je-js+1)*(ie-is+1)+1
 607 #endif
 608           DO i = is, ie
 609             DO j = js, je
 610               outbuf(j,i,k) = inbuf(p)
 611               p = p + 1
 612             ENDDO
 613           ENDDO
 614         ENDDO
 615 !$OMP END DO
 616 !$OMP END PARALLEL
 617         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 618         RETURN
 619       END SUBROUTINE f_unpack_lint_jik
 620
 621 !kij
 622       SUBROUTINE f_pack_int_kij ( inbuf, outbuf, js, je, ks, ke,              &
 623      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 624         IMPLICIT NONE
 625         INTEGER jms, jme, kms, kme, ims, ime
 626         INTEGER inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
 627         INTEGER js, je, ks, ke, is, ie, curs
 628         ! Local
 629         INTEGER i,j,k,p
 630 !$OMP PARALLEL PRIVATE (i,j,k,p)
 631 #ifndef _OPENMP
 632         p = 1
 633 #endif
 634 !$OMP DO SCHEDULE(RUNTIME)
 635         DO j = js, je
 636 #ifdef _OPENMP
 637         p = (j-js)*(ke-ks+1)*(ie-is+1)+1
 638 #endif
 639           DO i = is, ie
 640             DO k = ks, ke
 641               outbuf(p) = inbuf(k,i,j)
 642               p = p + 1
 643             ENDDO
 644           ENDDO
 645         ENDDO
 646 !$OMP END DO
 647 !$OMP END PARALLEL
 648         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 649         RETURN
 650       END SUBROUTINE f_pack_int_kij
 651
 652       SUBROUTINE f_pack_lint_kij ( inbuf, outbuf, js, je, ks, ke,            &
 653      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 654         IMPLICIT NONE
 655         INTEGER jms, jme, kms, kme, ims, ime
 656         INTEGER*8 inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
 657         INTEGER js, je, ks, ke, is, ie, curs
 658         ! Local
 659         INTEGER i,j,k,p
 660 !$OMP PARALLEL PRIVATE (i,j,k,p)
 661 #ifndef _OPENMP
 662         p = 1
 663 #endif
 664 !$OMP DO SCHEDULE(RUNTIME)
 665         DO j = js, je
 666 #ifdef _OPENMP
 667         p = (j-js)*(ke-ks+1)*(ie-is+1)+1
 668 #endif
 669           DO i = is, ie
 670             DO k = ks, ke
 671               outbuf(p) = inbuf(k,i,j)
 672               p = p + 1
 673             ENDDO
 674           ENDDO
 675         ENDDO
 676 !$OMP END DO
 677 !$OMP END PARALLEL
 678         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 679         RETURN
 680       END SUBROUTINE f_pack_lint_kij
 681
 682       SUBROUTINE f_unpack_int_kij ( inbuf, outbuf, js, je, ks, ke,            &
 683      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 684         IMPLICIT NONE
 685         INTEGER jms, jme, kms, kme, ims, ime
 686         INTEGER outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
 687         INTEGER js, je, ks, ke, is, ie, curs
 688         ! Local
 689         INTEGER i,j,k,p
 690 !$OMP PARALLEL PRIVATE (i,j,k,p)
 691 #ifndef _OPENMP
 692         p = 1
 693 #endif
 694 !$OMP DO SCHEDULE(RUNTIME)
 695         DO j = js, je
 696 #ifdef _OPENMP
 697         p = (j-js)*(ke-ks+1)*(ie-is+1)+1
 698 #endif
 699           DO i = is, ie
 700             DO k = ks, ke
 701               outbuf(k,i,j) = inbuf(p)
 702               p = p + 1
 703             ENDDO
 704           ENDDO
 705         ENDDO
 706 !$OMP END DO
 707 !$OMP END PARALLEL
 708         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 709         RETURN
 710       END SUBROUTINE f_unpack_int_kij
 711
 712       SUBROUTINE f_unpack_lint_kij ( inbuf, outbuf, js, je, ks, ke,            &
 713      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 714         IMPLICIT NONE
 715         INTEGER jms, jme, kms, kme, ims, ime
 716         INTEGER*8 outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
 717         INTEGER js, je, ks, ke, is, ie, curs
 718         ! Local
 719         INTEGER i,j,k,p
 720 !$OMP PARALLEL PRIVATE (i,j,k,p)
 721 #ifndef _OPENMP
 722         p = 1
 723 #endif
 724 !$OMP DO SCHEDULE(RUNTIME)
 725         DO j = js, je
 726 #ifdef _OPENMP
 727         p = (j-js)*(ke-ks+1)*(ie-is+1)+1
 728 #endif
 729           DO i = is, ie
 730             DO k = ks, ke
 731               outbuf(k,i,j) = inbuf(p)
 732               p = p + 1
 733             ENDDO
 734           ENDDO
 735         ENDDO
 736 !$OMP END DO
 737 !$OMP END PARALLEL
 738         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 739         RETURN
 740       END SUBROUTINE f_unpack_lint_kij
 741
 742 !kji
 743       SUBROUTINE f_pack_int_kji ( inbuf, outbuf, js, je, ks, ke,              &
 744      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 745         IMPLICIT NONE
 746         INTEGER jms, jme, kms, kme, ims, ime
 747         INTEGER inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
 748         INTEGER js, je, ks, ke, is, ie, curs
 749         ! Local
 750         INTEGER i,j,k,p
 751 !$OMP PARALLEL PRIVATE (i,j,k,p)
 752 #ifndef _OPENMP
 753         p = 1
 754 #endif
 755 !$OMP DO SCHEDULE(RUNTIME)
 756           DO i = is, ie
 757 #ifdef _OPENMP
 758         p = (i-is)*(ke-ks+1)*(je-js+1)+1
 759 #endif
 760         DO j = js, je
 761             DO k = ks, ke
 762               outbuf(p) = inbuf(k,j,i)
 763               p = p + 1
 764             ENDDO
 765           ENDDO
 766         ENDDO
 767 !$OMP END DO
 768 !$OMP END PARALLEL
 769         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 770         RETURN
 771       END SUBROUTINE f_pack_int_kji
 772
 773       SUBROUTINE f_pack_lint_kji ( inbuf, outbuf, js, je, ks, ke,            &
 774      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 775         IMPLICIT NONE
 776         INTEGER jms, jme, kms, kme, ims, ime
 777         INTEGER*8 inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
 778         INTEGER js, je, ks, ke, is, ie, curs
 779         ! Local
 780         INTEGER i,j,k,p
 781 !$OMP PARALLEL PRIVATE (i,j,k,p)
 782 #ifndef _OPENMP
 783         p = 1
 784 #endif
 785 !$OMP DO SCHEDULE(RUNTIME)
 786           DO i = is, ie
 787 #ifdef _OPENMP
 788         p = (i-is)*(ke-ks+1)*(je-js+1)+1
 789 #endif
 790         DO j = js, je
 791             DO k = ks, ke
 792               outbuf(p) = inbuf(k,j,i)
 793               p = p + 1
 794             ENDDO
 795           ENDDO
 796         ENDDO
 797 !$OMP END DO
 798 !$OMP END PARALLEL
 799         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 800         RETURN
 801       END SUBROUTINE f_pack_lint_kji
 802
 803       SUBROUTINE f_unpack_int_kji ( inbuf, outbuf, js, je, ks, ke,            &
 804      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 805         IMPLICIT NONE
 806         INTEGER jms, jme, kms, kme, ims, ime
 807         INTEGER outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
 808         INTEGER js, je, ks, ke, is, ie, curs
 809         ! Local
 810         INTEGER i,j,k,p
 811 !$OMP PARALLEL PRIVATE (i,j,k,p)
 812 #ifndef _OPENMP
 813         p = 1
 814 #endif
 815 !$OMP DO SCHEDULE(RUNTIME)
 816           DO i = is, ie
 817 #ifdef _OPENMP
 818         p = (i-is)*(ke-ks+1)*(je-js+1)+1
 819 #endif
 820         DO j = js, je
 821             DO k = ks, ke
 822               outbuf(k,j,i) = inbuf(p)
 823               p = p + 1
 824             ENDDO
 825           ENDDO
 826         ENDDO
 827 !$OMP END DO
 828 !$OMP END PARALLEL
 829         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 830         RETURN
 831       END SUBROUTINE f_unpack_int_kji
 832
 833       SUBROUTINE f_unpack_lint_kji ( inbuf, outbuf, js, je, ks, ke,            &
 834      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 835         IMPLICIT NONE
 836         INTEGER jms, jme, kms, kme, ims, ime
 837         INTEGER*8 outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
 838         INTEGER js, je, ks, ke, is, ie, curs
 839         ! Local
 840         INTEGER i,j,k,p
 841 !$OMP PARALLEL PRIVATE (i,j,k,p)
 842 #ifndef _OPENMP
 843         p = 1
 844 #endif
 845 !$OMP DO SCHEDULE(RUNTIME)
 846           DO i = is, ie
 847 #ifdef _OPENMP
 848         p = (i-is)*(ke-ks+1)*(je-js+1)+1
 849 #endif
 850         DO j = js, je
 851             DO k = ks, ke
 852               outbuf(k,j,i) = inbuf(p)
 853               p = p + 1
 854             ENDDO
 855           ENDDO
 856         ENDDO
 857 !$OMP END DO
 858 !$OMP END PARALLEL
 859         curs = (ie-is+1)*(je-js+1)*(ke-ks+1)
 860         RETURN
 861       END SUBROUTINE f_unpack_lint_kji
 862
 863 #if ( WRFPLUS == 1 )
 864 !--------------------------------------------------------------------------------
 865       SUBROUTINE f_pack_int_ad ( inbuf, outbuf, memorder, js, je, ks, ke,            &
 866      &                    is, ie, jms, jme, kms, kme, ims, ime, curs )
 867         USE duplicate_of_driver_constants
 868         IMPLICIT NONE
 869         INTEGER, INTENT(IN) ::  memorder
 870         INTEGER ims, ime, jms, jme, kms, kme
 871         INTEGER inbuf(*), outbuf(*)
 872         INTEGER js, je, ks, ke, is, ie, curs
 873         SELECT CASE ( memorder )
 874           CASE ( DATA_ORDER_XYZ )
 875             CALL f_pack_real_ad_ijk( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 876      &                           jms, jme, kms, kme, ims, ime, curs )
 877           CASE ( DATA_ORDER_YXZ )
 878             CALL f_pack_real_ad_jik( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 879      &                           jms, jme, kms, kme, ims, ime, curs )
 880           CASE ( DATA_ORDER_XZY )
 881             CALL f_pack_real_ad_ikj( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 882      &                           jms, jme, kms, kme, ims, ime, curs )
 883           CASE ( DATA_ORDER_YZX )
 884             CALL f_pack_real_ad_jki( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 885      &                           jms, jme, kms, kme, ims, ime, curs )
 886           CASE ( DATA_ORDER_ZXY )
 887             CALL f_pack_real_ad_kij( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 888      &                           jms, jme, kms, kme, ims, ime, curs )
 889           CASE ( DATA_ORDER_ZYX )
 890             CALL f_pack_real_ad_kji( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 891      &                           jms, jme, kms, kme, ims, ime, curs )
 892         END SELECT
 893         RETURN
 894       END SUBROUTINE f_pack_int_ad
 895
 896       SUBROUTINE f_pack_lint_ad ( inbuf, outbuf, memorder, js, je, ks, ke,           &
 897      &                     is, ie, jms, jme, kms, kme, ims, ime, curs )
 898         USE duplicate_of_driver_constants
 899         IMPLICIT NONE
 900         INTEGER, INTENT(IN) ::  memorder
 901         INTEGER jms, jme, kms, kme, ims, ime
 902         INTEGER*8 inbuf(*), outbuf(*)
 903         INTEGER js, je, ks, ke, is, ie, curs
 904         SELECT CASE ( memorder )
 905           CASE ( DATA_ORDER_XYZ )
 906             CALL f_pack_lreal_ad_ijk( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 907      &                           jms, jme, kms, kme, ims, ime, curs )
 908           CASE ( DATA_ORDER_YXZ )
 909             CALL f_pack_lreal_ad_jik( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 910      &                           jms, jme, kms, kme, ims, ime, curs )
 911           CASE ( DATA_ORDER_XZY )
 912             CALL f_pack_lreal_ad_ikj( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 913      &                           jms, jme, kms, kme, ims, ime, curs )
 914           CASE ( DATA_ORDER_YZX )
 915             CALL f_pack_lreal_ad_jki( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 916      &                           jms, jme, kms, kme, ims, ime, curs )
 917           CASE ( DATA_ORDER_ZXY )
 918             CALL f_pack_lreal_ad_kij( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 919      &                           jms, jme, kms, kme, ims, ime, curs )
 920           CASE ( DATA_ORDER_ZYX )
 921             CALL f_pack_lreal_ad_kji( inbuf, outbuf, js, je, ks, ke, is, ie,           &
 922      &                           jms, jme, kms, kme, ims, ime, curs )
 923         END SELECT
 924         RETURN
 925       END SUBROUTINE f_pack_lint_ad
 926
 927       SUBROUTINE f_unpack_int_ad ( inbuf, outbuf, memorder, js, je, ks, ke,           &
 928      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 929         USE duplicate_of_driver_constants
 930         IMPLICIT NONE
 931         INTEGER, INTENT(IN) ::  memorder
 932         INTEGER jms, jme, kms, kme, ims, ime
 933         INTEGER outbuf(*), inbuf(*)
 934         INTEGER js, je, ks, ke, is, ie, curs
 935         SELECT CASE ( memorder )
 936           CASE ( DATA_ORDER_XYZ )
 937             CALL f_unpack_real_ad_ijk( inbuf, outbuf, js, je, ks, ke,                   &
 938      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 939           CASE ( DATA_ORDER_YXZ )
 940             CALL f_unpack_real_ad_jik( inbuf, outbuf, js, je, ks, ke,                   &
 941      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 942           CASE ( DATA_ORDER_XZY )
 943             CALL f_unpack_real_ad_ikj( inbuf, outbuf, js, je, ks, ke,                   &
 944      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 945           CASE ( DATA_ORDER_YZX )
 946             CALL f_unpack_real_ad_jki( inbuf, outbuf, js, je, ks, ke,                   &
 947      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 948           CASE ( DATA_ORDER_ZXY )
 949             CALL f_unpack_real_ad_kij( inbuf, outbuf, js, je, ks, ke,                   &
 950      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 951           CASE ( DATA_ORDER_ZYX )
 952             CALL f_unpack_real_ad_kji( inbuf, outbuf, js, je, ks, ke,                   &
 953      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 954         END SELECT
 955         RETURN
 956       END SUBROUTINE f_unpack_int_ad
 957
 958       SUBROUTINE f_unpack_lint_ad ( inbuf, outbuf, memorder, js, je, ks,               &
 959      &                 ke, is, ie, jms, jme, kms, kme, ims, ime, curs )
 960         USE duplicate_of_driver_constants
 961         IMPLICIT NONE
 962         INTEGER, INTENT(IN) ::  memorder
 963         INTEGER jms, jme, kms, kme, ims, ime
 964         INTEGER*8 outbuf(*), inbuf(*)
 965         INTEGER js, je, ks, ke, is, ie, curs
 966         SELECT CASE ( memorder )
 967           CASE ( DATA_ORDER_XYZ )
 968             CALL f_unpack_lreal_ad_ijk( inbuf, outbuf, js, je, ks, ke,                   &
 969      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 970           CASE ( DATA_ORDER_YXZ )
 971             CALL f_unpack_lreal_ad_jik( inbuf, outbuf, js, je, ks, ke,                   &
 972      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 973           CASE ( DATA_ORDER_XZY )
 974             CALL f_unpack_lreal_ad_ikj( inbuf, outbuf, js, je, ks, ke,                   &
 975      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 976           CASE ( DATA_ORDER_YZX )
 977             CALL f_unpack_lreal_ad_jki( inbuf, outbuf, js, je, ks, ke,                   &
 978      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 979           CASE ( DATA_ORDER_ZXY )
 980             CALL f_unpack_lreal_ad_kij( inbuf, outbuf, js, je, ks, ke,                   &
 981      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 982           CASE ( DATA_ORDER_ZYX )
 983             CALL f_unpack_lreal_ad_kji( inbuf, outbuf, js, je, ks, ke,                   &
 984      &                      is, ie, jms, jme, kms, kme, ims, ime, curs )
 985         END SELECT
 986         RETURN
 987       END SUBROUTINE f_unpack_lint_ad
 988
 989 !ikj
 990       SUBROUTINE f_pack_real_ad_ikj ( inbuf, outbuf, js, je, ks, ke,              &
 991      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
 992         IMPLICIT NONE
 993         INTEGER jms, jme, kms, kme, ims, ime
 994         REAL    inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
 995         INTEGER js, je, ks, ke, is, ie, curs
 996         ! Local
 997         INTEGER i,j,k,p
 998         p = 1
 999         DO j = js, je
1000           DO k = ks, ke
1001             DO i = is, ie
1002               outbuf(p) = inbuf(i,k,j)
1003               inbuf(i,k,j) = 0.0
1004               p = p + 1
1005             ENDDO
1006           ENDDO
1007         ENDDO
1008         curs = p - 1
1009         RETURN
1010       END SUBROUTINE f_pack_real_ad_ikj
1011
1012       SUBROUTINE f_pack_lreal_ad_ikj ( inbuf, outbuf, js, je, ks, ke,            &
1013      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1014         IMPLICIT NONE
1015         INTEGER jms, jme, kms, kme, ims, ime
1016         REAL*8  inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
1017         INTEGER js, je, ks, ke, is, ie, curs
1018         ! Local
1019         INTEGER i,j,k,p
1020         p = 1
1021         DO j = js, je
1022           DO k = ks, ke
1023             DO i = is, ie
1024               outbuf(p) = inbuf(i,k,j)
1025               inbuf(i,k,j) = 0.0
1026               p = p + 1
1027             ENDDO
1028           ENDDO
1029         ENDDO
1030         curs = p - 1
1031         RETURN
1032       END SUBROUTINE f_pack_lreal_ad_ikj
1033
1034       SUBROUTINE f_unpack_real_ad_ikj ( inbuf, outbuf, js, je, ks, ke,            &
1035      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1036         IMPLICIT NONE
1037         INTEGER jms, jme, kms, kme, ims, ime
1038         REAL    outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
1039         INTEGER js, je, ks, ke, is, ie, curs
1040         ! Local
1041         INTEGER i,j,k,p
1042         p = 1
1043         DO j = js, je
1044           DO k = ks, ke
1045             DO i = is, ie
1046               outbuf(i,k,j) = outbuf(i,k,j) + inbuf(p)
1047               p = p + 1
1048             ENDDO
1049           ENDDO
1050         ENDDO
1051         curs = p - 1
1052         RETURN
1053       END SUBROUTINE f_unpack_real_ad_ikj
1054
1055       SUBROUTINE f_unpack_lreal_ad_ikj ( inbuf, outbuf, js, je, ks, ke,            &
1056      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1057         IMPLICIT NONE
1058         INTEGER jms, jme, kms, kme, ims, ime
1059         REAL*8  outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
1060         INTEGER js, je, ks, ke, is, ie, curs
1061         ! Local
1062         INTEGER i,j,k,p
1063         p = 1
1064         DO j = js, je
1065           DO k = ks, ke
1066             DO i = is, ie
1067               outbuf(i,k,j) = outbuf(i,k,j) + inbuf(p)
1068               p = p + 1
1069             ENDDO
1070           ENDDO
1071         ENDDO
1072         curs = p - 1
1073         RETURN
1074       END SUBROUTINE f_unpack_lreal_ad_ikj
1075
1076 !jki
1077       SUBROUTINE f_pack_real_ad_jki ( inbuf, outbuf, js, je, ks, ke,              &
1078      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1079         IMPLICIT NONE
1080         INTEGER jms, jme, kms, kme, ims, ime
1081         REAL    inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
1082         INTEGER js, je, ks, ke, is, ie, curs
1083         ! Local
1084         INTEGER i,j,k,p
1085         p = 1
1086             DO i = is, ie
1087           DO k = ks, ke
1088         DO j = js, je
1089               outbuf(p) = inbuf(j,k,i)
1090               inbuf(j,k,i) = 0.0
1091               p = p + 1
1092             ENDDO
1093           ENDDO
1094         ENDDO
1095         curs = p - 1
1096         RETURN
1097       END SUBROUTINE f_pack_real_ad_jki
1098
1099       SUBROUTINE f_pack_lreal_ad_jki ( inbuf, outbuf, js, je, ks, ke,            &
1100      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1101         IMPLICIT NONE
1102         INTEGER jms, jme, kms, kme, ims, ime
1103         REAL*8  inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
1104         INTEGER js, je, ks, ke, is, ie, curs
1105         ! Local
1106         INTEGER i,j,k,p
1107         p = 1
1108             DO i = is, ie
1109           DO k = ks, ke
1110         DO j = js, je
1111               outbuf(p) = inbuf(j,k,i)
1112               inbuf(j,k,i) = 0.0
1113               p = p + 1
1114             ENDDO
1115           ENDDO
1116         ENDDO
1117         curs = p - 1
1118         RETURN
1119       END SUBROUTINE f_pack_lreal_ad_jki
1120
1121       SUBROUTINE f_unpack_real_ad_jki ( inbuf, outbuf, js, je, ks, ke,            &
1122      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1123         IMPLICIT NONE
1124         INTEGER jms, jme, kms, kme, ims, ime
1125         REAL    outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
1126         INTEGER js, je, ks, ke, is, ie, curs
1127         ! Local
1128         INTEGER i,j,k,p
1129         p = 1
1130             DO i = is, ie
1131           DO k = ks, ke
1132         DO j = js, je
1133               outbuf(j,k,i) = outbuf(j,k,i) + inbuf(p)
1134               p = p + 1
1135             ENDDO
1136           ENDDO
1137         ENDDO
1138         curs = p - 1
1139         RETURN
1140       END SUBROUTINE f_unpack_real_ad_jki
1141
1142       SUBROUTINE f_unpack_lreal_ad_jki ( inbuf, outbuf, js, je, ks, ke,            &
1143      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1144         IMPLICIT NONE
1145         INTEGER jms, jme, kms, kme, ims, ime
1146         REAL*8  outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
1147         INTEGER js, je, ks, ke, is, ie, curs
1148         ! Local
1149         INTEGER i,j,k,p
1150         p = 1
1151             DO i = is, ie
1152           DO k = ks, ke
1153         DO j = js, je
1154               outbuf(j,k,i) = outbuf(j,k,i) + inbuf(p)
1155               p = p + 1
1156             ENDDO
1157           ENDDO
1158         ENDDO
1159         curs = p - 1
1160         RETURN
1161       END SUBROUTINE f_unpack_lreal_ad_jki
1162
1163 !ijk
1164       SUBROUTINE f_pack_real_ad_ijk ( inbuf, outbuf, js, je, ks, ke,              &
1165      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1166         IMPLICIT NONE
1167         INTEGER jms, jme, kms, kme, ims, ime
1168         REAL    inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
1169         INTEGER js, je, ks, ke, is, ie, curs
1170         ! Local
1171         INTEGER i,j,k,p
1172         p = 1
1173         DO k = ks, ke
1174           DO j = js, je
1175             DO i = is, ie
1176               outbuf(p) = inbuf(i,j,k)
1177               inbuf(i,j,k) = 0.0
1178               p = p + 1
1179             ENDDO
1180           ENDDO
1181         ENDDO
1182         curs = p - 1
1183         RETURN
1184       END SUBROUTINE f_pack_real_ad_ijk
1185
1186       SUBROUTINE f_pack_lreal_ad_ijk ( inbuf, outbuf, js, je, ks, ke,            &
1187      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1188         IMPLICIT NONE
1189         INTEGER jms, jme, kms, kme, ims, ime
1190         REAL*8  inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
1191         INTEGER js, je, ks, ke, is, ie, curs
1192         ! Local
1193         INTEGER i,j,k,p
1194         p = 1
1195         DO k = ks, ke
1196           DO j = js, je
1197             DO i = is, ie
1198               outbuf(p) = inbuf(i,j,k)
1199               inbuf(i,j,k) = 0.0
1200               p = p + 1
1201             ENDDO
1202           ENDDO
1203         ENDDO
1204         curs = p - 1
1205         RETURN
1206       END SUBROUTINE f_pack_lreal_ad_ijk
1207
1208       SUBROUTINE f_unpack_real_ad_ijk ( inbuf, outbuf, js, je, ks, ke,            &
1209      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1210         IMPLICIT NONE
1211         INTEGER jms, jme, kms, kme, ims, ime
1212         REAL    outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
1213         INTEGER js, je, ks, ke, is, ie, curs
1214         ! Local
1215         INTEGER i,j,k,p
1216         p = 1
1217         DO k = ks, ke
1218           DO j = js, je
1219             DO i = is, ie
1220               outbuf(i,j,k) = outbuf(i,j,k) + inbuf(p)
1221               p = p + 1
1222             ENDDO
1223           ENDDO
1224         ENDDO
1225         curs = p - 1
1226         RETURN
1227       END SUBROUTINE f_unpack_real_ad_ijk
1228
1229       SUBROUTINE f_unpack_lreal_ad_ijk ( inbuf, outbuf, js, je, ks, ke,            &
1230      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1231         IMPLICIT NONE
1232         INTEGER jms, jme, kms, kme, ims, ime
1233         REAL*8  outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
1234         INTEGER js, je, ks, ke, is, ie, curs
1235         ! Local
1236         INTEGER i,j,k,p
1237         p = 1
1238         DO k = ks, ke
1239           DO j = js, je
1240             DO i = is, ie
1241               outbuf(i,j,k) = outbuf(i,j,k) + inbuf(p)
1242               p = p + 1
1243             ENDDO
1244           ENDDO
1245         ENDDO
1246         curs = p - 1
1247         RETURN
1248       END SUBROUTINE f_unpack_lreal_ad_ijk
1249
1250 !jik
1251       SUBROUTINE f_pack_real_ad_jik ( inbuf, outbuf, js, je, ks, ke,              &
1252      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1253         IMPLICIT NONE
1254         INTEGER jms, jme, kms, kme, ims, ime
1255         REAL    inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
1256         INTEGER js, je, ks, ke, is, ie, curs
1257         ! Local
1258         INTEGER i,j,k,p
1259         p = 1
1260         DO k = ks, ke
1261           DO i = is, ie
1262             DO j = js, je
1263               outbuf(p) = inbuf(j,i,k)
1264               inbuf(j,i,k) = 0.0
1265               p = p + 1
1266             ENDDO
1267           ENDDO
1268         ENDDO
1269         curs = p - 1
1270         RETURN
1271       END SUBROUTINE f_pack_real_ad_jik
1272
1273       SUBROUTINE f_pack_lreal_ad_jik ( inbuf, outbuf, js, je, ks, ke,            &
1274      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1275         IMPLICIT NONE
1276         INTEGER jms, jme, kms, kme, ims, ime
1277         REAL*8  inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
1278         INTEGER js, je, ks, ke, is, ie, curs
1279         ! Local
1280         INTEGER i,j,k,p
1281         p = 1
1282         DO k = ks, ke
1283           DO i = is, ie
1284             DO j = js, je
1285               outbuf(p) = inbuf(j,i,k)
1286               inbuf(j,i,k) = 0.0
1287               p = p + 1
1288             ENDDO
1289           ENDDO
1290         ENDDO
1291         curs = p - 1
1292         RETURN
1293       END SUBROUTINE f_pack_lreal_ad_jik
1294
1295       SUBROUTINE f_unpack_real_ad_jik ( inbuf, outbuf, js, je, ks, ke,            &
1296      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1297         IMPLICIT NONE
1298         INTEGER jms, jme, kms, kme, ims, ime
1299         REAL    outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
1300         INTEGER js, je, ks, ke, is, ie, curs
1301         ! Local
1302         INTEGER i,j,k,p
1303         p = 1
1304         DO k = ks, ke
1305           DO i = is, ie
1306             DO j = js, je
1307               outbuf(j,i,k) = outbuf(j,i,k) + inbuf(p)
1308               p = p + 1
1309             ENDDO
1310           ENDDO
1311         ENDDO
1312         curs = p - 1
1313         RETURN
1314       END SUBROUTINE f_unpack_real_ad_jik
1315
1316       SUBROUTINE f_unpack_lreal_ad_jik ( inbuf, outbuf, js, je, ks, ke,            &
1317      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1318         IMPLICIT NONE
1319         INTEGER jms, jme, kms, kme, ims, ime
1320         REAL*8  outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
1321         INTEGER js, je, ks, ke, is, ie, curs
1322         ! Local
1323         INTEGER i,j,k,p
1324         p = 1
1325         DO k = ks, ke
1326           DO i = is, ie
1327             DO j = js, je
1328               outbuf(j,i,k) = outbuf(j,i,k) + inbuf(p)
1329               p = p + 1
1330             ENDDO
1331           ENDDO
1332         ENDDO
1333         curs = p - 1
1334         RETURN
1335       END SUBROUTINE f_unpack_lreal_ad_jik
1336
1337 !kij
1338       SUBROUTINE f_pack_real_ad_kij ( inbuf, outbuf, js, je, ks, ke,              &
1339      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1340         IMPLICIT NONE
1341         INTEGER jms, jme, kms, kme, ims, ime
1342         REAL    inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
1343         INTEGER js, je, ks, ke, is, ie, curs
1344         ! Local
1345         INTEGER i,j,k,p
1346         p = 1
1347         DO j = js, je
1348           DO i = is, ie
1349             DO k = ks, ke
1350               outbuf(p) = inbuf(k,i,j)
1351               inbuf(k,i,j) = 0.0
1352               p = p + 1
1353             ENDDO
1354           ENDDO
1355         ENDDO
1356         curs = p - 1
1357         RETURN
1358       END SUBROUTINE f_pack_real_ad_kij
1359
1360       SUBROUTINE f_pack_lreal_ad_kij ( inbuf, outbuf, js, je, ks, ke,            &
1361      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1362         IMPLICIT NONE
1363         INTEGER jms, jme, kms, kme, ims, ime
1364         REAL*8  inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
1365         INTEGER js, je, ks, ke, is, ie, curs
1366         ! Local
1367         INTEGER i,j,k,p
1368         p = 1
1369         DO j = js, je
1370           DO i = is, ie
1371             DO k = ks, ke
1372               outbuf(p) = inbuf(k,i,j)
1373               inbuf(k,i,j) = 0.0
1374               p = p + 1
1375             ENDDO
1376           ENDDO
1377         ENDDO
1378         curs = p - 1
1379         RETURN
1380       END SUBROUTINE f_pack_lreal_ad_kij
1381
1382       SUBROUTINE f_unpack_real_ad_kij ( inbuf, outbuf, js, je, ks, ke,            &
1383      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1384         IMPLICIT NONE
1385         INTEGER jms, jme, kms, kme, ims, ime
1386         REAL    outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
1387         INTEGER js, je, ks, ke, is, ie, curs
1388         ! Local
1389         INTEGER i,j,k,p
1390         p = 1
1391         DO j = js, je
1392           DO i = is, ie
1393             DO k = ks, ke
1394               outbuf(k,i,j) = outbuf(k,i,j) + inbuf(p)
1395               p = p + 1
1396             ENDDO
1397           ENDDO
1398         ENDDO
1399         curs = p - 1
1400         RETURN
1401       END SUBROUTINE f_unpack_real_ad_kij
1402
1403       SUBROUTINE f_unpack_lreal_ad_kij ( inbuf, outbuf, js, je, ks, ke,            &
1404      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1405         IMPLICIT NONE
1406         INTEGER jms, jme, kms, kme, ims, ime
1407         REAL*8  outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
1408         INTEGER js, je, ks, ke, is, ie, curs
1409         ! Local
1410         INTEGER i,j,k,p
1411         p = 1
1412         DO j = js, je
1413           DO i = is, ie
1414             DO k = ks, ke
1415               outbuf(k,i,j) = outbuf(k,i,j) + inbuf(p)
1416               p = p + 1
1417             ENDDO
1418           ENDDO
1419         ENDDO
1420         curs = p - 1
1421         RETURN
1422       END SUBROUTINE f_unpack_lreal_ad_kij
1423
1424 !kji
1425       SUBROUTINE f_pack_real_ad_kji ( inbuf, outbuf, js, je, ks, ke,              &
1426      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1427         IMPLICIT NONE
1428         INTEGER jms, jme, kms, kme, ims, ime
1429         REAL    inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
1430         INTEGER js, je, ks, ke, is, ie, curs
1431         ! Local
1432         INTEGER i,j,k,p
1433         p = 1
1434           DO i = is, ie
1435         DO j = js, je
1436             DO k = ks, ke
1437               outbuf(p) = inbuf(k,j,i)
1438               inbuf(k,j,i) = 0.0
1439               p = p + 1
1440             ENDDO
1441           ENDDO
1442         ENDDO
1443         curs = p - 1
1444         RETURN
1445       END SUBROUTINE f_pack_real_ad_kji
1446
1447       SUBROUTINE f_pack_lreal_ad_kji ( inbuf, outbuf, js, je, ks, ke,            &
1448      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1449         IMPLICIT NONE
1450         INTEGER jms, jme, kms, kme, ims, ime
1451         REAL*8  inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
1452         INTEGER js, je, ks, ke, is, ie, curs
1453         ! Local
1454         INTEGER i,j,k,p
1455         p = 1
1456           DO i = is, ie
1457         DO j = js, je
1458             DO k = ks, ke
1459               outbuf(p) = inbuf(k,j,i)
1460               inbuf(k,j,i) = 0.0
1461               p = p + 1
1462             ENDDO
1463           ENDDO
1464         ENDDO
1465         curs = p - 1
1466         RETURN
1467       END SUBROUTINE f_pack_lreal_ad_kji
1468
1469       SUBROUTINE f_unpack_real_ad_kji ( inbuf, outbuf, js, je, ks, ke,            &
1470      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1471         IMPLICIT NONE
1472         INTEGER jms, jme, kms, kme, ims, ime
1473         REAL    outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
1474         INTEGER js, je, ks, ke, is, ie, curs
1475         ! Local
1476         INTEGER i,j,k,p
1477         p = 1
1478           DO i = is, ie
1479         DO j = js, je
1480             DO k = ks, ke
1481               outbuf(k,j,i) = outbuf(k,j,i) + inbuf(p)
1482               p = p + 1
1483             ENDDO
1484           ENDDO
1485         ENDDO
1486         curs = p - 1
1487         RETURN
1488       END SUBROUTINE f_unpack_real_ad_kji
1489
1490       SUBROUTINE f_unpack_lreal_ad_kji ( inbuf, outbuf, js, je, ks, ke,            &
1491      &                is, ie, jms, jme, kms, kme, ims, ime, curs )
1492         IMPLICIT NONE
1493         INTEGER jms, jme, kms, kme, ims, ime
1494         REAL*8  outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
1495         INTEGER js, je, ks, ke, is, ie, curs
1496         ! Local
1497         INTEGER i,j,k,p
1498         p = 1
1499           DO i = is, ie
1500         DO j = js, je
1501             DO k = ks, ke
1502               outbuf(k,j,i) = outbuf(k,j,i) + inbuf(p)
1503               p = p + 1
1504             ENDDO
1505           ENDDO
1506         ENDDO
1507         curs = p - 1
1508         RETURN
1509       END SUBROUTINE f_unpack_lreal_ad_kji
1510 #endif