/[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.10 by heimbach, Fri Feb 18 21:41:44 2005 UTC revision 1.15 by heimbach, Mon May 14 22:53:26 2007 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    CMM(
107          integer pIL
108    CMM)
109    
110  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
111    
# Line 123  C Assume nothing Line 128  C Assume nothing
128        globalFile = .FALSE.        globalFile = .FALSE.
129        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
130        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
131    CMM(
132          pIL = ILNBLNK( mdsioLocalDir )
133    CMM)
134    CMM(
135    C Assign special directory
136          if ( pIL.NE.0 ) then
137           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
138          endif
139    CMM)
140    
141  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
142        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 142  C Check first for global file with simpl Line 156  C Check first for global file with simpl
156    
157  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)
158           if (.NOT. globalFile) then           if (.NOT. globalFile) then
159            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
160            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
161            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
162           endif           endif
# Line 154  C Otherwise stop program. Line 168  C Otherwise stop program.
168            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
169       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
170           else           else
171            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
172         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
173            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
174       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
175            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 177  C Check first for global file with simpl Line 192  C Check first for global file with simpl
192         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
193         if (exst) then         if (exst) then
194          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
195       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
196          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
197       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
198         endif         endif
199    
200  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)
201         if (.NOT. globalFile) then         if (.NOT. globalFile) then
202          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
203          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
204          if (exst) then          if (exst) then
205           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
206       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
207           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
208       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
209           globalFile = .TRUE.           globalFile = .TRUE.
# Line 220  C If we are reading from a tiled MDS fil Line 235  C If we are reading from a tiled MDS fil
235          if (.NOT. globalFile) then          if (.NOT. globalFile) then
236           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
237           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
238           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
239       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
240           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
241  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 243  C (This is a place-holder for the active
243           if (exst) then           if (exst) then
244            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
245             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
246       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
247             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
248       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
249            endif            endif
# Line 239  C (This is a place-holder for the active Line 254  C (This is a place-holder for the active
254           else           else
255            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
256            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
257       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
258            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
259       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
260            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 469  C Functions Line 484  C Functions
484        integer ILNBLNK        integer ILNBLNK
485        integer MDS_RECLEN        integer MDS_RECLEN
486  C Local variables  C Local variables
487        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
488        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
489        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
490        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 479  C Local variables Line 494  C Local variables
494        logical fileIsOpen        logical fileIsOpen
495        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
496  cph-usesingle(  cph-usesingle(
497    #ifdef ALLOW_USE_MPI
498        integer ii,jj        integer ii,jj
499        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
500          integer x_size,y_size
501        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
502        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
503        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
504        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
505        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
506    #endif
507  cph-usesingle)  cph-usesingle)
508    CMM(
509          integer pIL
510    CMM)
511    
512  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
513    
# Line 508  C Record number must be >= 1 Line 529  C Record number must be >= 1
529  C Assume nothing  C Assume nothing
530        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
531        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
532    CMM(
533          pIL = ILNBLNK( mdsioLocalDir )
534    CMM)
535    CMM(
536    C Assign special directory
537          if ( pIL.NE.0 ) then
538           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
539          endif
540    CMM)
541    
542  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
543        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 522  C globalFile is too slow, then try using Line 552  C globalFile is too slow, then try using
552  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
553         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
554          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
555           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
556           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
557           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
558            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 619  C Close data-file and create meta-file
619         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
620          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
621           close( dUnit )           close( dUnit )
622           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
623           dimList(1,1)=Nx           dimList(1,1)=Nx
624           dimList(2,1)=1           dimList(2,1)=1
625           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 622  C Loop over all tiles Line 652  C Loop over all tiles
652  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
653           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
654           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
655           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
656       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
657           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
658            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 668  C If we are writing to a tiled MDS file
668          if (fileIsOpen) then          if (fileIsOpen) then
669           do k=1,Nr           do k=1,Nr
670            do j=1,sNy            do j=1,sNy
671               do ii=1,sNx               do i=1,sNx
672                  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)
673               enddo               enddo
674              iG = 0              iG = 0
675              jG = 0              jG = 0
# Line 698  C If we were writing to a tiled MDS file Line 728  C If we were writing to a tiled MDS file
728  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
729           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
730           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
731           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
732       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
733           dimList(1,1)=Nx           dimList(1,1)=Nx
734           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 821  C Functions
821        integer ILNBLNK        integer ILNBLNK
822        integer MDS_RECLEN        integer MDS_RECLEN
823  C Local variables  C Local variables
824        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
825        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
826        logical exst        logical exst
827        _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 832  C Local variables
832        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
833  cph-usesingle(  cph-usesingle(
834        integer ii,jj        integer ii,jj
835        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
836          integer x_size,y_size
837        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
838        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
839        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
840        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
841        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
842        _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)
843  cph-usesingle)  cph-usesingle)
844    CMM(
845          integer pIL
846    CMM)
847    
848  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
849    
# Line 832  C Assume nothing Line 866  C Assume nothing
866        globalFile = .FALSE.        globalFile = .FALSE.
867        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
868        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
869    CMM(
870          pIL = ILNBLNK( mdsioLocalDir )
871    CMM)
872    CMM(
873    C Assign special directory
874          if ( pIL.NE.0 ) then
875           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
876          endif
877    CMM)
878    
879  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
880        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 852  C Check first for global file with simpl Line 895  C Check first for global file with simpl
895    
896  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)
897           if (.NOT. globalFile) then           if (.NOT. globalFile) then
898            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
899            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
900            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
901           endif           endif
# Line 864  C Otherwise stop program. Line 907  C Otherwise stop program.
907            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
908       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
909           else           else
910            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
911         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
912            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
913       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
914            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 886  C Check first for global file with simpl Line 930  C Check first for global file with simpl
930         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
931         if (exst) then         if (exst) then
932          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
933       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
934          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
935       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
936         endif         endif
937    
938  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)
939         if (.NOT. globalFile) then         if (.NOT. globalFile) then
940          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
941          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
942          if (exst) then          if (exst) then
943           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
944       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
945           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
946       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
947           globalFile = .TRUE.           globalFile = .TRUE.
# Line 929  C If we are reading from a tiled MDS fil Line 973  C If we are reading from a tiled MDS fil
973          if (.NOT. globalFile) then          if (.NOT. globalFile) then
974           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
975           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
976           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
977       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
978           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
979  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 981  C (This is a place-holder for the active
981           if (exst) then           if (exst) then
982            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
983             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
984       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
985             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
986       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
987            endif            endif
# Line 948  C (This is a place-holder for the active Line 992  C (This is a place-holder for the active
992           else           else
993            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
994            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
995       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
996            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
997       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
998            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 1179  C Functions Line 1223  C Functions
1223        integer ILNBLNK        integer ILNBLNK
1224        integer MDS_RECLEN        integer MDS_RECLEN
1225  C Local variables  C Local variables
1226        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1227        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
1228        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1229        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 1189  C Local variables Line 1233  C Local variables
1233        logical fileIsOpen        logical fileIsOpen
1234        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1235  cph-usesingle(  cph-usesingle(
1236    #ifdef ALLOW_USE_MPI
1237        integer ii,jj        integer ii,jj
1238        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
1239          integer x_size,y_size
1240        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1241        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1242        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1243        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1244        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1245    #endif
1246  cph-usesingle)  cph-usesingle)
1247    CMM(
1248          integer pIL
1249    CMM)
1250    
1251  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1252    
# Line 1218  C Record number must be >= 1 Line 1268  C Record number must be >= 1
1268  C Assume nothing  C Assume nothing
1269        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
1270        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
1271    CMM(
1272          pIL = ILNBLNK( mdsioLocalDir )
1273    CMM)
1274    CMM(
1275    C Assign special directory
1276          if ( pIL.NE.0 ) then
1277           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
1278          endif
1279    CMM)
1280    
1281  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
1282        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 1233  C globalFile is too slow, then try using Line 1292  C globalFile is too slow, then try using
1292  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1293         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1294          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1295           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1296           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1297           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1298            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 1359  C Close data-file and create meta-file
1359         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1360          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1361           close( dUnit )           close( dUnit )
1362           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1363           dimList(1,1)=Nx           dimList(1,1)=Nx
1364           dimList(2,1)=1           dimList(2,1)=1
1365           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1333  C Loop over all tiles Line 1392  C Loop over all tiles
1392  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
1393           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1394           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1395           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1396       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1397           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1398            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 1408  C If we are writing to a tiled MDS file
1408          if (fileIsOpen) then          if (fileIsOpen) then
1409           do k=1,nLocz           do k=1,nLocz
1410            do j=1,sNy            do j=1,sNy
1411               do ii=1,sNx               do i=1,sNx
1412                  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)
1413               enddo               enddo
1414              iG = 0              iG = 0
1415              jG = 0              jG = 0
# Line 1409  C If we were writing to a tiled MDS file Line 1468  C If we were writing to a tiled MDS file
1468  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1469           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1470           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1471           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1472       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1473           dimList(1,1)=Nx           dimList(1,1)=Nx
1474           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.10  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22