/[MITgcm]/MITgcm/eesupp/src/mdsio.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/mdsio.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by adcroft, Wed May 5 18:32:34 1999 UTC revision 1.2 by adcroft, Fri May 7 18:14:16 1999 UTC
# Line 176  C         stop 'MDSREADFIELD: un-active Line 176  C         stop 'MDSREADFIELD: un-active
176             endif             endif
177             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
178              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
179    #ifdef _BYTESWAPIO
180                call MDS_BYTESWAPR4( sNx, r4seg )
181    #endif
182              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
183               call MDS_SEG4toRS( j,bi,bj,k,nNz, r4seg, .TRUE., arr )               call MDS_SEG4toRS( j,bi,bj,k,nNz, r4seg, .TRUE., arr )
184              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
# Line 185  C         stop 'MDSREADFIELD: un-active Line 188  C         stop 'MDSREADFIELD: un-active
188              endif              endif
189             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
190              read(dUnit,rec=irec) r8seg              read(dUnit,rec=irec) r8seg
191    #ifdef _BYTESWAPIO
192                call MDS_BYTESWAPR8( sNx, r8seg )
193    #endif
194              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
195               call MDS_SEG8toRS( j,bi,bj,k,nNz, r8seg, .TRUE., arr )               call MDS_SEG8toRS( j,bi,bj,k,nNz, r8seg, .TRUE., arr )
196              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
# Line 370  C If we are writing to a tiled MDS file Line 376  C If we are writing to a tiled MDS file
376              else              else
377               stop 'MDSWRITEFIELD: illegal value for arrType'               stop 'MDSWRITEFIELD: illegal value for arrType'
378              endif              endif
379    #ifdef _BYTESWAPIO
380                call MDS_BYTESWAPR4( sNx, r4seg )
381    #endif
382              write(dUnit,rec=irec) r4seg              write(dUnit,rec=irec) r4seg
383             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
384              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
# Line 379  C If we are writing to a tiled MDS file Line 388  C If we are writing to a tiled MDS file
388              else              else
389               stop 'MDSWRITEFIELD: illegal value for arrType'               stop 'MDSWRITEFIELD: illegal value for arrType'
390              endif              endif
391    #ifdef _BYTESWAPIO
392                call MDS_BYTESWAPR8( sNx, r8seg )
393    #endif
394              write(dUnit,rec=irec) r8seg              write(dUnit,rec=irec) r8seg
395             else             else
396              stop 'MDSWRITEFIELD: illegal value for filePrec'              stop 'MDSWRITEFIELD: illegal value for filePrec'
# Line 1239  C     ---------------------------------- Line 1251  C     ----------------------------------
1251        return        return
1252        end        end
1253  C=======================================================================  C=======================================================================
1254    
1255    #ifdef _BYTESWAPIO
1256    C=======================================================================
1257          subroutine MDS_BYTESWAPR4( n, arr )
1258    C IN:
1259    C   n           integer - Number of 4-byte words in arr
1260    C IN/OUT:
1261    C   arr         real*4  - Array declared as real*4(n)
1262    C
1263    C Created: 05/05/99 adcroft@mit.edu (This is an unfortunate hack!!)
1264    
1265          implicit none
1266    C Arguments
1267          integer n
1268          character*(*) arr
1269    C Local
1270          integer i
1271          character*(1) cc
1272    C     ------------------------------------------------------------------
1273          do i=1,4*n,4
1274           cc=arr(i:i)
1275           arr(i:i)=arr(i+3:i+3)
1276           arr(i+3:i+3)=cc
1277           cc=arr(i+1:i+1)
1278           arr(i+1:i+1)=arr(i+2:i+2)
1279           arr(i+2:i+2)=cc
1280          enddo
1281    C     ------------------------------------------------------------------
1282          return
1283          end
1284    C=======================================================================
1285    
1286    C=======================================================================
1287          subroutine MDS_BYTESWAPR8( n, arr )
1288    C IN:
1289    C   n           integer - Number of 8-byte words in arr
1290    C IN/OUT:
1291    C   arr         real*8  - Array declared as real*4(n)
1292    C
1293    C Created: 05/05/99 adcroft@mit.edu (This is an unfortunate hack!!)
1294    
1295          implicit none
1296    C Arguments
1297          integer n
1298          character*(*) arr
1299    C Local
1300          integer i
1301          character*(1) cc
1302    C     ------------------------------------------------------------------
1303          do i=1,8*n,8
1304           cc=arr(i:i)
1305           arr(i:i)=arr(i+7:i+7)
1306           arr(i+7:i+7)=cc
1307           cc=arr(i+1:i+1)
1308           arr(i+1:i+1)=arr(i+6:i+6)
1309           arr(i+6:i+6)=cc
1310           cc=arr(i+2:i+2)
1311           arr(i+2:i+2)=arr(i+5:i+5)
1312           arr(i+5:i+5)=cc
1313           cc=arr(i+3:i+3)
1314           arr(i+3:i+3)=arr(i+4:i+4)
1315           arr(i+4:i+4)=cc
1316          enddo
1317    C     ------------------------------------------------------------------
1318          return
1319          end
1320    C=======================================================================
1321    #endif
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22