/[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.3 by heimbach, Tue Jul 8 15:00:26 2003 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 "CPP_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
6  C The five "public" routines supplied here are:  C The five "public" routines supplied here are:
7  C  C
# Line 26  C           inserted calls to *print_mes Line 27  C           inserted calls to *print_mes
27  C  C
28  C To be modified to work with MITgcmuv message routines.  C To be modified to work with MITgcmuv message routines.
29    
 #undef  SAFE_IO  
   
 #ifdef SAFE_IO  
 #define _NEW_STATUS 'new'  
 #else  
 #define _NEW_STATUS 'unknown'  
 #endif  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 #define _OLD_STATUS 'unknown'  
 #else  
 #define _OLD_STATUS 'old'  
 #endif  
   
30  C=======================================================================  C=======================================================================
31        SUBROUTINE MDSREADFIELD_3D_GL(        SUBROUTINE MDSREADFIELD_3D_GL(
32       I   fName,       I   fName,
# Line 81  C Created: 03/16/99 adcroft@mit.edu Line 68  C Created: 03/16/99 adcroft@mit.edu
68  C Global variables / common blocks  C Global variables / common blocks
69  #include "SIZE.h"  #include "SIZE.h"
70  #include "EEPARAMS.h"  #include "EEPARAMS.h"
71    #include "EESUPPORT.h"
72  #include "PARAMS.h"  #include "PARAMS.h"
73    
74  C Routine arguments  C Routine arguments
# Line 95  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,ii,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)
90        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 104  C Local variables Line 92  C Local variables
92        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
93        integer length_of_rec        integer length_of_rec
94        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
95    cph-usesingle(
96          integer ii,jj
97    c     integer iG_IO,jG_IO,npe
98          integer x_size,y_size
99          PARAMETER ( x_size = Nx )
100          PARAMETER ( y_size = Ny )
101          Real*4 xy_buffer_r4(x_size,y_size)
102          Real*8 xy_buffer_r8(x_size,y_size)
103          Real*8 global(Nx,Ny)
104    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
105    cph-usesingle)
106    CMM(
107          integer pIL
108    CMM)
109    
110  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
111    
112  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 125  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 )
143    
144          if ( useSingleCPUIO ) then
145    
146    #ifdef ALLOW_USE_MPI
147            IF( mpiMyId .EQ. 0 ) THEN
148    #else
149            IF ( .TRUE. ) THEN
150    #endif /* ALLOW_USE_MPI */
151    
152  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
153        dataFName = fName           dataFName = fName
154        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
155        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
        stop " xx, adxx, weights and masks are not supposed to be global"  
       endif  
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 )
161              if (exst) globalFile = .TRUE.
162             endif
163    
164    C If global file is visible to process 0, then open it here.
165    C Otherwise stop program.
166             if ( globalFile) then
167              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
168              open( dUnit, file=dataFName, status='old',
169         &         access='direct', recl=length_of_rec )
170             else
171              write(msgbuf,'(2a)')
172         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
173              call print_message( msgbuf, standardmessageunit,
174         &                        SQUEEZE_RIGHT , mythid)
175              call print_error( msgbuf, mythid )
176              write(msgbuf,'(a)')
177         &      ' MDSREADFIELD: File does not exist'
178              call print_message( msgbuf, standardmessageunit,
179         &                        SQUEEZE_RIGHT , mythid)
180              call print_error( msgbuf, mythid )
181              stop 'ABNORMAL END: S/R MDSREADFIELD'
182             endif
183    
184            ENDIF
185    
186    c-- useSingleCpuIO
187          else
188    C Only do I/O if I am the master thread
189    
190    C Check first for global file with simple name (ie. fName)
191           dataFName = fName
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_GL: 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)
         globalFile = .TRUE.  
        stop " xx, adxx, weights and masks are not supposed to be global"  
