| 1 | |
|---|
| 2 | SUBROUTINE f_pack_int ( inbuf, outbuf, js, je, ks, ke, is, ie, & |
|---|
| 3 | & jms, jme, kms, kme, ims, ime, curs ) |
|---|
| 4 | IMPLICIT NONE |
|---|
| 5 | INTEGER jms, jme, kms, kme, ims, ime |
|---|
| 6 | INTEGER inbuf(ims:ime,kms:kme,jms:jme), outbuf(*) |
|---|
| 7 | INTEGER js, je, ks, ke, is, ie, curs |
|---|
| 8 | ! Local |
|---|
| 9 | INTEGER i,j,k,p |
|---|
| 10 | p = 1 |
|---|
| 11 | DO j = js, je |
|---|
| 12 | DO k = ks, ke |
|---|
| 13 | DO i = is, ie |
|---|
| 14 | outbuf(p) = inbuf(i,k,j) |
|---|
| 15 | p = p + 1 |
|---|
| 16 | ENDDO |
|---|
| 17 | ENDDO |
|---|
| 18 | ENDDO |
|---|
| 19 | curs = p - 1 |
|---|
| 20 | RETURN |
|---|
| 21 | END SUBROUTINE f_pack_int |
|---|
| 22 | |
|---|
| 23 | SUBROUTINE f_pack_lint ( inbuf, outbuf, js, je, ks, ke, is, ie, & |
|---|
| 24 | & jms, jme, kms, kme, ims, ime, curs ) |
|---|
| 25 | IMPLICIT NONE |
|---|
| 26 | INTEGER jms, jme, kms, kme, ims, ime |
|---|
| 27 | INTEGER*8 inbuf(ims:ime,kms:kme,jms:jme), outbuf(*) |
|---|
| 28 | INTEGER js, je, ks, ke, is, ie, curs |
|---|
| 29 | ! Local |
|---|
| 30 | INTEGER i,j,k,p |
|---|
| 31 | p = 1 |
|---|
| 32 | DO j = js, je |
|---|
| 33 | DO k = ks, ke |
|---|
| 34 | DO i = is, ie |
|---|
| 35 | outbuf(p) = inbuf(i,k,j) |
|---|
| 36 | p = p + 1 |
|---|
| 37 | ENDDO |
|---|
| 38 | ENDDO |
|---|
| 39 | ENDDO |
|---|
| 40 | curs = p - 1 |
|---|
| 41 | RETURN |
|---|
| 42 | END SUBROUTINE f_pack_lint |
|---|
| 43 | |
|---|
| 44 | SUBROUTINE f_unpack_int ( inbuf, outbuf, js, je, ks, ke, is, ie, & |
|---|
| 45 | & jms, jme, kms, kme, ims, ime, curs ) |
|---|
| 46 | IMPLICIT NONE |
|---|
| 47 | INTEGER jms, jme, kms, kme, ims, ime |
|---|
| 48 | INTEGER outbuf(ims:ime,kms:kme,jms:jme), inbuf(*) |
|---|
| 49 | INTEGER js, je, ks, ke, is, ie, curs |
|---|
| 50 | ! Local |
|---|
| 51 | INTEGER i,j,k,p |
|---|
| 52 | p = 1 |
|---|
| 53 | DO j = js, je |
|---|
| 54 | DO k = ks, ke |
|---|
| 55 | DO i = is, ie |
|---|
| 56 | outbuf(i,k,j) = inbuf(p) |
|---|
| 57 | p = p + 1 |
|---|
| 58 | ENDDO |
|---|
| 59 | ENDDO |
|---|
| 60 | ENDDO |
|---|
| 61 | curs = p - 1 |
|---|
| 62 | RETURN |
|---|
| 63 | END SUBROUTINE f_unpack_int |
|---|
| 64 | |
|---|
| 65 | SUBROUTINE f_unpack_lint ( inbuf, outbuf, js, je, ks, ke, is, ie, & |
|---|
| 66 | & jms, jme, kms, kme, ims, ime, curs ) |
|---|
| 67 | IMPLICIT NONE |
|---|
| 68 | INTEGER jms, jme, kms, kme, ims, ime |
|---|
| 69 | INTEGER*8 outbuf(ims:ime,kms:kme,jms:jme), inbuf(*) |
|---|
| 70 | INTEGER js, je, ks, ke, is, ie, curs |
|---|
| 71 | ! Local |
|---|
| 72 | INTEGER i,j,k,p |
|---|
| 73 | p = 1 |
|---|
| 74 | DO j = js, je |
|---|
| 75 | DO k = ks, ke |
|---|
| 76 | DO i = is, ie |
|---|
| 77 | outbuf(i,k,j) = inbuf(p) |
|---|
| 78 | p = p + 1 |
|---|
| 79 | ENDDO |
|---|
| 80 | ENDDO |
|---|
| 81 | ENDDO |
|---|
| 82 | curs = p - 1 |
|---|
| 83 | RETURN |
|---|
| 84 | END SUBROUTINE f_unpack_lint |
|---|
| 85 | |
|---|
