/[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.9 by heimbach, Fri Feb 18 20:21:15 2005 UTC revision 1.16 by jahn, Tue Dec 30 00:14:05 2008 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 78  C Routine arguments Line 79  C Routine arguments
79        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,Nr)        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,Nr)
80        integer irecord        integer irecord
81        integer myThid        integer myThid
82    
83    #ifdef ALLOW_CTRL
84    
85  C Functions  C Functions
86        integer ILNBLNK        integer ILNBLNK
87        integer MDS_RECLEN        integer MDS_RECLEN
88  C Local variables  C Local variables
89        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
90        integer ip,jp,iG,jG,irec,bi,bj,ii,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
91        logical exst        logical exst
92        _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)
93        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 93  C Local variables Line 97  C Local variables
97        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
98  cph-usesingle(  cph-usesingle(
99        integer ii,jj        integer ii,jj
100        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
101          integer x_size,y_size
102        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
103        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
104        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
105        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
106        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
107        _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)
108  cph-usesingle)  cph-usesingle)
109    CMM(
110          integer pIL
111    CMM)
112    
113  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
114    
# Line 123  C Assume nothing Line 131  C Assume nothing
131        globalFile = .FALSE.        globalFile = .FALSE.
132        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
133        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
134    CMM(
135          pIL = ILNBLNK( mdsioLocalDir )
136    CMM)
137    CMM(
138    C Assign special directory
139          if ( pIL.NE.0 ) then
140           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
141          endif
142    CMM)
143    
144  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
145        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 142  C Check first for global file with simpl Line 159  C Check first for global file with simpl
159    
160  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)
161           if (.NOT. globalFile) then           if (.NOT. globalFile) then
162            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
163            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
164            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
165           endif           endif
# Line 154  C Otherwise stop program. Line 171  C Otherwise stop program.
171            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
172       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
173           else           else
174            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
175         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
176            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
177       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
178            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 177  C Check first for global file with simpl Line 195  C Check first for global file with simpl
195         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
196         if (exst) then         if (exst) then
197          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
198       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
199          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
200       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
201         endif         endif
202    
203  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)
204         if (.NOT. globalFile) then         if (.NOT. globalFile) then
205          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
206          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
207          if (exst) then          if (exst) then
208           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
209       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
210           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
211       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
212           globalFile = .TRUE.           globalFile = .TRUE.
# Line 220  C If we are reading from a tiled MDS fil Line 238  C If we are reading from a tiled MDS fil
238          if (.NOT. globalFile) then          if (.NOT. globalFile) then
239           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
240           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
241           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
242       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
243           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
244  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 246  C (This is a place-holder for the active
246           if (exst) then           if (exst) then
247            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
248             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
249       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
250             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
251       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
252            endif            endif
# Line 239  C (This is a place-holder for the active Line 257  C (This is a place-holder for the active
257           else           else
258            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
259            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
260       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
261            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
262       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
263            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 394  c      end of if ( .not. ( globalFile .a Line 412  c      end of if ( .not. ( globalFile .a
412    
413        _END_MASTER( myThid )        _END_MASTER( myThid )
414    
415    #endif /* ALLOW_CTRL */
416  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
417        return        return
418        end        end
# Line 465  cph) Line 484  cph)
484        integer irecord        integer irecord
485        integer myIter        integer myIter
486        integer myThid        integer myThid
487    
488    #ifdef ALLOW_CTRL
489    
490  C Functions  C Functions
491        integer ILNBLNK        integer ILNBLNK
492        integer MDS_RECLEN        integer MDS_RECLEN
493  C Local variables  C Local variables
494        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
495        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
496        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
497        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 479  C Local variables Line 501  C Local variables
501        logical fileIsOpen        logical fileIsOpen
502        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
503  cph-usesingle(  cph-usesingle(
504    #ifdef ALLOW_USE_MPI
505        integer ii,jj        integer ii,jj
506        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
507          integer x_size,y_size
508        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
509        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
510        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
511        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
512        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
513    #endif
514  cph-usesingle)  cph-usesingle)
515    CMM(
516          integer pIL
517    CMM)
518    
519  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
520    
# Line 508  C Record number must be >= 1 Line 536  C Record number must be >= 1
536  C Assume nothing  C Assume nothing
537        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
538        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
539    CMM(
540          pIL = ILNBLNK( mdsioLocalDir )
541    CMM)
542    CMM(
543    C Assign special directory
544          if ( pIL.NE.0 ) then
545           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
546          endif
547    CMM)
548    
549  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
550        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 522  C globalFile is too slow, then try using Line 559  C globalFile is too slow, then try using
559  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
560         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
561          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
562           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
563           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
564           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
565            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 626  C Close data-file and create meta-file
626         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
627          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
628           close( dUnit )           close( dUnit )
629           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
630           dimList(1,1)=Nx           dimList(1,1)=Nx
631           dimList(2,1)=1           dimList(2,1)=1
632           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 622  C Loop over all tiles Line 659  C Loop over all tiles
659  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
660           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
661           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
662           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
663       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
664           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
665            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 675  C If we are writing to a tiled MDS file
675          if (fileIsOpen) then          if (fileIsOpen) then
676           do k=1,Nr           do k=1,Nr
677            do j=1,sNy            do j=1,sNy
678               do ii=1,sNx               do i=1,sNx
679                  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)
680               enddo               enddo
681              iG = 0              iG = 0
682              jG = 0              jG = 0
# Line 698  C If we were writing to a tiled MDS file Line 735  C If we were writing to a tiled MDS file
735  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
736           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
737           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
738           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
739       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
740           dimList(1,1)=Nx           dimList(1,1)=Nx
741           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 729  C endif useSingleCpuIO Line 766  C endif useSingleCpuIO
766  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
767  cph-usesingle)  cph-usesingle)
768    
769    #endif /* ALLOW_CTRL */
770  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
771        return        return
772        end        end
# Line 787  C Routine arguments Line 825  C Routine arguments
825        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,nLocz)        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,nLocz)
826        integer irecord        integer irecord
827        integer myThid        integer myThid
828    
829    #ifdef ALLOW_CTRL
830    
831  C Functions  C Functions
832        integer ILNBLNK        integer ILNBLNK
833        integer MDS_RECLEN        integer MDS_RECLEN
834  C Local variables  C Local variables
835        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
836        integer ip,jp,iG,jG,irec,bi,bj,ii,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
837        logical exst        logical exst
838        _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)
839        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 802  C Local variables Line 843  C Local variables
843        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
844  cph-usesingle(  cph-usesingle(
845        integer ii,jj        integer ii,jj
846        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
847          integer x_size,y_size
848        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
849        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
850        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
851        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
852        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
853        _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)
854  cph-usesingle)  cph-usesingle)
855    CMM(
856          integer pIL
857    CMM)
858    
859  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
860    
# Line 832  C Assume nothing Line 877  C Assume nothing
877        globalFile = .FALSE.        globalFile = .FALSE.
878        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
879        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
880    CMM(
881          pIL = ILNBLNK( mdsioLocalDir )
882    CMM)
883    CMM(
884    C Assign special directory
885          if ( pIL.NE.0 ) then
886           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
887          endif
888    CMM)
889    
890  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
891        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 852  C Check first for global file with simpl Line 906  C Check first for global file with simpl
906    
907  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)
908           if (.NOT. globalFile) then           if (.NOT. globalFile) then
909            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
910            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
911            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
912           endif           endif
# Line 864  C Otherwise stop program. Line 918  C Otherwise stop program.
918            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
919       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
920           else           else
921            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
922         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
923            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
924       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
925            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 886  C Check first for global file with simpl Line 941  C Check first for global file with simpl
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: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
945          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
946       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
947         endif         endif
948    
949  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)
950         if (.NOT. globalFile) then         if (.NOT. globalFile) then
951          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
952          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
953          if (exst) then          if (exst) then
954           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
955       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
956           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
957       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
958           globalFile = .TRUE.           globalFile = .TRUE.
# Line 929  C If we are reading from a tiled MDS fil Line 984  C If we are reading from a tiled MDS fil
984          if (.NOT. globalFile) then          if (.NOT. globalFile) then
985           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
986           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
987           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
988       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
989           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
990  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 992  C (This is a place-holder for the active
992           if (exst) then           if (exst) then
993            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
994             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
995       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
996             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
997       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
998            endif            endif
# Line 948  C (This is a place-holder for the active Line 1003  C (This is a place-holder for the active
1003           else           else
1004            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
1005            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
1006       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
1007            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
1008       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
1009            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 1103  c      end of if ( .not. ( globalFile .a Line 1158  c      end of if ( .not. ( globalFile .a
1158    
1159        _END_MASTER( myThid )        _END_MASTER( myThid )
1160    
1161    #endif /* ALLOW_CTRL */
1162  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1163        return        return
1164        end        end
# Line 1175  cph) Line 1231  cph)
1231        integer irecord        integer irecord
1232        integer myIter        integer myIter
1233        integer myThid        integer myThid
1234    
1235    #ifdef ALLOW_CTRL
1236    
1237  C Functions  C Functions
1238        integer ILNBLNK        integer ILNBLNK
1239        integer MDS_RECLEN        integer MDS_RECLEN
1240  C Local variables  C Local variables
1241        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1242        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
1243        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1244        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 1189  C Local variables Line 1248  C Local variables
1248        logical fileIsOpen        logical fileIsOpen
1249        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1250  cph-usesingle(  cph-usesingle(
1251    #ifdef ALLOW_USE_MPI
1252        integer ii,jj        integer ii,jj
1253        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
1254          integer x_size,y_size
1255        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1256        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1257        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1258        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1259        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1260    #endif
1261  cph-usesingle)  cph-usesingle)
1262    CMM(
1263          integer pIL
1264    CMM)
1265    
1266  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1267    
# Line 1218  C Record number must be >= 1 Line 1283  C Record number must be >= 1
1283  C Assume nothing  C Assume nothing
1284        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
1285        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
1286    CMM(
1287          pIL = ILNBLNK( mdsioLocalDir )
1288    CMM)
1289    CMM(
1290    C Assign special directory
1291          if ( pIL.NE.0 ) then
1292           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
1293          endif
1294    CMM)
1295    
1296  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
1297        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 1233  C globalFile is too slow, then try using Line 1307  C globalFile is too slow, then try using
1307  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1308         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1309          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1310           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1311           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1312           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1313            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 1374  C Close data-file and create meta-file
1374         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1375          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1376           close( dUnit )           close( dUnit )
1377           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1378           dimList(1,1)=Nx           dimList(1,1)=Nx
1379           dimList(2,1)=1           dimList(2,1)=1
1380           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1333  C Loop over all tiles Line 1407  C Loop over all tiles
1407  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
1408           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1409           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1410           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1411       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1412           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1413            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 1423  C If we are writing to a tiled MDS file
1423          if (fileIsOpen) then          if (fileIsOpen) then
1424           do k=1,nLocz           do k=1,nLocz
1425            do j=1,sNy            do j=1,sNy
1426               do ii=1,sNx               do i=1,sNx
1427                  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)
1428               enddo               enddo
1429              iG = 0              iG = 0
1430              jG = 0              jG = 0
# Line 1409  C If we were writing to a tiled MDS file Line 1483  C If we were writing to a tiled MDS file
1483  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1484           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1485           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1486           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1487       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1488           dimList(1,1)=Nx           dimList(1,1)=Nx
1489           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 1438  C endif useSingleCpuIO Line 1512  C endif useSingleCpuIO
1512        endif        endif
1513  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
1514    
1515    #endif /* ALLOW_CTRL */
1516  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1517        return        return
1518        end        end
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22