/[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.18 by jmc, Tue Aug 24 14:56:24 2010 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
6  C The five "public" routines supplied here are:  C--  File mdsio_gl.F: Routines to handle mid-level I/O interface.
7  C  C--   Contents
8  C MDSREADFIELD   - read model field from direct access global or tiled MDS file  C--   o MDSREADFIELD_3D_GL
9  C MDSWRITEFIELD  - write model field to direct access global or tiled MDS file  C--   o MDSWRITEFIELD_3D_GL
10  C MDSFINDUNIT    - returns an available (unused) I/O channel  C--   o MDSREADFIELD_2D_GL
11  C MDSREADVECTOR  - read vector from direct access global or tiled MDS file  C--   o MDSWRITEFIELD_2D_GL
12  C MDSWRITEVECTOR - write vector to direct access global or tiled MDS file  
13  C  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 C all other routines are "private" to these utilities and ought  
 C not be accessed directly from the main code.  
 C  
 C Created:  03/16/99 adcroft@mit.edu  
 C Modified: 03/23/99 adcroft@mit.edu  
 C           To work with multiple records  
 C Modified: 03/29/99 eckert@mit.edu  
 C           Added arbitrary vector capability  
 C Modified: 07/27/99 eckert@mit.edu  
 C           Customized for state estimation (--> active_file_control.F)  
 C           this relates only to *mdsreadvector* and *mdswritevector*  
 C Modified: 07/28/99 eckert@mit.edu  
 C           inserted calls to *print_message* and *print_error*  
 C  
 C To be modified to work with MITgcmuv message routines.  
14    
 C=======================================================================  
15        SUBROUTINE MDSREADFIELD_3D_GL(        SUBROUTINE MDSREADFIELD_3D_GL(
16       I   fName,       I   fName,
17       I   filePrec,       I   filePrec,
# Line 38  C======================================= Line 23  C=======================================
23  C  C
24  C Arguments:  C Arguments:
25  C  C
26  C fName         string  base name for file to read  C fName     (string)  :: base name for file to read
27  C filePrec      integer number of bits per word in file (32 or 64)  C filePrec  (integer) :: number of bits per word in file (32 or 64)
28  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
29  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
30  C arr           RS/RL   array to read into, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to read into, arr(:,:,nNz,:,:)
31  C irecord       integer record number to read  C irecord   (integer) :: record number to read
32  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
33  C  C
34  C MDSREADFIELD first checks to see if the file "fName" exists, then  C MDSREADFIELD first checks to see if the file "fName" exists, then
35  C if the file "fName.data" exists and finally the tiled files of the  C if the file "fName.data" exists and finally the tiled files of the
# Line 67  C Created: 03/16/99 adcroft@mit.edu Line 52  C Created: 03/16/99 adcroft@mit.edu
52  C Global variables / common blocks  C Global variables / common blocks
53  #include "SIZE.h"  #include "SIZE.h"
54  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
55  #include "PARAMS.h"  #include "PARAMS.h"
56    
57  C Routine arguments  C Routine arguments
# Line 78  C Routine arguments Line 62  C Routine arguments
62        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,Nr)        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,Nr)
63        integer irecord        integer irecord
64        integer myThid        integer myThid
65    
66    #ifdef ALLOW_CTRL
67    
68  C Functions  C Functions
69        integer ILNBLNK        integer ILNBLNK
70        integer MDS_RECLEN        integer MDS_RECLEN
71  C Local variables  C Local variables
72        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
73        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
74        logical exst        logical exst
75        _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)
76        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 93  C Local variables Line 80  C Local variables
80        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
81  cph-usesingle(  cph-usesingle(
82        integer ii,jj        integer ii,jj
83        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
84          integer x_size,y_size
85        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
86        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
87        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
88        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
89        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
90        _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)
91  cph-usesingle)  cph-usesingle)
92    CMM(
93          integer pIL
94    CMM)
95    
96  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
97    
# Line 123  C Assume nothing Line 114  C Assume nothing
114        globalFile = .FALSE.        globalFile = .FALSE.
115        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
116        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
117    CMM(
118          pIL = ILNBLNK( mdsioLocalDir )
119    CMM)
120    CMM(
121    C Assign special directory
122          if ( pIL.NE.0 ) then
123           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
124          endif
125    CMM)
126    
127  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
128        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 130  C Assign a free unit number as the I/O c Line 130  C Assign a free unit number as the I/O c
130        if ( useSingleCPUIO ) then        if ( useSingleCPUIO ) then
131    
132  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
133          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
134  #else  #else
135          IF ( .TRUE. ) THEN          IF ( .TRUE. ) THEN
136  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
# Line 142  C Check first for global file with simpl Line 142  C Check first for global file with simpl
142    
143  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)
144           if (.NOT. globalFile) then           if (.NOT. globalFile) then
145            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
146            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
147            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
148           endif           endif
# Line 154  C Otherwise stop program. Line 154  C Otherwise stop program.
154            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
155       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
156           else           else
157            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
158         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
159            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
160       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
161            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 177  C Check first for global file with simpl Line 178  C Check first for global file with simpl
178         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
179         if (exst) then         if (exst) then
180          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
181       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
182          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
183       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
184         endif         endif
185    
186  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)
187         if (.NOT. globalFile) then         if (.NOT. globalFile) then
188          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
189          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
190          if (exst) then          if (exst) then
191           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
192       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
193           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
194       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
195           globalFile = .TRUE.           globalFile = .TRUE.
# Line 210  C If we are reading from a global file t Line 211  C If we are reading from a global file t
211         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
212        endif        endif
213    
214  C Loop over all processors      C Loop over all processors
215        do jp=1,nPy        do jp=1,nPy
216        do ip=1,nPx        do ip=1,nPx
217  C Loop over all tiles  C Loop over all tiles
# Line 220  C If we are reading from a tiled MDS fil Line 221  C If we are reading from a tiled MDS fil
221          if (.NOT. globalFile) then          if (.NOT. globalFile) then
222           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
223           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
224           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
225       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
226           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
227  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 229  C (This is a place-holder for the active
229           if (exst) then           if (exst) then
230            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
231             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
232       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
233             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
234       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
235            endif            endif
# Line 239  C (This is a place-holder for the active Line 240  C (This is a place-holder for the active
240           else           else
241            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
242            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
243       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
244            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
245       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
246            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 336  c      else of if ( .not. ( globalFile . Line 337  c      else of if ( .not. ( globalFile .
337         DO k=1,nNz         DO k=1,nNz
338    
339  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
340           IF( mpiMyId .EQ. 0 ) THEN           IF( myProcId .EQ. 0 ) THEN
341  #else  #else
342           IF ( .TRUE. ) THEN           IF ( .TRUE. ) THEN
343  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
# Line 394  c      end of if ( .not. ( globalFile .a Line 395  c      end of if ( .not. ( globalFile .a
395    
396        _END_MASTER( myThid )        _END_MASTER( myThid )
397    
398    #else /* ALLOW_CTRL */
399          STOP 'ABNORMAL END: S/R MDSREADFIELD_3D_GL is empty'
400    #endif /* ALLOW_CTRL */
401  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
402        return        RETURN
403        end        END
404  C=======================================================================  
405    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
406    
 C=======================================================================  
407        SUBROUTINE MDSWRITEFIELD_3D_GL(        SUBROUTINE MDSWRITEFIELD_3D_GL(
408       I   fName,       I   fName,
409       I   filePrec,       I   filePrec,
# Line 412  C======================================= Line 416  C=======================================
416  C  C
417  C Arguments:  C Arguments:
418  C  C
419  C fName         string  base name for file to written  C fName     (string)  :: base name for file to write
420  C filePrec      integer number of bits per word in file (32 or 64)  C filePrec  (integer) :: number of bits per word in file (32 or 64)
421  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
422  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
423  C arr           RS/RL   array to write, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to write, arr(:,:,nNz,:,:)
424  C irecord       integer record number to read  C irecord   (integer) :: record number to write
425  C myIter        integer time step number  C myIter    (integer) :: time step number
426  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
427  C  C
428  C MDSWRITEFIELD creates either a file of the form "fName.data" and  C MDSWRITEFIELD creates either a file of the form "fName.data" and
429  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise
# Line 450  C          open(dUnit, ..., status='old' Line 454  C          open(dUnit, ..., status='old'
454  C Global variables / common blocks  C Global variables / common blocks
455  #include "SIZE.h"  #include "SIZE.h"
456  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
457  #include "PARAMS.h"  #include "PARAMS.h"
458    
459  C Routine arguments  C Routine arguments
# Line 465  cph) Line 468  cph)
468        integer irecord        integer irecord
469        integer myIter        integer myIter
470        integer myThid        integer myThid
471    
472    #ifdef ALLOW_CTRL
473    
474  C Functions  C Functions
475        integer ILNBLNK        integer ILNBLNK
476        integer MDS_RECLEN        integer MDS_RECLEN
477  C Local variables  C Local variables
478        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
479        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
480        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
481        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
482        _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)
483        integer dimList(3,3),ndims        INTEGER dimList(3,3), nDims, map2gl(2)
484          _RL dummyRL(1)
485          CHARACTER*8 blank8c
486        integer length_of_rec        integer length_of_rec
487        logical fileIsOpen        logical fileIsOpen
488        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
489  cph-usesingle(  cph-usesingle(
490    #ifdef ALLOW_USE_MPI
491        integer ii,jj        integer ii,jj
492        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
493          integer x_size,y_size
494        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
495        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
496        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
497        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
498        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
499    #endif
500  cph-usesingle)  cph-usesingle)
501    CMM(
502          integer pIL
503    CMM)
504    
505          DATA dummyRL(1) / 0. _d 0 /
506          DATA blank8c / '        ' /
507    
508  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
509    
# Line 508  C Record number must be >= 1 Line 525  C Record number must be >= 1
525  C Assume nothing  C Assume nothing
526        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
527        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
528    CMM(
529          pIL = ILNBLNK( mdsioLocalDir )
530    CMM)
531    CMM(
532    C Assign special directory
533          if ( pIL.NE.0 ) then
534           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
535          endif
536    CMM)
537    
538  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
539        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 521  C globalFile is too slow, then try using Line 547  C globalFile is too slow, then try using
547    
548  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
549         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
550          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
551           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
552           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
553           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
554            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 536  C Master thread of process 0, only, open Line 562  C Master thread of process 0, only, open
562    
563  C Gather array and write it to file, one vertical level at a time  C Gather array and write it to file, one vertical level at a time
564         DO k=1,nNz         DO k=1,nNz
565  C Loop over all processors      C Loop over all processors
566          do jp=1,nPy          do jp=1,nPy
567          do ip=1,nPx          do ip=1,nPx
568          DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
# Line 553  C Loop over all processors Line 579  C Loop over all processors
579          enddo          enddo
580          enddo          enddo
581          _BEGIN_MASTER( myThid )          _BEGIN_MASTER( myThid )
582           IF( mpiMyId .EQ. 0 ) THEN           IF( myProcId .EQ. 0 ) THEN
583            irec=k+nNz*(irecord-1)            irec=k+nNz*(irecord-1)
584            if (filePrec .eq. precFloat32) then            if (filePrec .eq. precFloat32) then
585             DO J=1,Ny             DO J=1,Ny
# Line 587  C Loop over all processors Line 613  C Loop over all processors
613    
614  C Close data-file and create meta-file  C Close data-file and create meta-file
615         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
616          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
617           close( dUnit )           close( dUnit )
618           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
619           dimList(1,1)=Nx           dimList(1,1)=Nx
620           dimList(2,1)=1           dimList(2,1)=1
621           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 599  C Close data-file and create meta-file Line 625  C Close data-file and create meta-file
625           dimList(1,3)=nNz           dimList(1,3)=nNz
626           dimList(2,3)=1           dimList(2,3)=1
627           dimList(3,3)=nNz           dimList(3,3)=nNz
628           ndims=3           nDims=3
629           if (nNz .EQ. 1) ndims=2           if (nNz .EQ. 1) nDims=2
630           call MDSWRITEMETA( metaFName, dataFName,           map2gl(1) = 0
631       &     filePrec, ndims, dimList, irecord, myIter, mythid )           map2gl(2) = 1
632             CALL MDS_WRITE_META(
633         I              metaFName, dataFName, the_run_name, ' ',
634         I              filePrec, nDims, dimList, map2gl, 0, blank8c,
635         I              0, dummyRL, irecord, myIter, myThid )
636          ENDIF          ENDIF
637         _END_MASTER( myThid )         _END_MASTER( myThid )
638  C To be safe, make other processes wait for I/O completion  C To be safe, make other processes wait for I/O completion
# Line 613  C To be safe, make other processes wait Line 643  C To be safe, make other processes wait
643  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
644  cph-usesingle)  cph-usesingle)
645    
646  C Loop over all processors      C Loop over all processors
647        do jp=1,nPy        do jp=1,nPy
648        do ip=1,nPx        do ip=1,nPx
649  C Loop over all tiles  C Loop over all tiles
# 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 709  C Create meta-file for each tile if we a Line 739  C Create meta-file for each tile if we a
739           dimList(1,3)=Nr           dimList(1,3)=Nr
740           dimList(2,3)=1           dimList(2,3)=1
741           dimList(3,3)=Nr           dimList(3,3)=Nr
742           ndims=3           nDims=3
743           if (Nr .EQ. 1) ndims=2           if (Nr .EQ. 1) nDims=2
744           call MDSWRITEMETA( metaFName, dataFName,           map2gl(1) = 0
745       &     filePrec, ndims, dimList, irecord, myIter, mythid )           map2gl(2) = 1
746             CALL MDS_WRITE_META(
747         I              metaFName, dataFName, the_run_name, ' ',
748         I              filePrec, nDims, dimList, map2gl, 0, blank8c,
749         I              0, dummyRL, irecord, myIter, myThid )
750  C End of bi,bj loops  C End of bi,bj loops
751         enddo         enddo
752        enddo        enddo
# Line 729  C endif useSingleCpuIO Line 763  C endif useSingleCpuIO
763  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
764  cph-usesingle)  cph-usesingle)
765    
766    #else /* ALLOW_CTRL */
767          STOP 'ABNORMAL END: S/R MDSWRITEFIELD_3D_GL is empty'
768    #endif /* ALLOW_CTRL */
769  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
770        return        RETURN
771        end        END
772  C=======================================================================  
773    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
774    
 C=======================================================================  
775        SUBROUTINE MDSREADFIELD_2D_GL(        SUBROUTINE MDSREADFIELD_2D_GL(
776       I   fName,       I   fName,
777       I   filePrec,       I   filePrec,
# Line 746  C======================================= Line 783  C=======================================
783  C  C
784  C Arguments:  C Arguments:
785  C  C
786  C fName         string  base name for file to read  C fName     (string)  :: base name for file to read
787  C filePrec      integer number of bits per word in file (32 or 64)  C filePrec  (integer) :: number of bits per word in file (32 or 64)
788  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
789  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
790  C arr           RS/RL   array to read into, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to read into, arr(:,:,nNz,:,:)
791  C irecord       integer record number to read  C irecord   (integer) :: record number to read
792  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
793  C  C
794  C MDSREADFIELD first checks to see if the file "fName" exists, then  C MDSREADFIELD first checks to see if the file "fName" exists, then
795  C if the file "fName.data" exists and finally the tiled files of the  C if the file "fName.data" exists and finally the tiled files of the
# Line 775  C Created: 03/16/99 adcroft@mit.edu Line 812  C Created: 03/16/99 adcroft@mit.edu
812  C Global variables / common blocks  C Global variables / common blocks
813  #include "SIZE.h"  #include "SIZE.h"
814  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
815  #include "PARAMS.h"  #include "PARAMS.h"
816    
817  C Routine arguments  C Routine arguments
# Line 787  C Routine arguments Line 823  C Routine arguments
823        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,nLocz)        _RL arr_gl(sNx,nSx,nPx,sNy,nSy,nPy,nLocz)
824        integer irecord        integer irecord
825        integer myThid        integer myThid
826    
827    #ifdef ALLOW_CTRL
828    
829  C Functions  C Functions
830        integer ILNBLNK        integer ILNBLNK
831        integer MDS_RECLEN        integer MDS_RECLEN
832  C Local variables  C Local variables
833        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
834        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
835        logical exst        logical exst
836        _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)
837        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 802  C Local variables Line 841  C Local variables
841        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
842  cph-usesingle(  cph-usesingle(
843        integer ii,jj        integer ii,jj
844        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
845          integer x_size,y_size
846        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
847        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
848        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
849        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
850        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
851        _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)
852  cph-usesingle)  cph-usesingle)
853    CMM(
854          integer pIL
855    CMM)
856    
857  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
858    
# Line 832  C Assume nothing Line 875  C Assume nothing
875        globalFile = .FALSE.        globalFile = .FALSE.
876        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
877        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
878    CMM(
879          pIL = ILNBLNK( mdsioLocalDir )
880    CMM)
881    CMM(
882    C Assign special directory
883          if ( pIL.NE.0 ) then
884           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
885          endif
886    CMM)
887    
888  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
889        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 840  C Assign a free unit number as the I/O c Line 892  C Assign a free unit number as the I/O c
892    
893  C master thread of process 0, only, opens a global file  C master thread of process 0, only, opens a global file
894  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
895          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
896  #else  #else
897          IF ( .TRUE. ) THEN          IF ( .TRUE. ) THEN
898  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
# Line 852  C Check first for global file with simpl Line 904  C Check first for global file with simpl
904    
905  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)
906           if (.NOT. globalFile) then           if (.NOT. globalFile) then
907            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
908            inquire( file=dataFname, exist=exst )            inquire( file=dataFname, exist=exst )
909            if (exst) globalFile = .TRUE.            if (exst) globalFile = .TRUE.
910           endif           endif
# Line 864  C Otherwise stop program. Line 916  C Otherwise stop program.
916            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
917       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
918           else           else
919            write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName            write(msgbuf,'(2a)')
920         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
921            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
922       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
923            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 886  C Check first for global file with simpl Line 939  C Check first for global file with simpl
939         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
940         if (exst) then         if (exst) then
941          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
942       &    ' MDSREADFIELD: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
943          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
944       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
945         endif         endif
946    
947  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)
948         if (.NOT. globalFile) then         if (.NOT. globalFile) then
949          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'          write(dataFname,'(2a)') fName(1:IL),'.data'
950          inquire( file=dataFname, exist=exst )          inquire( file=dataFname, exist=exst )
951          if (exst) then          if (exst) then
952           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
953       &     ' MDSREADFIELD_GL: opening global file: ',dataFName       &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
954           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
955       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
956           globalFile = .TRUE.           globalFile = .TRUE.
# Line 919  C If we are reading from a global file t Line 972  C If we are reading from a global file t
972         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
973        endif        endif
974    
975  C Loop over all processors      C Loop over all processors
976        do jp=1,nPy        do jp=1,nPy
977        do ip=1,nPx        do ip=1,nPx
978  C Loop over all tiles  C Loop over all tiles
# Line 929  C If we are reading from a tiled MDS fil Line 982  C If we are reading from a tiled MDS fil
982          if (.NOT. globalFile) then          if (.NOT. globalFile) then
983           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
984           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
985           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
986       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
987           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
988  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 990  C (This is a place-holder for the active
990           if (exst) then           if (exst) then
991            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
992             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
993       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
994             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
995       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
996            endif            endif
# Line 948  C (This is a place-holder for the active Line 1001  C (This is a place-holder for the active
1001           else           else
1002            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
1003            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
1004       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
1005            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
1006       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
1007            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 1045  c      else of if ( .not. ( globalFile . Line 1098  c      else of if ( .not. ( globalFile .
1098         DO k=1,nLocz         DO k=1,nLocz
1099    
1100  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
1101           IF( mpiMyId .EQ. 0 ) THEN           IF( myProcId .EQ. 0 ) THEN
1102  #else  #else
1103           IF ( .TRUE. ) THEN           IF ( .TRUE. ) THEN
1104  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
# Line 1103  c      end of if ( .not. ( globalFile .a Line 1156  c      end of if ( .not. ( globalFile .a
1156    
1157        _END_MASTER( myThid )        _END_MASTER( myThid )
1158    
1159    #else /* ALLOW_CTRL */
1160          STOP 'ABNORMAL END: S/R MDSREADFIELD_2D_GL is empty'
1161    #endif /* ALLOW_CTRL */
1162  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1163        return        RETURN
1164        end        END
1165  C=======================================================================  
1166    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1167    
 C=======================================================================  
1168        SUBROUTINE MDSWRITEFIELD_2D_GL(        SUBROUTINE MDSWRITEFIELD_2D_GL(
1169       I   fName,       I   fName,
1170       I   filePrec,       I   filePrec,
# Line 1121  C======================================= Line 1177  C=======================================
1177  C  C
1178  C Arguments:  C Arguments:
1179  C  C
1180  C fName         string  base name for file to written  C fName     (string)  :: base name for file to write
1181  C filePrec      integer number of bits per word in file (32 or 64)  C filePrec  (integer) :: number of bits per word in file (32 or 64)
1182  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
1183  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
1184  C arr           RS/RL   array to write, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to write, arr(:,:,nNz,:,:)
1185  C irecord       integer record number to read  C irecord   (integer) :: record number to write
1186  C myIter        integer time step number  C myIter    (integer) :: time step number
1187  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
1188  C  C
1189  C MDSWRITEFIELD creates either a file of the form "fName.data" and  C MDSWRITEFIELD creates either a file of the form "fName.data" and
1190  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise
# Line 1159  C          open(dUnit, ..., status='old' Line 1215  C          open(dUnit, ..., status='old'
1215  C Global variables / common blocks  C Global variables / common blocks
1216  #include "SIZE.h"  #include "SIZE.h"
1217  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
1218  #include "PARAMS.h"  #include "PARAMS.h"
1219    
1220  C Routine arguments  C Routine arguments
# Line 1175  cph) Line 1230  cph)
1230        integer irecord        integer irecord
1231        integer myIter        integer myIter
1232        integer myThid        integer myThid
1233    
1234    #ifdef ALLOW_CTRL
1235    
1236  C Functions  C Functions
1237        integer ILNBLNK        integer ILNBLNK
1238        integer MDS_RECLEN        integer MDS_RECLEN
1239  C Local variables  C Local variables
1240        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1241        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
1242        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1243        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
1244        _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)
1245        integer dimList(3,3),ndims        INTEGER dimList(3,3), nDims, map2gl(2)
1246          _RL dummyRL(1)
1247          CHARACTER*8 blank8c
1248        integer length_of_rec        integer length_of_rec
1249        logical fileIsOpen        logical fileIsOpen
1250        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1251  cph-usesingle(  cph-usesingle(
1252    #ifdef ALLOW_USE_MPI
1253        integer ii,jj        integer ii,jj
1254        integer x_size,y_size,iG_IO,jG_IO,npe  c     integer iG_IO,jG_IO,npe
1255          integer x_size,y_size
1256        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1257        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1258        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1259        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1260        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1261    #endif
1262  cph-usesingle)  cph-usesingle)
1263    CMM(
1264          integer pIL
1265    CMM)
1266    
1267          DATA dummyRL(1) / 0. _d 0 /
1268          DATA blank8c / '        ' /
1269    
1270  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1271    
# Line 1218  C Record number must be >= 1 Line 1287  C Record number must be >= 1
1287  C Assume nothing  C Assume nothing
1288        fileIsOpen=.FALSE.        fileIsOpen=.FALSE.
1289        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
1290    CMM(
1291          pIL = ILNBLNK( mdsioLocalDir )
1292    CMM)
1293    CMM(
1294    C Assign special directory
1295          if ( pIL.NE.0 ) then
1296           write(fName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
1297          endif
1298    CMM)
1299    
1300  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
1301        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
# Line 1232  C globalFile is too slow, then try using Line 1310  C globalFile is too slow, then try using
1310    
1311  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1312         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1313          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
1314           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1315           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1316           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1317            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 1247  C Master thread of process 0, only, open Line 1325  C Master thread of process 0, only, open
1325    
1326  C Gather array and write it to file, one vertical level at a time  C Gather array and write it to file, one vertical level at a time
1327         DO k=1,nLocz         DO k=1,nLocz
1328  C Loop over all processors      C Loop over all processors
1329          do jp=1,nPy          do jp=1,nPy
1330          do ip=1,nPx          do ip=1,nPx
1331          DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
# Line 1264  C Loop over all processors Line 1342  C Loop over all processors
1342          enddo          enddo
1343          enddo          enddo
1344          _BEGIN_MASTER( myThid )          _BEGIN_MASTER( myThid )
1345           IF( mpiMyId .EQ. 0 ) THEN           IF( myProcId .EQ. 0 ) THEN
1346            irec=k+nLocz*(irecord-1)            irec=k+nLocz*(irecord-1)
1347            if (filePrec .eq. precFloat32) then            if (filePrec .eq. precFloat32) then
1348             DO J=1,Ny             DO J=1,Ny
# Line 1298  C Loop over all processors Line 1376  C Loop over all processors
1376    
1377  C Close data-file and create meta-file  C Close data-file and create meta-file
1378         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1379          IF( mpiMyId .EQ. 0 ) THEN          IF( myProcId .EQ. 0 ) THEN
1380           close( dUnit )           close( dUnit )
1381           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1382           dimList(1,1)=Nx           dimList(1,1)=Nx
1383           dimList(2,1)=1           dimList(2,1)=1
1384           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1310  C Close data-file and create meta-file Line 1388  C Close data-file and create meta-file
1388           dimList(1,3)=nLocz           dimList(1,3)=nLocz
1389           dimList(2,3)=1           dimList(2,3)=1
1390           dimList(3,3)=nLocz           dimList(3,3)=nLocz
1391           ndims=3           nDims=3
1392           if (nLocz .EQ. 1) ndims=2           if (nLocz .EQ. 1) nDims=2
1393           call MDSWRITEMETA( metaFName, dataFName,           map2gl(1) = 0
1394       &     filePrec, ndims, dimList, irecord, myIter, mythid )           map2gl(2) = 1
1395             CALL MDS_WRITE_META(
1396         I              metaFName, dataFName, the_run_name, ' ',
1397         I              filePrec, nDims, dimList, map2gl, 0, blank8c,
1398         I              0, dummyRL, irecord, myIter, myThid )
1399          ENDIF          ENDIF
1400         _END_MASTER( myThid )         _END_MASTER( myThid )
1401  C To be safe, make other processes wait for I/O completion  C To be safe, make other processes wait for I/O completion
# Line 1324  C To be safe, make other processes wait Line 1406  C To be safe, make other processes wait
1406  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
1407  cph-usesingle)  cph-usesingle)
1408    
1409  C Loop over all processors      C Loop over all processors
1410        do jp=1,nPy        do jp=1,nPy
1411        do ip=1,nPx        do ip=1,nPx
1412  C Loop over all tiles  C Loop over all tiles
# Line 1333  C Loop over all tiles Line 1415  C Loop over all tiles
1415  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
1416           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1417           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1418           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1419       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1420           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1421            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 1431  C If we are writing to a tiled MDS file
1431          if (fileIsOpen) then          if (fileIsOpen) then
1432           do k=1,nLocz           do k=1,nLocz
1433            do j=1,sNy            do j=1,sNy
1434               do ii=1,sNx               do i=1,sNx
1435                  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)
1436               enddo               enddo
1437              iG = 0              iG = 0
1438              jG = 0              jG = 0
# Line 1409  C If we were writing to a tiled MDS file Line 1491  C If we were writing to a tiled MDS file
1491  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1492           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1493           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1494           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1495       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1496           dimList(1,1)=Nx           dimList(1,1)=Nx
1497           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 1420  C Create meta-file for each tile if we a Line 1502  C Create meta-file for each tile if we a
1502           dimList(1,3)=Nr           dimList(1,3)=Nr
1503           dimList(2,3)=1           dimList(2,3)=1
1504           dimList(3,3)=Nr           dimList(3,3)=Nr
1505           ndims=3           nDims=3
1506           if (nLocz .EQ. 1) ndims=2           if (nLocz .EQ. 1) nDims=2
1507           call MDSWRITEMETA( metaFName, dataFName,           map2gl(1) = 0
1508       &     filePrec, ndims, dimList, irecord, myIter, mythid )           map2gl(2) = 1
1509             CALL MDS_WRITE_META(
1510         I              metaFName, dataFName, the_run_name, ' ',
1511         I              filePrec, nDims, dimList, map2gl, 0, blank8c,
1512         I              0, dummyRL, irecord, myIter, myThid )
1513  C End of bi,bj loops  C End of bi,bj loops
1514         enddo         enddo
1515        enddo        enddo
# Line 1438  C endif useSingleCpuIO Line 1524  C endif useSingleCpuIO
1524        endif        endif
1525  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
1526    
1527    #else /* ALLOW_CTRL */
1528          STOP 'ABNORMAL END: S/R MDSWRITEFIELD_2D_GL is empty'
1529    #endif /* ALLOW_CTRL */
1530  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1531        return        RETURN
1532        end        END
 C=======================================================================  
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22