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

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

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

revision 1.3 by jmc, Mon Jun 8 03:32:33 2009 UTC revision 1.4 by jmc, Thu Dec 23 02:40:42 2010 UTC
# Line 12  C---+----1----+----2----+----3----+----4 Line 12  C---+----1----+----2----+----3----+----4
12  CBOP  CBOP
13  C !ROUTINE: MDS_PASS_R4toRL  C !ROUTINE: MDS_PASS_R4toRL
14  C !INTERFACE:  C !INTERFACE:
15        SUBROUTINE MDS_PASS_R4toRL( buffer, arrFld, nNz, kLo, kSize,        SUBROUTINE MDS_PASS_R4toRL(
16         U                            buffer, arrFld,
17         I                            oLi, oLj, nNz, kLo, kSize,
18       I                            biArg, bjArg, copyTo, myThid )       I                            biArg, bjArg, copyTo, myThid )
19    
20  C !DESCRIPTION:  C !DESCRIPTION:
# Line 31  C     !INPUT/OUTPUT PARAMETERS: Line 33  C     !INPUT/OUTPUT PARAMETERS:
33  C Routine arguments  C Routine arguments
34  C buffer  (real*4) :: buffer 3-D array (Input/Output if copyTo=T/F)  C buffer  (real*4) :: buffer 3-D array (Input/Output if copyTo=T/F)
35  C arrFld   ( RL )  :: model 3-D tiled array (Output/Input if copyTo=T/F)  C arrFld   ( RL )  :: model 3-D tiled array (Output/Input if copyTo=T/F)
36    C oLi     (integer):: Overlap size (dim-1) of buffer to copy - to/from - arrFld
37    C oLj     (integer):: Overlap size (dim-2) of buffer to copy - to/from - arrFld
38  C nNz     (integer):: Number of levels to - fill in / extract from - arrFld  C nNz     (integer):: Number of levels to - fill in / extract from - arrFld
39  C kLo     (integer):: 1rst level to - fill in / extract from - arrFld  C kLo     (integer):: 1rst level to - fill in / extract from - arrFld
40  C kSize   (integer):: third dimension of 3-D array "arrFld"  C kSize   (integer):: third dimension of 3-D array "arrFld"
# Line 38  C biArg   (integer):: tile X-index to - Line 42  C biArg   (integer):: tile X-index to -
42  C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled buffer  C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled buffer
43  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
44  C myThid  (integer):: my Thread Id number  C myThid  (integer):: my Thread Id number
45          INTEGER oLi, oLj
46        INTEGER nNz, kSize        INTEGER nNz, kSize
47        Real*4 buffer(1:sNx,1:sNy,nNz,nSx,nSy)        Real*4 buffer(1-oLi:sNx+oLi,1-oLj:sNy+oLj,nNz,nSx,nSy)
48        _RL    arrFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)        _RL    arrFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
49        INTEGER kLo        INTEGER kLo
50        INTEGER biArg        INTEGER biArg
# Line 53  C   bi,bj :: tile indices Line 58  C   bi,bj :: tile indices
58        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
59        INTEGER kLev        INTEGER kLev
60  CEOP  CEOP
61          IF ( oLi.LT.0 .OR. oLi.GT.OLx .OR.
62         &     oLj.LT.0 .OR. oLj.GT.OLy ) THEN
63            STOP 'ABNORMAL END: MDS_PASS_R4toRL invalid oLi,oLj Arg'
64          ENDIF
65    
66        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
67          IF ( copyTo ) THEN          IF ( copyTo ) THEN
# Line 60  CEOP Line 69  CEOP
69             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
70              DO k=1,nNz              DO k=1,nNz
71               kLev = kLo+k-1               kLev = kLo+k-1
72               DO j=1,sNy               DO j=1-oLj,sNy+oLj
73                DO i=1,sNx                DO i=1-oLi,sNx+oLi
74                  arrFld(i,j,kLev,bi,bj) = buffer(i,j,k,bi,bj)                  arrFld(i,j,kLev,bi,bj) = buffer(i,j,k,bi,bj)
75                ENDDO                ENDDO
76               ENDDO               ENDDO
# Line 73  CEOP Line 82  CEOP
82             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
83              DO k=1,nNz              DO k=1,nNz
84               kLev = kLo+k-1               kLev = kLo+k-1
85               DO j=1,sNy               DO j=1-oLj,sNy+oLj
86                DO i=1,sNx                DO i=1-oLi,sNx+oLi
87                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,bi,bj)                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,bi,bj)
88                ENDDO                ENDDO
89               ENDDO               ENDDO
# Line 89  CEOP Line 98  CEOP
98          IF ( copyTo ) THEN          IF ( copyTo ) THEN
99            DO k=1,nNz            DO k=1,nNz
100              kLev = kLo+k-1              kLev = kLo+k-1
101              DO j=1,sNy              DO j=1-oLj,sNy+oLj
102                DO i=1,sNx                DO i=1-oLi,sNx+oLi
103                  arrFld(i,j,kLev,1,1) = buffer(i,j,k,bi,bj)                  arrFld(i,j,kLev,1,1) = buffer(i,j,k,bi,bj)
104                ENDDO                ENDDO
105              ENDDO              ENDDO
# Line 98  CEOP Line 107  CEOP
107          ELSE          ELSE
108            DO k=1,nNz            DO k=1,nNz
109              kLev = kLo+k-1              kLev = kLo+k-1
110              DO j=1,sNy              DO j=1-oLj,sNy+oLj
111                DO i=1,sNx                DO i=1-oLi,sNx+oLi
112                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,1,1)                  buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,1,1)
113                ENDDO                ENDDO
114              ENDDO              ENDDO
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22