/[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.1 by jmc, Mon May 11 02:20:49 2009 UTC revision 1.2 by jmc, Mon Jun 1 14:20:31 2009 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(local,arr,k,nNz,copyTo,myThid)        SUBROUTINE MDS_PASS_R4toRL( local, arr, k, nNz,
16         I                            biArg, bjArg, copyTo, myThid )
17    
18  C !DESCRIPTION:  C !DESCRIPTION:
19  C     Transfert 2-D real*4 array to 3-D RL array,  C     Transfert 2-D real*4 array to 3-D RL array, or the reverse,
20  C     or the reverse, depending on "copyTo" value.  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.
22    
23  C     !USES:  C     !USES:
24        IMPLICIT NONE        IMPLICIT NONE
# Line 29  C     !INPUT/OUTPUT PARAMETERS: Line 31  C     !INPUT/OUTPUT PARAMETERS:
31  C Routine arguments  C Routine arguments
32  C local   (real*4) :: local 2-D array (Input/Output if copyTo=T/F)  C local   (real*4) :: local 2-D array (Input/Output if copyTo=T/F)
33  C arr     ( RL )   :: model 3-D tiled array (Output/Input if copyTo=T/F)  C arr     ( RL )   :: model 3-D tiled array (Output/Input if copyTo=T/F)
34  C k       (integer):: level index to fill in / to extract from 3-D array  C k       (integer):: level index to - fill in / extract from - 3-D array
35  C nNz     (integer):: size of third dimension of 3-D array "arr"  C nNz     (integer):: size of third dimension of 3-D array "arr"
36    C biArg   (integer):: tile X-index to - fill in / extract from - tiled array
37    C bjArg   (integer):: tile Y-index to - fill in / extract from - tiled array
38  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
39  C myThid  (integer):: my Thread Id number  C myThid  (integer):: my Thread Id number
40        INTEGER nNz        INTEGER nNz
41        Real*4 local(1:sNx,1:sNy,nSx,nSy)        Real*4 local(1:sNx,1:sNy,nSx,nSy)
42        _RL    arr  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)        _RL    arr  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
43        INTEGER k        INTEGER k
44          INTEGER biArg
45          INTEGER bjArg
46        LOGICAL copyTo        LOGICAL copyTo
47        INTEGER myThid        INTEGER myThid
48    
# Line 46  C   bi,bj :: tile indices Line 52  C   bi,bj :: tile indices
52        INTEGER i,j,bi,bj        INTEGER i,j,bi,bj
53  CEOP  CEOP
54    
55        IF ( copyTo ) THEN        IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
56          DO bj = myByLo(myThid), myByHi(myThid)          IF ( copyTo ) THEN
57            DO bi = myBxLo(myThid), myBxHi(myThid)            DO bj = myByLo(myThid), myByHi(myThid)
58              DO j=1,sNy             DO bi = myBxLo(myThid), myBxHi(myThid)
59                 DO j=1,sNy
60                DO i=1,sNx                DO i=1,sNx
61                  arr(i,j,k,bi,bj) = local(i,j,bi,bj)                  arr(i,j,k,bi,bj) = local(i,j,bi,bj)
62                ENDDO                ENDDO
63              ENDDO               ENDDO
64               ENDDO
65            ENDDO            ENDDO
66          ENDDO          ELSE
67        ELSE            DO bj = myByLo(myThid), myByHi(myThid)
68          DO bj = myByLo(myThid), myByHi(myThid)             DO bi = myBxLo(myThid), myBxHi(myThid)
69            DO bi = myBxLo(myThid), myBxHi(myThid)               DO j=1,sNy
             DO j=1,sNy  
70                DO i=1,sNx                DO i=1,sNx
71                  local(i,j,bi,bj) = arr(i,j,k,bi,bj)                  local(i,j,bi,bj) = arr(i,j,k,bi,bj)
72                ENDDO                ENDDO
73              ENDDO               ENDDO
74               ENDDO
75            ENDDO            ENDDO
76          ENDDO          ENDIF
77          ELSEIF ( biArg.GE.1 .AND. biArg.LE.nSx
78         &   .AND. bjArg.GE.1 .AND. bjArg.LE.nSy ) THEN
79            bi = biArg
80            bj = bjArg
81            IF ( copyTo ) THEN
82                DO j=1,sNy
83                  DO i=1,sNx
84                    arr(i,j,k,bi,bj) = local(i,j,1,1)
85                  ENDDO
86                ENDDO
87            ELSE
88                DO j=1,sNy
89                  DO i=1,sNx
90                    local(i,j,1,1) = arr(i,j,k,bi,bj)
91                  ENDDO
92                ENDDO
93            ENDIF
94          ELSE
95            STOP 'ABNORMAL END: MDS_PASS_R4toRL invalid bi,bj Arg'
96        ENDIF        ENDIF
97    
98        RETURN        RETURN
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22