C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_segxtorx_2d.F,v 1.1 2009/09/01 19:16:51 jmc Exp $
C $Name: $
#include "MDSIO_OPTIONS.h"
C-- File mdsio_segxtorx_2d.F: Routines to pass segment to/from 2D section array
C-- Contents
C-- o MDS_SEG4toRL_2D
C-- o MDS_SEG4toRS_2D
C-- o MDS_SEG8toRL_2D
C-- o MDS_SEG8toRS_2D
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
SUBROUTINE MDS_SEG4TORL_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
C IN:
C sn,ol,nNz integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
C k,bi,bj, integer :: indices to array "arr"
C copyTo logical :: flag to indicate tranfer direction.
C .TRUE.: seg -> arr, .FALSE.: arr -> seg
C seg Real*4 :: 1-D vector of length sn
C OUT:
C arr _RL :: model vertical slice (array)
C
C Created: 06/03/00 spk@ocean.mit.edu
IMPLICIT NONE
C Global variables / common blocks
#include "SIZE.h"
C Arguments
INTEGER sn,ol,nNz,bi,bj,k
LOGICAL copyTo
Real*4 seg(sn)
_RL arr(1-ol:sn+ol,nNz,nSx,nSy)
C Local
INTEGER ii
C ------------------------------------------------------------------
IF (copyTo) THEN
DO ii=1,sn
arr(ii,k,bi,bj)=seg(ii)
ENDDO
ELSE
DO ii=1,sn
seg(ii)=arr(ii,k,bi,bj)
ENDDO
ENDIF
C ------------------------------------------------------------------
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
SUBROUTINE MDS_SEG4TORS_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
C IN:
C sn,ol,nNz integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
C k,bi,bj, integer :: indices to array "arr"
C copyTo logical :: flag to indicate tranfer direction.
C .TRUE.: seg -> arr, .FALSE.: arr -> seg
C seg Real*4 :: 1-D vector of length sn
C OUT:
C arr _RS :: model vertical slice (array)
C
C Created: 06/03/00 spk@ocean.mit.edu
IMPLICIT NONE
C Global variables / common blocks
#include "SIZE.h"
C Arguments
INTEGER sn,ol,nNz,bi,bj,k
LOGICAL copyTo
Real*4 seg(sn)
_RS arr(1-ol:sn+ol,nNz,nSx,nSy)
C Local
INTEGER ii
C ------------------------------------------------------------------
IF (copyTo) THEN
DO ii=1,sn
arr(ii,k,bi,bj)=seg(ii)
ENDDO
ELSE
DO ii=1,sn
seg(ii)=arr(ii,k,bi,bj)
ENDDO
ENDIF
C ------------------------------------------------------------------
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
SUBROUTINE MDS_SEG8TORL_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
C IN:
C sn,ol,nNz integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
C k,bi,bj, integer :: indices to array "arr"
C copyTo logical :: flag to indicate tranfer direction.
C .TRUE.: seg -> arr, .FALSE.: arr -> seg
C seg Real*8 :: 1-D vector of length sn
C OUT:
C arr _RL :: model vertical slice (array)
C
C Created: 06/03/00 spk@ocean.mit.edu
IMPLICIT NONE
C Global variables / common blocks
#include "SIZE.h"
C Arguments
INTEGER sn,ol,nNz,bi,bj,k
LOGICAL copyTo
Real*8 seg(sn)
_RL arr(1-ol:sn+ol,nNz,nSx,nSy)
C Local
INTEGER ii
C ------------------------------------------------------------------
IF (copyTo) THEN
DO ii=1,sn
arr(ii,k,bi,bj)=seg(ii)
ENDDO
ELSE
DO ii=1,sn
seg(ii)=arr(ii,k,bi,bj)
ENDDO
ENDIF
C ------------------------------------------------------------------
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
SUBROUTINE MDS_SEG8TORS_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
C IN:
C sn,ol,nNz integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
C k,bi,bj, integer :: indices to array "arr"
C copyTo logical :: flag to indicate tranfer direction.
C .TRUE.: seg -> arr, .FALSE.: arr -> seg
C seg Real*8 :: 1-D vector of length sn
C OUT:
C arr _RS :: model vertical slice (array)
C
C Created: 06/03/00 spk@ocean.mit.edu
IMPLICIT NONE
C Global variables / common blocks
#include "SIZE.h"
C Arguments
INTEGER sn,ol,nNz,bi,bj,k
LOGICAL copyTo
Real*8 seg(sn)
_RS arr(1-ol:sn+ol,nNz,nSx,nSy)
C Local
INTEGER ii
C ------------------------------------------------------------------
IF (copyTo) THEN
DO ii=1,sn
arr(ii,k,bi,bj)=seg(ii)
ENDDO
ELSE
DO ii=1,sn
seg(ii)=arr(ii,k,bi,bj)
ENDDO
ENDIF
C ------------------------------------------------------------------
RETURN
END