/[MITgcm]/MITgcm/pkg/mdsio/mdsio_slice_loc.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_slice_loc.F

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

revision 1.2.2.1 by adcroft, Thu Oct 2 18:18:33 2003 UTC revision 1.11 by jmc, Tue Sep 1 19:16:51 2009 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
# Line 24  C myThid       integer thread identifier Line 25  C myThid       integer thread identifier
25  C  C
26  C MDSREADFIELD first checks to see if the file "fName" exists, then  C MDSREADFIELD first checks to see if the file "fName" exists, then
27  C if the file "fName.data" exists and finally the tiled files of the  C if the file "fName.data" exists and finally the tiled files of the
28  C form "fName.xxx.yyy.data" exist.  C form "fName.xxx.yyy.data" exist.
29  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
30  C to floatPrec32 or floatPrec64. The precision or declaration of  C to floatPrec32 or floatPrec64. The precision or declaration of
31  C the array argument must be consistently described by the char*(2)  C the array argument must be consistently described by the char*(2)
32  C string arrType, either "RS" or "RL".  C string arrType, either "RS" or "RL".
33  C This routine reads vertical slices (X-Z) including the overlap region.  C This routine reads vertical slices (X-Z) including the overlap region.
34  C irecord is the record number to be read and must be >= 1.  C irecord is the record number to be read and must be >= 1.
35  C The file data is stored in arr *but* the overlaps are *not* updated.  C The file data is stored in arr *but* the overlaps are *not* updated.
36  C  C
37  C Created: 06/03/00 spk@ocean.mit.edu  C Created: 06/03/00 spk@ocean.mit.edu
38  C  C
39    
40        implicit none        implicit none
41  C Global variables / common blocks  C Global variables / common blocks
# Line 47  C Routine arguments Line 48  C Routine arguments
48        integer filePrec        integer filePrec
49        character*(2) arrType        character*(2) arrType
50        integer nNz        integer nNz
51        Real arr(*)        _RL  arr(*)
52        integer irecord        integer irecord
53        integer myThid        integer myThid
54  C Functions  C Functions
55        integer ILNBLNK        integer ILNBLNK
56        integer MDS_RECLEN        integer MDS_RECLEN
57  C Local variables  C Local variables
58        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
59        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
60        logical exst        logical exst
61        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 89  C Assign a free unit number as the I/O c Line 90  C Assign a free unit number as the I/O c
90    
91  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
92        dataFName = fName        dataFName = fName
93        inquire( file=dataFname, exist=exst )        inquire( file=dataFName, exist=exst )
94        if (exst) then        if (exst) then
95         if ( debugLevel .GE. debLevA ) then         if ( debugLevel .GE. debLevA ) then
96          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
97       &   ' MDSREADFIELDXZ: opening global file: ',dataFName       &   ' MDSREADFIELDXZ: opening global file: ',dataFName(1:IL)
98          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
99       &                     SQUEEZE_RIGHT , mythid)       &                     SQUEEZE_RIGHT , mythid)
100         endif         endif
# Line 102  C Check first for global file with simpl Line 103  C Check first for global file with simpl
103    
104  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
105        if (.NOT. globalFile) then        if (.NOT. globalFile) then
106         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFName,'(2a)') fName(1:IL),'.data'
107         inquire( file=dataFname, exist=exst )         inquire( file=dataFName, exist=exst )
108         if (exst) then         if (exst) then
109          if ( debugLevel .GE. debLevA ) then          if ( debugLevel .GE. debLevA ) then
110           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
111       &    ' MDSREADFIELDXZ: opening global file: ',dataFName       &    ' MDSREADFIELDXZ: opening global file: ',dataFName(1:IL+5)
112           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
113       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
114          endif          endif
# Line 130  C If we are reading from a tiled MDS fil Line 131  C If we are reading from a tiled MDS fil
131          if (.NOT. globalFile) then          if (.NOT. globalFile) then
132           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
133           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
134           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFName,'(2a,i3.3,a,i3.3,a)')
135       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
136           inquire( file=dataFname, exist=exst )           inquire( file=dataFName, exist=exst )
137  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
138  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
139           if (exst) then           if (exst) then
140            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
141             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
142       &      ' MDSREADFIELDXZ: opening file: ',dataFName       &      ' MDSREADFIELDXZ: opening file: ',dataFName(1:IL+13)
143             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
144       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
145            endif            endif
# Line 149  C (This is a place-holder for the active Line 150  C (This is a place-holder for the active
150           else           else
151            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
152            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
153       &      ' MDSREADFIELDXZ: filename: ',dataFName       &      ' MDSREADFIELDXZ: filename: ',dataFName(1:IL+13)
154            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
155       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
156            write(msgbuf,'(a)')            write(msgbuf,'(a)')
# Line 164  C (This is a place-holder for the active Line 165  C (This is a place-holder for the active
165             if (globalFile) then             if (globalFile) then
166              iG = myXGlobalLo-1 + (bi-1)*sNx              iG = myXGlobalLo-1 + (bi-1)*sNx
167              jG = (myYGlobalLo-1)/sNy + (bj-1)              jG = (myYGlobalLo-1)/sNy + (bj-1)
168              irec=1 + INT(iG/sNx) + nSx*nPx*jG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(iG/sNx) + nSx*nPx*(k-1)
169       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSx*nPx*nNz*(irecord-1)
170             else             else
171              iG = 0              iG = 0
172              jG = 0              jG = 0
# Line 253  C myThid       integer thread identifier Line 254  C myThid       integer thread identifier
254  C  C
255  C MDSREADFIELD first checks to see if the file "fName" exists, then  C MDSREADFIELD first checks to see if the file "fName" exists, then
256  C if the file "fName.data" exists and finally the tiled files of the  C if the file "fName.data" exists and finally the tiled files of the
257  C form "fName.xxx.yyy.data" exist.  C form "fName.xxx.yyy.data" exist.
258  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
259  C to floatPrec32 or floatPrec64. The precision or declaration of  C to floatPrec32 or floatPrec64. The precision or declaration of
260  C the array argument must be consistently described by the char*(2)  C the array argument must be consistently described by the char*(2)
261  C string arrType, either "RS" or "RL".  C string arrType, either "RS" or "RL".
262  C This routine reads vertical slices (Y-Z) including overlap regions.  C This routine reads vertical slices (Y-Z) including overlap regions.
263  C irecord is the record number to be read and must be >= 1.  C irecord is the record number to be read and must be >= 1.
264  C The file data is stored in arr *but* the overlaps are *not* updated.  C The file data is stored in arr *but* the overlaps are *not* updated.
265  C  C
266  C Created: 06/03/00 spk@ocean.mit.edu  C Created: 06/03/00 spk@ocean.mit.edu
267  C  C
268    
269        implicit none        implicit none
270  C Global variables / common blocks  C Global variables / common blocks
# Line 276  C Routine arguments Line 277  C Routine arguments
277        integer filePrec        integer filePrec
278        character*(2) arrType        character*(2) arrType
279        integer nNz        integer nNz
280        Real arr(*)        _RL  arr(*)
281        integer irecord        integer irecord
282        integer myThid        integer myThid
283  C Functions  C Functions
284        integer ILNBLNK        integer ILNBLNK
285        integer MDS_RECLEN        integer MDS_RECLEN
286  C Local variables  C Local variables
287        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
288        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
289        logical exst        logical exst
290        Real*4 r4seg(sNy)        Real*4 r4seg(sNy)
# Line 318  C Assign a free unit number as the I/O c Line 319  C Assign a free unit number as the I/O c
319    
320  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
321        dataFName = fName        dataFName = fName
322        inquire( file=dataFname, exist=exst )        inquire( file=dataFName, exist=exst )
323        if (exst) then        if (exst) then
324         if ( debugLevel .GE. debLevA ) then         if ( debugLevel .GE. debLevA ) then
325          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
326       &   ' MDSREADFIELDYZ: opening global file: ',dataFName       &   ' MDSREADFIELDYZ: opening global file: ',dataFName(1:IL)
327          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
328       &                     SQUEEZE_RIGHT , mythid)       &                     SQUEEZE_RIGHT , mythid)
329         endif         endif
# Line 331  C Check first for global file with simpl Line 332  C Check first for global file with simpl
332    
333  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
334        if (.NOT. globalFile) then        if (.NOT. globalFile) then
335         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFName,'(2a)') fName(1:IL),'.data'
336         inquire( file=dataFname, exist=exst )         inquire( file=dataFName, exist=exst )
337         if (exst) then         if (exst) then
338          if ( debugLevel .GE. debLevA ) then          if ( debugLevel .GE. debLevA ) then
339           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
340       &    ' MDSREADFIELDYZ: opening global file: ',dataFName       &    ' MDSREADFIELDYZ: opening global file: ',dataFName(1:IL+5)
341           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
342       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
343          endif          endif
# Line 359  C If we are reading from a tiled MDS fil Line 360  C If we are reading from a tiled MDS fil
360          if (.NOT. globalFile) then          if (.NOT. globalFile) then
361           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
362           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
363           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFName,'(2a,i3.3,a,i3.3,a)')
364       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
365           inquire( file=dataFname, exist=exst )           inquire( file=dataFName, exist=exst )
366  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
367  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
368           if (exst) then           if (exst) then
369            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
370             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
371       &      ' MDSREADFIELDYZ: opening file: ',dataFName       &      ' MDSREADFIELDYZ: opening file: ',dataFName(1:IL+13)
372             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
373       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
374            endif            endif
# Line 378  C (This is a place-holder for the active Line 379  C (This is a place-holder for the active
379           else           else
380            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
381            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
382       &      ' MDSREADFIELDYZ: filename: ',dataFName       &      ' MDSREADFIELDYZ: filename: ',dataFName(1:IL+13)
383            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
384       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
385            write(msgbuf,'(a)')            write(msgbuf,'(a)')
# Line 393  C (This is a place-holder for the active Line 394  C (This is a place-holder for the active
394             if (globalFile) then             if (globalFile) then
395              iG = (myXGlobalLo-1)/sNx + (bi-1)              iG = (myXGlobalLo-1)/sNx + (bi-1)
396              jG = myYGlobalLo-1 + (bj-1)*sNy              jG = myYGlobalLo-1 + (bj-1)*sNy
397              irec=1 + INT(jG/sNy) + nSy*nPy*iG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(jG/sNy) + nSy*nPy*(k-1)
398       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSy*nPy*nNz*(irecord-1)
399             else             else
400              iG = 0              iG = 0
401              jG = 0              jG = 0
# Line 484  C irecord      integer record number to read Line 485  C irecord      integer record number to read
485  C myIter        integer time step number  C myIter        integer time step number
486  C myThid        integer thread identifier  C myThid        integer thread identifier
487  C  C
488  C MDSWRITEFIELDXZ creates either a file of the form "fName.data"    C MDSWRITEFIELDXZ creates either a file of the form "fName.data"
489  C if the logical flag "globalFile" is set true. Otherwise  C if the logical flag "globalFile" is set true. Otherwise
490  C it creates MDS tiled files of the form "fName.xxx.yyy.data".  C it creates MDS tiled files of the form "fName.xxx.yyy.data".
491  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
# Line 492  C to floatPrec32 or floatPrec64. The pre Line 493  C to floatPrec32 or floatPrec64. The pre
493  C the array argument must be consistently described by the char*(2)  C the array argument must be consistently described by the char*(2)
494  C string arrType, either "RS" or "RL".  C string arrType, either "RS" or "RL".
495  C This routine writes vertical slices (X-Z) including overlap regions.  C This routine writes vertical slices (X-Z) including overlap regions.
496  C irecord is the record number to be read and must be >= 1.  C irecord is the record number to be read and must be >= 1.
497  C NOTE: It is currently assumed that  C NOTE: It is currently assumed that
498  C the highest record number in the file was the last record written.  C the highest record number in the file was the last record written.
499  C  C
# Line 510  C Routine arguments Line 511  C Routine arguments
511        logical globalFile        logical globalFile
512        character*(2) arrType        character*(2) arrType
513        integer nNz        integer nNz
514        Real arr(*)        _RL  arr(*)
515        integer irecord        integer irecord
516        integer myIter        integer myIter
517        integer myThid        integer myThid
# Line 518  C Functions Line 519  C Functions
519        integer ILNBLNK        integer ILNBLNK
520        integer MDS_RECLEN        integer MDS_RECLEN
521  C Local variables  C Local variables
522        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
523        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
524        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
525        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 551  C Assign a free unit number as the I/O c Line 552  C Assign a free unit number as the I/O c
552    
553  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
554        if (globalFile) then        if (globalFile) then
555         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFName,'(2a)') fName(1:IL),'.data'
556         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
557          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
558          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 572  C If we are writing to a tiled MDS file Line 573  C If we are writing to a tiled MDS file
573          if (.NOT. globalFile) then          if (.NOT. globalFile) then
574           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
575           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
576           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFName,'(2a,i3.3,a,i3.3,a)')
577       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
578           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
579            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 591  C If we are writing to a tiled MDS file Line 592  C If we are writing to a tiled MDS file
592             if (globalFile) then             if (globalFile) then
593              iG = myXGlobalLo-1 + (bi-1)*sNx              iG = myXGlobalLo-1 + (bi-1)*sNx
594              jG = (myYGlobalLo-1)/sNy + (bj-1)              jG = (myYGlobalLo-1)/sNy + (bj-1)
595              irec=1 + INT(iG/sNx) + nSx*nPx*jG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(iG/sNx) + nSx*nPx*(k-1)
596       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSx*nPx*nNz*(irecord-1)
597             else             else
598              iG = 0              iG = 0
599              jG = 0              jG = 0
# Line 623  C If we are writing to a tiled MDS file Line 624  C If we are writing to a tiled MDS file
624       &         ' MDSWRITEFIELDXZ: illegal value for arrType'       &         ' MDSWRITEFIELDXZ: illegal value for arrType'
625               call print_error( msgbuf, mythid )               call print_error( msgbuf, mythid )
626               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'
627              endif                            endif
628  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
629              call MDS_BYTESWAPR8( sNx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
630  #endif  #endif
# Line 692  C irecord      integer record number to read Line 693  C irecord      integer record number to read
693  C myIter        integer time step number  C myIter        integer time step number
694  C myThid        integer thread identifier  C myThid        integer thread identifier
695  C  C
696  C MDSWRITEFIELDYZ creates either a file of the form "fName.data"    C MDSWRITEFIELDYZ creates either a file of the form "fName.data"
697  C if the logical flag "globalFile" is set true. Otherwise  C if the logical flag "globalFile" is set true. Otherwise
698  C it creates MDS tiled files of the form "fName.xxx.yyy.data".  C it creates MDS tiled files of the form "fName.xxx.yyy.data".
699  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
# Line 700  C to floatPrec32 or floatPrec64. The pre Line 701  C to floatPrec32 or floatPrec64. The pre
701  C the array argument must be consistently described by the char*(2)  C the array argument must be consistently described by the char*(2)
702  C string arrType, either "RS" or "RL".  C string arrType, either "RS" or "RL".
703  C This routine writes vertical slices (Y-Z) including overlap regions.  C This routine writes vertical slices (Y-Z) including overlap regions.
704  C irecord is the record number to be read and must be >= 1.  C irecord is the record number to be read and must be >= 1.
705  C NOTE: It is currently assumed that  C NOTE: It is currently assumed that
706  C the highest record number in the file was the last record written.  C the highest record number in the file was the last record written.
707  C  C
# Line 719  C Routine arguments Line 720  C Routine arguments
720        logical globalFile        logical globalFile
721        character*(2) arrType        character*(2) arrType
722        integer nNz        integer nNz
723        Real arr(*)        _RL  arr(*)
724        integer irecord        integer irecord
725        integer myIter        integer myIter
726        integer myThid        integer myThid
# Line 727  C Functions Line 728  C Functions
728        integer ILNBLNK        integer ILNBLNK
729        integer MDS_RECLEN        integer MDS_RECLEN
730  C Local variables  C Local variables
731        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
732        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
733        Real*4 r4seg(sNy)        Real*4 r4seg(sNy)
734        Real*8 r8seg(sNy)        Real*8 r8seg(sNy)
# Line 760  C Assign a free unit number as the I/O c Line 761  C Assign a free unit number as the I/O c
761    
762  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
763        if (globalFile) then        if (globalFile) then
764         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFName,'(2a)') fName(1:IL),'.data'
765         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
766          length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
767          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 781  C If we are writing to a tiled MDS file Line 782  C If we are writing to a tiled MDS file
782          if (.NOT. globalFile) then          if (.NOT. globalFile) then
783           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
784           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
785           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFName,'(2a,i3.3,a,i3.3,a)')
786       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
787           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
788            length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
# Line 800  C If we are writing to a tiled MDS file Line 801  C If we are writing to a tiled MDS file
801             if (globalFile) then             if (globalFile) then
802              iG = (myXGlobalLo-1)/sNx + (bi-1)              iG = (myXGlobalLo-1)/sNx + (bi-1)
803              jG = myYGlobalLo-1 + (bj-1)*sNy              jG = myYGlobalLo-1 + (bj-1)*sNy
804              irec=1 + INT(jG/sNy) + nSy*nPy*iG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(jG/sNy) + nSy*nPy*(k-1)
805       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSy*nPy*nNz*(irecord-1)
806             else             else
807              iG = 0              iG = 0
808              jG = 0              jG = 0
# Line 832  C If we are writing to a tiled MDS file Line 833  C If we are writing to a tiled MDS file
833       &         ' MDSWRITEFIELDYZ: illegal value for arrType'       &         ' MDSWRITEFIELDYZ: illegal value for arrType'
834               call print_error( msgbuf, mythid )               call print_error( msgbuf, mythid )
835               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'
836              endif                          endif
837  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
838              call MDS_BYTESWAPR8( sNy, r8seg )              call MDS_BYTESWAPR8( sNy, r8seg )
839  #endif  #endif
Legend:
Removed from v.1.2.2.1  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22