198         endif         endif
199    
200    C If negative check for global file with MDS name (ie. fName.data)
201           if (.NOT. globalFile) then
202            write(dataFname,'(2a)') fName(1:IL),'.data'
203            inquire( file=dataFname, exist=exst )
204            if (exst) then
205             write(msgbuf,'(a,a)')
206         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
207             call print_message( msgbuf, standardmessageunit,
208         &                       SQUEEZE_RIGHT , mythid)
209             globalFile = .TRUE.
210            endif
211           endif
212    
213    c-- useSingleCpuIO
214        endif        endif
215    
216          if ( .not. useSingleCpuIO ) then
217    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
218          if ( .not. ( globalFile ) ) then
219    
220    C If we are reading from a global file then we open it here
221          if (globalFile) then
222           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
223           open( dUnit, file=dataFName, status='old',
224         &      access='direct', recl=length_of_rec )
225           fileIsOpen=.TRUE.
226          endif
227    
228  C Loop over all processors      C Loop over all processors    
229        do jp=1,nPy        do jp=1,nPy
230        do ip=1,nPx        do ip=1,nPx
# Line 163  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 171  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 182  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 )
261            write(msgbuf,'(a)')            write(msgbuf,'(a)')
262       &      ' MDSREADFIELD_GL: File does not exist'       &      ' MDSREADFIELD_GL: File does not exist'
263              call print_message( msgbuf, standardmessageunit,
264         &                        SQUEEZE_RIGHT , mythid)
265            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
266            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
267           endif           endif
# Line 195  C (This is a place-holder for the active Line 270  C (This is a place-holder for the active
270          if (fileIsOpen) then          if (fileIsOpen) then
271           do k=1,Nr           do k=1,Nr
272            do j=1,sNy            do j=1,sNy
273               if (globalFile) then
274                iG=bi+(ip-1)*nsx
275                jG=bj+(jp-1)*nsy
276                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
277         &             + nSx*nPx*Ny*nNz*(irecord-1)
278               else
279              iG = 0              iG = 0
280              jG = 0              jG = 0
281              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)
282               endif
283             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
284              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
285  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 260  C If global file was opened then close i Line 342  C If global file was opened then close i
342         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
343        endif        endif
344    
345    c      end of if ( .not. ( globalFile ) ) then
346          endif
347    
348    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
349          else
350    
351           DO k=1,nNz
352    
353    #ifdef ALLOW_USE_MPI
354             IF( mpiMyId .EQ. 0 ) THEN
355    #else
356             IF ( .TRUE. ) THEN
357    #endif /* ALLOW_USE_MPI */
358              irec = k+nNz*(irecord-1)
359              if (filePrec .eq. precFloat32) then
360               read(dUnit,rec=irec) xy_buffer_r4
361    #ifdef _BYTESWAPIO
362               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
363    #endif
364               DO J=1,Ny
365                DO I=1,Nx
366                 global(I,J) = xy_buffer_r4(I,J)
367                ENDDO
368               ENDDO
369              elseif (filePrec .eq. precFloat64) then
370               read(dUnit,rec=irec) xy_buffer_r8
371    #ifdef _BYTESWAPIO
372               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
373    #endif
374               DO J=1,Ny
375                DO I=1,Nx
376                 global(I,J) = xy_buffer_r8(I,J)
377                ENDDO
378               ENDDO
379              else
380               write(msgbuf,'(a)')
381         &            ' MDSREADFIELD: illegal value for filePrec'
382               call print_error( msgbuf, mythid )
383               stop 'ABNORMAL END: S/R MDSREADFIELD'
384              endif
385             ENDIF
386            DO jp=1,nPy
387             DO ip=1,nPx
388              DO bj = myByLo(myThid), myByHi(myThid)
389               DO bi = myBxLo(myThid), myBxHi(myThid)
390                DO J=1,sNy
391                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
392                 DO I=1,sNx
393                  II=((ip-1)*nSx+(bi-1))*sNx+I
394                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
395                 ENDDO
396                ENDDO
397               ENDDO
398              ENDDO
399             ENDDO
400            ENDDO
401    
402           ENDDO
403    c      ENDDO k=1,nNz
404    
405            close( dUnit )
406    
407          endif
408    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
409    
410        _END_MASTER( myThid )        _END_MASTER( myThid )
411    
412  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 318  C          open(dUnit, ..., status='old' Line 465  C          open(dUnit, ..., status='old'
465  C Global variables / common blocks  C Global variables / common blocks
466  #include "SIZE.h"  #include "SIZE.h"
467  #include "EEPARAMS.h"  #include "EEPARAMS.h"
468    #include "EESUPPORT.h"
469  #include "PARAMS.h"  #include "PARAMS.h"
470    
471  C Routine arguments  C Routine arguments
# Line 336  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,ii,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)
491        _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 345  C Local variables Line 493  C Local variables
493        integer length_of_rec        integer length_of_rec
494        logical fileIsOpen        logical fileIsOpen
495        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
496    cph-usesingle(
497    #ifdef ALLOW_USE_MPI
498          integer ii,jj
499    c     integer iG_IO,jG_IO,npe
500          integer x_size,y_size
501          PARAMETER ( x_size = Nx )
502          PARAMETER ( y_size = Ny )
503          Real*4 xy_buffer_r4(x_size,y_size)
504          Real*8 xy_buffer_r8(x_size,y_size)
505          Real*8 global(Nx,Ny)
506    #endif
507    cph-usesingle)
508    CMM(
509          integer pIL
510    CMM)
511    
512  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
513    
514  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 365  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 )
544    
545    cph-usesingle(
546    #ifdef ALLOW_USE_MPI
547          _END_MASTER( myThid )
548    C If option globalFile is desired but does not work or if
549    C globalFile is too slow, then try using single-CPU I/O.
550          if (useSingleCpuIO) then
551    
552    C Master thread of process 0, only, opens a global file
553           _BEGIN_MASTER( myThid )
554            IF( mpiMyId .EQ. 0 ) THEN
555             write(dataFname,'(2a)') fName(1:IL),'.data'
556             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
557             if (irecord .EQ. 1) then
558              open( dUnit, file=dataFName, status=_NEW_STATUS,
559         &        access='direct', recl=length_of_rec )
560             else
561              open( dUnit, file=dataFName, status=_OLD_STATUS,
562         &        access='direct', recl=length_of_rec )
563             endif
564            ENDIF
565           _END_MASTER( myThid )
566    
567    C Gather array and write it to file, one vertical level at a time
568           DO k=1,nNz
569    C Loop over all processors    
570            do jp=1,nPy
571            do ip=1,nPx
572            DO bj = myByLo(myThid), myByHi(myThid)
573             DO bi = myBxLo(myThid), myBxHi(myThid)
574              DO J=1,sNy
575               JJ=((jp-1)*nSy+(bj-1))*sNy+J
576               DO I=1,sNx
577                II=((ip-1)*nSx+(bi-1))*sNx+I
578                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
579               ENDDO
580              ENDDO
581             ENDDO
582            ENDDO
583            enddo
584            enddo
585            _BEGIN_MASTER( myThid )
586             IF( mpiMyId .EQ. 0 ) THEN
587              irec=k+nNz*(irecord-1)
588              if (filePrec .eq. precFloat32) then
589               DO J=1,Ny
590                DO I=1,Nx
591                 xy_buffer_r4(I,J) = global(I,J)
592                ENDDO
593               ENDDO
594    #ifdef _BYTESWAPIO
595               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
596    #endif
597               write(dUnit,rec=irec) xy_buffer_r4
598              elseif (filePrec .eq. precFloat64) then
599               DO J=1,Ny
600                DO I=1,Nx
601                 xy_buffer_r8(I,J) = global(I,J)
602                ENDDO
603               ENDDO
604    #ifdef _BYTESWAPIO
605               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
606    #endif
607               write(dUnit,rec=irec) xy_buffer_r8
608              else
609               write(msgbuf,'(a)')
610         &       ' MDSWRITEFIELD: illegal value for filePrec'
611               call print_error( msgbuf, mythid )
612               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
613              endif
614             ENDIF
615            _END_MASTER( myThid )
616           ENDDO
617    
618    C Close data-file and create meta-file
619           _BEGIN_MASTER( myThid )
620            IF( mpiMyId .EQ. 0 ) THEN
621             close( dUnit )
622             write(metaFName,'(2a)') fName(1:IL),'.meta'
623             dimList(1,1)=Nx
624             dimList(2,1)=1
625             dimList(3,1)=Nx
626             dimList(1,2)=Ny
627             dimList(2,2)=1
628             dimList(3,2)=Ny
629             dimList(1,3)=nNz
630             dimList(2,3)=1
631             dimList(3,3)=nNz
632             ndims=3
633             if (nNz .EQ. 1) ndims=2
634             call MDSWRITEMETA( metaFName, dataFName,
635         &     filePrec, ndims, dimList, irecord, myIter, mythid )
636            ENDIF
637           _END_MASTER( myThid )
638    C To be safe, make other processes wait for I/O completion
639           _BARRIER
640    
641          elseif ( .NOT. useSingleCpuIO ) then
642          _BEGIN_MASTER( myThid )
643    #endif /* ALLOW_USE_MPI */
644    cph-usesingle)
645    
646  C Loop over all processors      C Loop over all processors    
647        do jp=1,nPy        do jp=1,nPy
# Line 379  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 395  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 455  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 477  C End of ip,jp loops Line 750  C End of ip,jp loops
750         enddo         enddo
751        enddo        enddo
752    
   
753        _END_MASTER( myThid )        _END_MASTER( myThid )
754    
755    cph-usesingle(
756    #ifdef ALLOW_USE_MPI
757    C endif useSingleCpuIO
758          endif
759    #endif /* ALLOW_USE_MPI */
760    cph-usesingle)
761    
762  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
763        return        return
764        end        end
# Line 526  C Created: 03/16/99 adcroft@mit.edu Line 805  C Created: 03/16/99 adcroft@mit.edu
805  C Global variables / common blocks  C Global variables / common blocks
806  #include "SIZE.h"  #include "SIZE.h"
807  #include "EEPARAMS.h"  #include "EEPARAMS.h"
808    #include "EESUPPORT.h"
809  #include "PARAMS.h"  #include "PARAMS.h"
810    
811  C Routine arguments  C Routine arguments
# Line 541  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,ii,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)
828        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 550  C Local variables Line 830  C Local variables
830        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
831        integer length_of_rec        integer length_of_rec
832        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
833    cph-usesingle(
834          integer ii,jj
835    c     integer iG_IO,jG_IO,npe
836          integer x_size,y_size
837          PARAMETER ( x_size = Nx )
838          PARAMETER ( y_size = Ny )
839          Real*4 xy_buffer_r4(x_size,y_size)
840          Real*8 xy_buffer_r8(x_size,y_size)
841          Real*8 global(Nx,Ny)
842    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
843    cph-usesingle)
844    CMM(
845          integer pIL
846    CMM)
847    
848  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
849    
850  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 571  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 )
881    
882          if ( useSingleCPUIO ) then
883    
884    C master thread of process 0, only, opens a global file
885    #ifdef ALLOW_USE_MPI
886            IF( mpiMyId .EQ. 0 ) THEN
887    #else
888            IF ( .TRUE. ) THEN
889    #endif /* ALLOW_USE_MPI */
890    
891  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
892        dataFName = fName           dataFName = fName
893        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
894        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
        stop " xx, adxx, weights and masks are not supposed to be global"  
       endif  
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 )
900              if (exst) globalFile = .TRUE.
901             endif
902    
903    C If global file is visible to process 0, then open it here.
904    C Otherwise stop program.
905             if ( globalFile) then
906              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
907              open( dUnit, file=dataFName, status='old',
908         &         access='direct', recl=length_of_rec )
909             else
910              write(msgbuf,'(2a)')
911         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
912              call print_message( msgbuf, standardmessageunit,
913         &                        SQUEEZE_RIGHT , mythid)
914              call print_error( msgbuf, mythid )
915              write(msgbuf,'(a)')
916         &      ' MDSREADFIELD: File does not exist'
917              call print_message( msgbuf, standardmessageunit,
918         &                        SQUEEZE_RIGHT , mythid)
919              call print_error( msgbuf, mythid )
920              stop 'ABNORMAL END: S/R MDSREADFIELD'
921             endif
922    
923            ENDIF
924    
925    c-- useSingleCpuIO
926          else
927    
928    C Check first for global file with simple name (ie. fName)
929           dataFName = fName
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_GL: 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)
         globalFile = .TRUE.  
        stop " xx, adxx, weights and masks are not supposed to be global"  
