pkg/mdsio/mdsio_passtors.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_passtors.F,v 1.1 2005/11/03 16:06:57 jmc Exp $
C $Name:  $

#include "MDSIO_OPTIONS.h"

C     ==================================================================

      SUBROUTINE MDS_PASStoRS(local,arr,k,nNz,copyTo,myThid)

C Arguments:
C
C local         RL      local 2-D array (Input/Output if copyTo=T/F)
C arr           RS      model 3-D tiled array (Output/Input if copyTo=T/F)
C k             integer level index to fill in / to extract from 3-D array
C nNz           integer size of third dimension of 3-D array "arr"
C copyTo        logical if =T, copy 2-D -> 3-D ; if =F: copy 2-D <- 3-D
C myThid        integer thread identifier
C
C MDS_PASStoRS transfert 2-D RL array to 3-D RS array,
C              or the reverse, depending on "copyTo" value.

      IMPLICIT NONE

C Global variables / common blocks
#include "EEPARAMS.h"
#include "SIZE.h"

C Routine arguments
      INTEGER nNz
      _RL local(1:sNx,1:sNy,nSx,nSy)
      _RS arr  (1-oLx:sNx+oLx,1-oLy:sNy+oLy,nNz,nSx,nSy)
      INTEGER k
      LOGICAL copyTo
      INTEGER myThid

C Local variables
      INTEGER i,j,bi,bj

      IF ( copyTo ) THEN
        DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO j=1,sNy
              DO i=1,sNx
                arr(i,j,k,bi,bj) = local(i,j,bi,bj)
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ELSE
        DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO j=1,sNy
              DO i=1,sNx
                local(i,j,bi,bj) = arr(i,j,k,bi,bj)
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ENDIF

      RETURN
      END
1	dimitri	1.2	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_passtors.F,v 1.1 2005/11/03 16:06:57 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "MDSIO_OPTIONS.h"
5
6			C ==================================================================
7
8			SUBROUTINE MDS_PASStoRS(local,arr,k,nNz,copyTo,myThid)
9
10			C Arguments:
11			C
12			C local RL local 2-D array (Input/Output if copyTo=T/F)
13			C arr RS model 3-D tiled array (Output/Input if copyTo=T/F)
14			C k integer level index to fill in / to extract from 3-D array
15			C nNz integer size of third dimension of 3-D array "arr"
16			C copyTo logical if =T, copy 2-D -> 3-D ; if =F: copy 2-D <- 3-D
17			C myThid integer thread identifier
18			C
19			C MDS_PASStoRS transfert 2-D RL array to 3-D RS array,
20			C or the reverse, depending on "copyTo" value.
21
22			IMPLICIT NONE
23
24			C Global variables / common blocks
25			#include "EEPARAMS.h"
26			#include "SIZE.h"
27
28			C Routine arguments
29			INTEGER nNz
30	dimitri	1.2	_RL local(1:sNx,1:sNy,nSx,nSy)
31	jmc	1.1	_RS arr (1-oLx:sNx+oLx,1-oLy:sNy+oLy,nNz,nSx,nSy)
32			INTEGER k
33			LOGICAL copyTo
34			INTEGER myThid
35
36			C Local variables
37			INTEGER i,j,bi,bj
38
39			IF ( copyTo ) THEN
40			DO bj = myByLo(myThid), myByHi(myThid)
41			DO bi = myBxLo(myThid), myBxHi(myThid)
42	dimitri	1.2	DO j=1,sNy
43			DO i=1,sNx
44	jmc	1.1	arr(i,j,k,bi,bj) = local(i,j,bi,bj)
45			ENDDO
46			ENDDO
47			ENDDO
48			ENDDO
49			ELSE
50			DO bj = myByLo(myThid), myByHi(myThid)
51			DO bi = myBxLo(myThid), myBxHi(myThid)
52	dimitri	1.2	DO j=1,sNy
53			DO i=1,sNx
54	jmc	1.1	local(i,j,bi,bj) = arr(i,j,k,bi,bj)
55			ENDDO
56			ENDDO
57			ENDDO
58			ENDDO
59			ENDIF
60
61			RETURN
62			END