/[MITgcm]/MITgcm/pkg/mdsio/mdsio_pass_r8tors.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_pass_r8tors.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by jmc, Mon Jun 1 14:20:31 2009 UTC revision 1.3 by jmc, Mon Jun 8 03:32:33 2009 UTC
# Line 12  C---+----1----+----2----+----3----+----4 Line 12  C---+----1----+----2----+----3----+----4
12  CBOP  CBOP
13  C !ROUTINE: MDS_PASS_R8toRS  C !ROUTINE: MDS_PASS_R8toRS
14  C !INTERFACE:  C !INTERFACE:
15        SUBROUTINE MDS_PASS_R8toRS( local, arr, k, nNz,        SUBROUTINE MDS_PASS_R8toRS( buffer, arrFld, nNz, kLo, kSize,
16       I                            biArg, bjArg, copyTo, myThid )       I                            biArg, bjArg, copyTo, myThid )
17    
18  C !DESCRIPTION:  C !DESCRIPTION:
19  C     Transfert 2-D real*8 array to 3-D RS array, or the reverse,  C     Transfert 3-D real*8 buffer to 3-D RS model array, or the reverse,
20  C      depending on "copyTo" value. Apply transfert to tile biArg,bjArg  C      depending on "copyTo" value. Apply transfert to tile biArg,bjArg
21  C      only or to all myThid tiles if called with biArg=bjArg=0.  C      only or to all myThid tiles if called with biArg=bjArg=0.
22    
# Line 29  C Global variables / common blocks Line 29  C Global variables / common blocks
29    
30  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
31  C Routine arguments  C Routine arguments
32  C local   (real*8) :: local 2-D array (Input/Output if copyTo=T/F)  C buffer  (real*8) :: buffer 3-D array (Input/Output if copyTo=T/F)
33  C arr     ( RS )   :: model 3-D tiled array (Output/Input if copyTo=T/F)  C arrFld   ( RS )  :: model 3-D tiled array (Output/Input if copyTo=T/F)
34  C k       (integer):: level index to - fill in / extract from - 3-D array  C nNz     (integer):: Number of levels to - fill in / extract from - arrFld
35  C nNz     (integer):: size of third dimension of 3-D array "arr"  C kLo     (integer):: 1rst level to - fill in / extract from - arrFld
36  C biArg   (integer):: tile X-index to - fill in / extract from - tiled array  C kSize   (integer):: third dimension of 3-D array "arrFld"
37  C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled array  C biArg   (integer):: tile X-index to - fill in / extract from - tiled buffer
38    C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled buffer
39  C copyTo  (logical):: if =T, copy 2-D -> 3-D ; if =F: copy 2-D <- 3-D  C copyTo  (logical):: if =T, copy 2-D -> 3-D ; if =F: copy 2-D <- 3-D
40  C myThid  (integer):: my Thread Id number  C myThid  (integer):: my Thread Id number
41        INTEGER nNz        INTEGER nNz, kSize
42        Real*8 local(1:sNx,1:sNy,nSx,nSy)        Real*8 buffer(1:sNx,1:sNy,nNz,nSx,nSy)
43        _RS    arr  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)        _RS    arrFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
44        INTEGER k        INTEGER kLo
45        INTEGER biArg        INTEGER biArg
46        INTEGER bjArg        INTEGER bjArg
47        LOGICAL copyTo        LOGICAL copyTo
48        INTEGER myThid        INTEGER myThid
49    
50  C !LOCAL VARIABLES:  C !LOCAL VARIABLES:
51  C   i,j   :: loop indices  C   i,j,k :: loop indices
52  C   bi,bj :: tile indices  C   bi,bj :: tile indices
53        INTEGER i,j,bi,bj        INTEGER i,j,k,bi,bj
54          INTEGER kLev
55  CEOP  CEOP
56    
57        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
58          IF ( copyTo ) THEN          IF ( copyTo ) THEN
59            DO bj = myByLo(myThid), myByHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
60             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
61                DO k=1,nNz
62                 kLev = kLo+k-1
63               DO j=1,sNy               DO j=1,sNy
64                DO i=1,sNx                DO i=1,sNx
65                  arr(i,j,k,bi,bj) = local(i,j,bi,bj)                  arrFld(i,j,kLev,bi,bj) = buffer(i,j,k,bi,bj)
66                ENDDO                ENDDO
67               ENDDO               ENDDO
68                ENDDO
69             ENDDO             ENDDO
70            ENDDO            ENDDO
71          ELSE          ELSE
72            DO bj = myByLo(myThid), myByHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
73             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
74                DO k=1,nNz
75                 kLev = kLo+k-1
76               DO j=1,sNy               DO j=1,sNy
77                DO i=1,sNx                DO i=1,sNx
78                  local(i,j,bi,bj) = arr(i,j,k,bi,bj)                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,bi,bj)
79                ENDDO                ENDDO
80               ENDDO               ENDDO
81                ENDDO
82             ENDDO             ENDDO
83            ENDDO            ENDDO
84          ENDIF          ENDIF
# Line 79  CEOP Line 87  CEOP
87          bi = biArg          bi = biArg
88          bj = bjArg          bj = bjArg
89          IF ( copyTo ) THEN          IF ( copyTo ) THEN
90              DO k=1,nNz
91                kLev = kLo+k-1
92              DO j=1,sNy              DO j=1,sNy
93                DO i=1,sNx                DO i=1,sNx
94                  arr(i,j,k,bi,bj) = local(i,j,1,1)                  arrFld(i,j,kLev,1,1) = buffer(i,j,k,bi,bj)
95                ENDDO                ENDDO
96              ENDDO              ENDDO
97              ENDDO
98          ELSE          ELSE
99              DO k=1,nNz
100                kLev = kLo+k-1
101              DO j=1,sNy              DO j=1,sNy
102                DO i=1,sNx                DO i=1,sNx
103                  local(i,j,1,1) = arr(i,j,k,bi,bj)                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,1,1)
104                ENDDO                ENDDO
105              ENDDO              ENDDO
106              ENDDO
107          ENDIF          ENDIF
108        ELSE        ELSE
109          STOP 'ABNORMAL END: MDS_PASS_R8toRS invalid bi,bj Arg'          STOP 'ABNORMAL END: MDS_PASS_R8toRS invalid bi,bj Arg'
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22