936         endif         endif
937    
938    C If negative check for global file with MDS name (ie. fName.data)
939           if (.NOT. globalFile) then
940            write(dataFname,'(2a)') fName(1:IL),'.data'
941            inquire( file=dataFname, exist=exst )
942            if (exst) then
943             write(msgbuf,'(a,a)')
944         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
945             call print_message( msgbuf, standardmessageunit,
946         &                       SQUEEZE_RIGHT , mythid)
947             globalFile = .TRUE.
948            endif
949           endif
950    
951    c-- useSingleCpuIO
952        endif        endif
953    
954          if ( .not. useSingleCpuIO ) then
955    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
956          if ( .not. ( globalFile ) ) then
957    
958    C If we are reading from a global file then we open it here
959          if (globalFile) then
960           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
961           open( dUnit, file=dataFName, status='old',
962         &      access='direct', recl=length_of_rec )
963           fileIsOpen=.TRUE.
964          endif
965    
966  C Loop over all processors      C Loop over all processors    
967        do jp=1,nPy        do jp=1,nPy
968        do ip=1,nPx        do ip=1,nPx
# Line 609  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 617  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 628  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 )
999            write(msgbuf,'(a)')            write(msgbuf,'(a)')
1000       &      ' MDSREADFIELD_GL: File does not exist'       &      ' MDSREADFIELD_GL: File does not exist'
1001              call print_message( msgbuf, standardmessageunit,
1002         &                        SQUEEZE_RIGHT , mythid)
1003            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
1004            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
1005           endif           endif
# Line 641  C (This is a place-holder for the active Line 1008  C (This is a place-holder for the active
1008          if (fileIsOpen) then          if (fileIsOpen) then
1009           do k=1,nLocz           do k=1,nLocz
1010            do j=1,sNy            do j=1,sNy
1011               if (globalFile) then
1012                iG=bi+(ip-1)*nsx
1013                jG=bj+(jp-1)*nsy
1014                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
1015         &             + nSx*nPx*Ny*nLocz*(irecord-1)
1016               else
1017              iG = 0              iG = 0
1018              jG = 0              jG = 0
1019              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)
1020               endif
1021             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
1022              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
1023  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 706  C If global file was opened then close i Line 1080  C If global file was opened then close i
1080         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1081        endif        endif
1082    
1083    c      end of if ( .not. ( globalFile ) ) then
1084          endif
1085    
1086    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1087          else
1088    
1089           DO k=1,nLocz
1090    
1091    #ifdef ALLOW_USE_MPI
1092             IF( mpiMyId .EQ. 0 ) THEN
1093    #else
1094             IF ( .TRUE. ) THEN
1095    #endif /* ALLOW_USE_MPI */
1096              irec = k+nNz*(irecord-1)
1097              if (filePrec .eq. precFloat32) then
1098               read(dUnit,rec=irec) xy_buffer_r4
1099    #ifdef _BYTESWAPIO
1100               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1101    #endif
1102               DO J=1,Ny
1103                DO I=1,Nx
1104                 global(I,J) = xy_buffer_r4(I,J)
1105                ENDDO
1106               ENDDO
1107              elseif (filePrec .eq. precFloat64) then
1108               read(dUnit,rec=irec) xy_buffer_r8
1109    #ifdef _BYTESWAPIO
1110               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1111    #endif
1112               DO J=1,Ny
1113                DO I=1,Nx
1114                 global(I,J) = xy_buffer_r8(I,J)
1115                ENDDO
1116               ENDDO
1117              else
1118               write(msgbuf,'(a)')
1119         &            ' MDSREADFIELD: illegal value for filePrec'
1120               call print_error( msgbuf, mythid )
1121               stop 'ABNORMAL END: S/R MDSREADFIELD'
1122              endif
1123             ENDIF
1124            DO jp=1,nPy
1125             DO ip=1,nPx
1126              DO bj = myByLo(myThid), myByHi(myThid)
1127               DO bi = myBxLo(myThid), myBxHi(myThid)
1128                DO J=1,sNy
1129                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1130                 DO I=1,sNx
1131                  II=((ip-1)*nSx+(bi-1))*sNx+I
1132                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1133                 ENDDO
1134                ENDDO
1135               ENDDO
1136              ENDDO
1137             ENDDO
1138            ENDDO
1139    
1140           ENDDO
1141    c      ENDDO k=1,nNz
1142    
1143            close( dUnit )
1144    
1145          endif
1146    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1147    
1148        _END_MASTER( myThid )        _END_MASTER( myThid )
1149    
1150  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 764  C          open(dUnit, ..., status='old' Line 1203  C          open(dUnit, ..., status='old'
1203  C Global variables / common blocks  C Global variables / common blocks
1204  #include "SIZE.h"  #include "SIZE.h"
1205  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1206    #include "EESUPPORT.h"
1207  #include "PARAMS.h"  #include "PARAMS.h"
1208    
1209  C Routine arguments  C Routine arguments
# Line 783  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,ii,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)
1230        _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 792  C Local variables Line 1232  C Local variables
1232        integer length_of_rec        integer length_of_rec
1233        logical fileIsOpen        logical fileIsOpen
1234        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1235    cph-usesingle(
1236    #ifdef ALLOW_USE_MPI
1237          integer ii,jj
1238    c     integer iG_IO,jG_IO,npe
1239          integer x_size,y_size
1240          PARAMETER ( x_size = Nx )
1241          PARAMETER ( y_size = Ny )
1242          Real*4 xy_buffer_r4(x_size,y_size)
1243          Real*8 xy_buffer_r8(x_size,y_size)
1244          Real*8 global(Nx,Ny)
1245    #endif
1246    cph-usesingle)
1247    CMM(
1248          integer pIL
1249    CMM)
1250    
1251  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1252    
1253  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 812  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 )
1283    
1284    
1285    cph-usesingle(
1286    #ifdef ALLOW_USE_MPI
1287          _END_MASTER( myThid )
1288    C If option globalFile is desired but does not work or if
1289    C globalFile is too slow, then try using single-CPU I/O.
1290          if (useSingleCpuIO) then
1291    
1292    C Master thread of process 0, only, opens a global file
1293           _BEGIN_MASTER( myThid )
1294            IF( mpiMyId .EQ. 0 ) THEN
1295             write(dataFname,'(2a)') fName(1:IL),'.data'
1296             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1297             if (irecord .EQ. 1) then
1298              open( dUnit, file=dataFName, status=_NEW_STATUS,
1299         &        access='direct', recl=length_of_rec )
1300             else
1301              open( dUnit, file=dataFName, status=_OLD_STATUS,
1302         &        access='direct', recl=length_of_rec )
1303             endif
1304            ENDIF
1305           _END_MASTER( myThid )
1306    
1307    C Gather array and write it to file, one vertical level at a time
1308           DO k=1,nLocz
1309    C Loop over all processors    
1310            do jp=1,nPy
1311            do ip=1,nPx
1312            DO bj = myByLo(myThid), myByHi(myThid)
1313             DO bi = myBxLo(myThid), myBxHi(myThid)
1314              DO J=1,sNy
1315               JJ=((jp-1)*nSy+(bj-1))*sNy+J
1316               DO I=1,sNx
1317                II=((ip-1)*nSx+(bi-1))*sNx+I
1318                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
1319               ENDDO
1320              ENDDO
1321             ENDDO
1322            ENDDO
1323            enddo
1324            enddo
1325            _BEGIN_MASTER( myThid )
1326             IF( mpiMyId .EQ. 0 ) THEN
1327              irec=k+nLocz*(irecord-1)
1328              if (filePrec .eq. precFloat32) then
1329               DO J=1,Ny
1330                DO I=1,Nx
1331                 xy_buffer_r4(I,J) = global(I,J)
1332                ENDDO
1333               ENDDO
1334    #ifdef _BYTESWAPIO
1335               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1336    #endif
1337               write(dUnit,rec=irec) xy_buffer_r4
1338              elseif (filePrec .eq. precFloat64) then
1339               DO J=1,Ny
1340                DO I=1,Nx
1341                 xy_buffer_r8(I,J) = global(I,J)
1342                ENDDO
1343               ENDDO
1344    #ifdef _BYTESWAPIO
1345               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1346    #endif
1347               write(dUnit,rec=irec) xy_buffer_r8
1348              else
1349               write(msgbuf,'(a)')
1350         &       ' MDSWRITEFIELD: illegal value for filePrec'
1351               call print_error( msgbuf, mythid )
1352               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
1353              endif
1354             ENDIF
1355            _END_MASTER( myThid )
1356           ENDDO
1357    
1358    C Close data-file and create meta-file
1359           _BEGIN_MASTER( myThid )
1360            IF( mpiMyId .EQ. 0 ) THEN
1361             close( dUnit )
1362             write(metaFName,'(2a)') fName(1:IL),'.meta'
1363             dimList(1,1)=Nx
1364             dimList(2,1)=1
1365             dimList(3,1)=Nx
1366             dimList(1,2)=Ny
1367             dimList(2,2)=1
1368             dimList(3,2)=Ny
1369             dimList(1,3)=nLocz
1370             dimList(2,3)=1
1371             dimList(3,3)=nLocz
1372             ndims=3
1373             if (nLocz .EQ. 1) ndims=2
1374             call MDSWRITEMETA( metaFName, dataFName,
1375         &     filePrec, ndims, dimList, irecord, myIter, mythid )
1376            ENDIF
1377           _END_MASTER( myThid )
1378    C To be safe, make other processes wait for I/O completion
1379           _BARRIER
1380    
1381          elseif ( .NOT. useSingleCpuIO ) then
1382          _BEGIN_MASTER( myThid )
1383    #endif /* ALLOW_USE_MPI */
1384    cph-usesingle)
1385    
1386  C Loop over all processors      C Loop over all processors    
1387        do jp=1,nPy        do jp=1,nPy
1388        do ip=1,nPx        do ip=1,nPx
# Line 826  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 842  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 902  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
# Line 924  C End of ip,jp loops Line 1490  C End of ip,jp loops
1490         enddo         enddo
1491        enddo        enddo
1492    
   
1493        _END_MASTER( myThid )        _END_MASTER( myThid )
1494    
1495    #ifdef ALLOW_USE_MPI
1496    C endif useSingleCpuIO
1497          endif
1498    #endif /* ALLOW_USE_MPI */
1499    
1500  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1501        return        return
1502        end        end
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22