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

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

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

revision 1.12 by heimbach, Fri Aug 19 18:27:51 2005 UTC revision 1.14 by jmc, Sun Nov 6 01:25:13 2005 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 82  C Functions Line 83  C Functions
83        integer ILNBLNK        integer ILNBLNK
84        integer MDS_RECLEN        integer MDS_RECLEN
85  C Local variables  C Local variables
86        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
87        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
88        logical exst        logical exst
89        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)
# Line 93  C Local variables Line 94  C Local variables
94        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
95  cph-usesingle(  cph-usesingle(
96        integer ii,jj        integer ii,jj
97        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
98          integer x_size,y_size
99        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
100        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
101        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
102        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
103        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
104        _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
105  cph-usesingle)  cph-usesingle)
106    
107  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 142  C Check first for global file with simpl Line 144  C Check first for global file with simpl
144    
145  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)
146           if (.NOT. globalFile) then           if (.NOT. globalFile) then
147            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
148            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
149            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
150           endif           endif
# Line 154  C Otherwise stop program. Line 156  C Otherwise stop program.
156            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
157       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
158           else           else
159            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
160         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
161            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
162       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
163            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 177  C Check first for global file with simpl Line 180  C Check first for global file with simpl
180         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
181         if (exst) then         if (exst) then
182          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
183       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
184          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
185       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
186         endif         endif
187    
188  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)
189         if (.NOT. globalFile) then         if (.NOT. globalFile) then
190          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
191          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
192          if (exst) then          if (exst) then
193           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
194       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
195           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
196       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
197           globalFile = .TRUE.           globalFile = .TRUE.
# Line 220  C If we are reading from a tiled MDS fil Line 223  C If we are reading from a tiled MDS fil
223          if (.NOT. globalFile) then          if (.NOT. globalFile) then
224           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
225           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
226           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
227       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
228           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
229  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"
# Line 228  C (This is a place-holder for the active Line 231  C (This is a place-holder for the active
231           if (exst) then           if (exst) then
232            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
233             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
234       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
235             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
236       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
237            endif            endif
# Line 239  C (This is a place-holder for the active Line 242  C (This is a place-holder for the active
242           else           else
243            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
244            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
245       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
246            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
247       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
248            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 469  C Functions Line 472  C Functions
472        integer ILNBLNK        integer ILNBLNK
473        integer MDS_RECLEN        integer MDS_RECLEN
474  C Local variables  C Local variables
475        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
476        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
477        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
478        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 479  C Local variables Line 482  C Local variables
482        logical fileIsOpen        logical fileIsOpen
483        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
484  cph-usesingle(  cph-usesingle(
485    #ifdef ALLOW_USE_MPI
486        integer ii,jj        integer ii,jj
487        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
488          integer x_size,y_size
489        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
490        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
491        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
492        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
493        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
494    #endif
495  cph-usesingle)  cph-usesingle)
496    
497  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 522  C globalFile is too slow, then try using Line 528  C globalFile is too slow, then try using
528  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
529         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
530          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
531           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
532           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
533           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
534            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 589  C Close data-file and create meta-file Line 595  C Close data-file and create meta-file
595         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
596          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
597           close( dUnit )           close( dUnit )
598           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
599           dimList(1,1)=Nx           dimList(1,1)=Nx
600           dimList(2,1)=1           dimList(2,1)=1
601           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 622  C Loop over all tiles Line 628  C Loop over all tiles
628  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
629           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
630           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
631           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
632       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
633           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
634            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 638  C If we are writing to a tiled MDS file Line 644  C If we are writing to a tiled MDS file
644          if (fileIsOpen) then          if (fileIsOpen) then
645           do k=1,Nr           do k=1,Nr
646            do j=1,sNy            do j=1,sNy
647               do ii=1,sNx               do i=1,sNx
648                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
649               enddo               enddo
650              iG = 0              iG = 0
651              jG = 0              jG = 0
# Line 698  C If we were writing to a tiled MDS file Line 704  C If we were writing to a tiled MDS file
704  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
705           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
706           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
707           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
708       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
709           dimList(1,1)=Nx           dimList(1,1)=Nx
710           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 791  C Functions Line 797  C Functions
797        integer ILNBLNK        integer ILNBLNK
798        integer MDS_RECLEN        integer MDS_RECLEN
799  C Local variables  C Local variables
800        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
801        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
802        logical exst        logical exst
803        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)
# Line 802  C Local variables Line 808  C Local variables
808        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
809  cph-usesingle(  cph-usesingle(
810        integer ii,jj        integer ii,jj
811        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
812          integer x_size,y_size
813        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
814        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
815        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
816        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
817        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
818        _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
819  cph-usesingle)  cph-usesingle)
820    
821  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 852  C Check first for global file with simpl Line 859  C Check first for global file with simpl
859    
860  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)
861           if (.NOT. globalFile) then           if (.NOT. globalFile) then
862            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
863            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
864            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
865           endif           endif
# Line 864  C Otherwise stop program. Line 871  C Otherwise stop program.
871            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
872       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
873           else           else
874            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
875         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
876            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
877       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
878            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 886  C Check first for global file with simpl Line 894  C Check first for global file with simpl
894         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
895         if (exst) then         if (exst) then
896          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
897       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
898          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
899       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
900         endif         endif
901    
902  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)
903         if (.NOT. globalFile) then         if (.NOT. globalFile) then
904          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
905          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
906          if (exst) then          if (exst) then
907           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
908       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
909           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
910       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
911           globalFile = .TRUE.           globalFile = .TRUE.
# Line 929  C If we are reading from a tiled MDS fil Line 937  C If we are reading from a tiled MDS fil
937          if (.NOT. globalFile) then          if (.NOT. globalFile) then
938           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
939           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
940           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
941       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
942           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
943  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"
# Line 937  C (This is a place-holder for the active Line 945  C (This is a place-holder for the active
945           if (exst) then           if (exst) then
946            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
947             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
948       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
949             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
950       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
951            endif            endif
# Line 948  C (This is a place-holder for the active Line 956  C (This is a place-holder for the active
956           else           else
957            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
958            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
959       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
960            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
961       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
962            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 1179  C Functions Line 1187  C Functions
1187        integer ILNBLNK        integer ILNBLNK
1188        integer MDS_RECLEN        integer MDS_RECLEN
1189  C Local variables  C Local variables
1190        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1191        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
1192        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1193        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 1189  C Local variables Line 1197  C Local variables
1197        logical fileIsOpen        logical fileIsOpen
1198        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1199  cph-usesingle(  cph-usesingle(
1200    #ifdef ALLOW_USE_MPI
1201        integer ii,jj        integer ii,jj
1202        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
1203          integer x_size,y_size
1204        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1205        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1206        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1207        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1208        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1209    #endif
1210  cph-usesingle)  cph-usesingle)
1211    
1212  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 1233  C globalFile is too slow, then try using Line 1244  C globalFile is too slow, then try using
1244  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1245         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1246          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1247           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1248           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1249           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1250            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 1300  C Close data-file and create meta-file Line 1311  C Close data-file and create meta-file
1311         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1312          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1313           close( dUnit )           close( dUnit )
1314           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1315           dimList(1,1)=Nx           dimList(1,1)=Nx
1316           dimList(2,1)=1           dimList(2,1)=1
1317           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1333  C Loop over all tiles Line 1344  C Loop over all tiles
1344  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
1345           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1346           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1347           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1348       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1349           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1350            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 1349  C If we are writing to a tiled MDS file Line 1360  C If we are writing to a tiled MDS file
1360          if (fileIsOpen) then          if (fileIsOpen) then
1361           do k=1,nLocz           do k=1,nLocz
1362            do j=1,sNy            do j=1,sNy
1363               do ii=1,sNx               do i=1,sNx
1364                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
1365               enddo               enddo
1366              iG = 0              iG = 0
1367              jG = 0              jG = 0
# Line 1409  C If we were writing to a tiled MDS file Line 1420  C If we were writing to a tiled MDS file
1420  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1421           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1422           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1423           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1424       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1425           dimList(1,1)=Nx           dimList(1,1)=Nx
1426           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22