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

Diff of /MITgcm/pkg/mdsio/mdsio_pass_r8torl.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.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_R8toRL  C !ROUTINE: MDS_PASS_R8toRL
14  C !INTERFACE:  C !INTERFACE:
15        SUBROUTINE MDS_PASS_R8toRL( local, arr, k, nNz,        SUBROUTINE MDS_PASS_R8toRL(
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:
21  C     Transfert 2-D real*8 array to 3-D RL array, or the reverse,  C     Transfert 3-D real*8 buffer to 3-D RL model array, or the reverse,
22  C      depending on "copyTo" value. Apply transfert to tile biArg,bjArg  C      depending on "copyTo" value. Apply transfert to tile biArg,bjArg
23  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.
24    
# Line 29  C Global variables / common blocks Line 31  C Global variables / common blocks
31    
32  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
33  C Routine arguments  C Routine arguments
34  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)
35  C arr     ( 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 k       (integer):: level index to - fill in / extract from - 3-D array  C oLi     (integer):: Overlap size (dim-1) of buffer to copy - to/from - arrFld
37  C nNz     (integer):: size of third dimension of 3-D array "arr"  C oLj     (integer):: Overlap size (dim-2) of buffer to copy - to/from - arrFld
38  C biArg   (integer):: tile X-index to - fill in / extract from - tiled array  C nNz     (integer):: Number of levels to - fill in / extract from - arrFld
39  C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled array  C kLo     (integer):: 1rst level to - fill in / extract from - arrFld
40    C kSize   (integer):: third dimension of 3-D array "arrFld"
41    C biArg   (integer):: tile X-index to - fill in / extract from - tiled buffer
42    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 nNz        INTEGER oLi, oLj
46        Real*8 local(1:sNx,1:sNy,nSx,nSy)        INTEGER nNz, kSize
47        _RL    arr  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)        Real*8 buffer(1-oLi:sNx+oLi,1-oLj:sNy+oLj,nNz,nSx,nSy)
48        INTEGER k        _RL    arrFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
49          INTEGER kLo
50        INTEGER biArg        INTEGER biArg
51        INTEGER bjArg        INTEGER bjArg
52        LOGICAL copyTo        LOGICAL copyTo
53        INTEGER myThid        INTEGER myThid
54    
55  C !LOCAL VARIABLES:  C !LOCAL VARIABLES:
56  C   i,j   :: loop indices  C   i,j,k :: loop indices
57  C   bi,bj :: tile indices  C   bi,bj :: tile indices
58        INTEGER i,j,bi,bj        INTEGER i,j,k,bi,bj
59          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_R8toRL 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
68            DO bj = myByLo(myThid), myByHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
69             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
70               DO j=1,sNy              DO k=1,nNz
71                DO i=1,sNx               kLev = kLo+k-1
72                  arr(i,j,k,bi,bj) = local(i,j,bi,bj)               DO j=1-oLj,sNy+oLj
73                  DO i=1-oLi,sNx+oLi
74                    arrFld(i,j,kLev,bi,bj) = buffer(i,j,k,bi,bj)
75                ENDDO                ENDDO
76               ENDDO               ENDDO
77                ENDDO
78             ENDDO             ENDDO
79            ENDDO            ENDDO
80          ELSE          ELSE
81            DO bj = myByLo(myThid), myByHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
82             DO bi = myBxLo(myThid), myBxHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
83               DO j=1,sNy              DO k=1,nNz
84                DO i=1,sNx               kLev = kLo+k-1
85                  local(i,j,bi,bj) = arr(i,j,k,bi,bj)               DO j=1-oLj,sNy+oLj
86                  DO i=1-oLi,sNx+oLi
87                    buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,bi,bj)
88                ENDDO                ENDDO
89               ENDDO               ENDDO
90                ENDDO
91             ENDDO             ENDDO
92            ENDDO            ENDDO
93          ENDIF          ENDIF
# Line 79  CEOP Line 96  CEOP
96          bi = biArg          bi = biArg
97          bj = bjArg          bj = bjArg
98          IF ( copyTo ) THEN          IF ( copyTo ) THEN
99              DO j=1,sNy            DO k=1,nNz
100                DO i=1,sNx              kLev = kLo+k-1
101                  arr(i,j,k,bi,bj) = local(i,j,1,1)              DO j=1-oLj,sNy+oLj
102                  DO i=1-oLi,sNx+oLi
103                    arrFld(i,j,kLev,1,1) = buffer(i,j,k,bi,bj)
104                ENDDO                ENDDO
105              ENDDO              ENDDO
106              ENDDO
107          ELSE          ELSE
108              DO j=1,sNy            DO k=1,nNz
109                DO i=1,sNx              kLev = kLo+k-1
110                  local(i,j,1,1) = arr(i,j,k,bi,bj)              DO j=1-oLj,sNy+oLj
111                  DO i=1-oLi,sNx+oLi
112                    buffer(i,j,k,bi,bj) = arrFld(i,j,kLev,1,1)
113                ENDDO                ENDDO
114              ENDDO              ENDDO
115              ENDDO
116          ENDIF          ENDIF
117        ELSE        ELSE
118          STOP 'ABNORMAL END: MDS_PASS_R8toRL invalid bi,bj Arg'          STOP 'ABNORMAL END: MDS_PASS_R8toRL invalid bi,bj Arg'
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22