|
||||
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 UTC9c019881ee 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
[ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |