Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:41:55 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
9c019881ee Jean*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 C--  File mdsio_segxtorx_2d.F: Routines to pass segment to/from 2D section array
                0004 C--   Contents
                0005 C--   o MDS_SEG4toRL_2D
                0006 C--   o MDS_SEG4toRS_2D
                0007 C--   o MDS_SEG8toRL_2D
                0008 C--   o MDS_SEG8toRS_2D
                0009 
                0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0011 
                0012       SUBROUTINE MDS_SEG4toRL_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
                0013 
                0014 C IN:
                0015 C     sn,ol,nNz  integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
                0016 C     k,bi,bj,   integer :: indices to array "arr"
                0017 C     copyTo     logical :: flag to indicate tranfer direction.
                0018 C                           .TRUE.: seg -> arr, .FALSE.: arr -> seg
                0019 C     seg        Real*4  :: 1-D vector of length sn
                0020 C OUT:
                0021 C     arr         _RL    :: model vertical slice (array)
                0022 C
                0023 C Created: 06/03/00 spk@ocean.mit.edu
                0024 
                0025       IMPLICIT NONE
                0026 C Global variables / common blocks
                0027 #include "SIZE.h"
                0028 
                0029 C Arguments
                0030       INTEGER sn,ol,nNz,bi,bj,k
                0031       LOGICAL copyTo
                0032       Real*4 seg(sn)
                0033       _RL arr(1-ol:sn+ol,nNz,nSx,nSy)
                0034 
                0035 C Local
                0036       INTEGER ii
                0037 C     ------------------------------------------------------------------
                0038       IF (copyTo) THEN
                0039        DO ii=1,sn
                0040         arr(ii,k,bi,bj)=seg(ii)
                0041        ENDDO
                0042       ELSE
                0043        DO ii=1,sn
                0044         seg(ii)=arr(ii,k,bi,bj)
                0045        ENDDO
                0046       ENDIF
                0047 C     ------------------------------------------------------------------
                0048       RETURN
                0049       END
                0050 
                0051 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0052 
                0053       SUBROUTINE MDS_SEG4toRS_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
                0054 
                0055 C IN:
                0056 C     sn,ol,nNz  integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
                0057 C     k,bi,bj,   integer :: indices to array "arr"
                0058 C     copyTo     logical :: flag to indicate tranfer direction.
                0059 C                           .TRUE.: seg -> arr, .FALSE.: arr -> seg
                0060 C     seg        Real*4  :: 1-D vector of length sn
                0061 C OUT:
                0062 C     arr         _RS    :: model vertical slice (array)
                0063 C
                0064 C Created: 06/03/00 spk@ocean.mit.edu
                0065 
                0066       IMPLICIT NONE
                0067 C Global variables / common blocks
                0068 #include "SIZE.h"
                0069 
                0070 C Arguments
                0071       INTEGER sn,ol,nNz,bi,bj,k
                0072       LOGICAL copyTo
                0073       Real*4 seg(sn)
                0074       _RS arr(1-ol:sn+ol,nNz,nSx,nSy)
                0075 
                0076 C Local
                0077       INTEGER ii
                0078 C     ------------------------------------------------------------------
                0079       IF (copyTo) THEN
                0080        DO ii=1,sn
                0081         arr(ii,k,bi,bj)=seg(ii)
                0082        ENDDO
                0083       ELSE
                0084        DO ii=1,sn
                0085         seg(ii)=arr(ii,k,bi,bj)
                0086        ENDDO
                0087       ENDIF
                0088 C     ------------------------------------------------------------------
                0089       RETURN
                0090       END
                0091 
                0092 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0093 
                0094       SUBROUTINE MDS_SEG8toRL_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
                0095 
                0096 C IN:
                0097 C     sn,ol,nNz  integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
                0098 C     k,bi,bj,   integer :: indices to array "arr"
                0099 C     copyTo     logical :: flag to indicate tranfer direction.
                0100 C                           .TRUE.: seg -> arr, .FALSE.: arr -> seg
                0101 C     seg        Real*8  :: 1-D vector of length sn
                0102 C OUT:
                0103 C     arr         _RL    :: model vertical slice (array)
                0104 C
                0105 C Created: 06/03/00 spk@ocean.mit.edu
                0106 
                0107       IMPLICIT NONE
                0108 C Global variables / common blocks
                0109 #include "SIZE.h"
                0110 
                0111 C Arguments
                0112       INTEGER sn,ol,nNz,bi,bj,k
                0113       LOGICAL copyTo
                0114       Real*8 seg(sn)
                0115       _RL arr(1-ol:sn+ol,nNz,nSx,nSy)
                0116 
                0117 C Local
                0118       INTEGER ii
                0119 C     ------------------------------------------------------------------
                0120       IF (copyTo) THEN
                0121        DO ii=1,sn
                0122         arr(ii,k,bi,bj)=seg(ii)
                0123        ENDDO
                0124       ELSE
                0125        DO ii=1,sn
                0126         seg(ii)=arr(ii,k,bi,bj)
                0127        ENDDO
                0128       ENDIF
                0129 C     ------------------------------------------------------------------
                0130       RETURN
                0131       END
                0132 
                0133 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0134 
                0135       SUBROUTINE MDS_SEG8toRS_2D(sn,ol,nNz,bi,bj,k,copyTo,seg,arr)
                0136 
                0137 C IN:
                0138 C     sn,ol,nNz  integer :: size of 'arr'. sn,ol can be sNx,oLx OR sNy,oLy
                0139 C     k,bi,bj,   integer :: indices to array "arr"
                0140 C     copyTo     logical :: flag to indicate tranfer direction.
                0141 C                           .TRUE.: seg -> arr, .FALSE.: arr -> seg
                0142 C     seg        Real*8  :: 1-D vector of length sn
                0143 C OUT:
                0144 C     arr         _RS    :: model vertical slice (array)
                0145 C
                0146 C Created: 06/03/00 spk@ocean.mit.edu
                0147 
                0148       IMPLICIT NONE
                0149 C Global variables / common blocks
                0150 #include "SIZE.h"
                0151 
                0152 C Arguments
                0153       INTEGER sn,ol,nNz,bi,bj,k
                0154       LOGICAL copyTo
                0155       Real*8 seg(sn)
                0156       _RS arr(1-ol:sn+ol,nNz,nSx,nSy)
                0157 
                0158 C Local
                0159       INTEGER ii
                0160 C     ------------------------------------------------------------------
                0161       IF (copyTo) THEN
                0162        DO ii=1,sn
                0163         arr(ii,k,bi,bj)=seg(ii)
                0164        ENDDO
                0165       ELSE
                0166        DO ii=1,sn
                0167         seg(ii)=arr(ii,k,bi,bj)
                0168        ENDDO
                0169       ENDIF
                0170 C     ------------------------------------------------------------------
                0171       RETURN
                0172       END