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

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

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

revision 1.1 by jmc, Sun Oct 30 21:12:20 2005 UTC revision 1.2 by jmc, Tue Dec 30 02:13:01 2008 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
6        SUBROUTINE MDSWRITEVEC_LOC_RS(        SUBROUTINE MDS_WRITEVEC_LOC(
7       I   fName,       I   fName,
8       I   filePrec,       I   filePrec,
9         I   arrType,
10       I   nArr,       I   nArr,
11       I   arr,       I   arr,
12       I   bi, bj,       I   bi, bj,
13       I   irecord,       I   irecord,
14       I   myIter,       I   myIter,
15       I   myThid )       I   myThid )
16  C  
17  C Arguments:  C Arguments:
18  C  C
19  C fName         string  base name for file to written  C fName  string base name for file to written
20  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)
21  C nArr          number of elements from input array "arr" to be written  C nArr     integer :: number of elements from input array "arr" to be written
22  C arr           RS/RL   array to WRITE, arr(nArr)  C arrType  char(2) :: declaration type of "arr": either "RS" or "RL"
23  C bi,bj         tile indices (if tiled array) or 0,0 if not a tiled array  C arr       RS/RL  :: array to WRITE, arr(nArr)
24  C irecord       integer record number to WRITE  C bi,bj    integer :: tile indices (if tiled array) or 0,0 if not a tiled array
25  C myIter        integer time step number  C irecord  integer :: record number to WRITE
26  C myThid        integer thread identifier  C myIter   integer :: time step number
27    C myThid   integer :: my Thread Id number
28  C  C
29  C MDSWRITEVEC_LOC creates either a file of the form "fName.data" and  C MDS_WRITEVEC_LOC creates either a file of the form "fName.data" and
30  C "fName.meta" IF bi=bj=0. Otherwise it creates MDS tiled files of the  C "fName.meta" IF bi=bj=0. Otherwise it creates MDS tiled files of the
31  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".
32  C A meta-file is always created.  C A meta-file is always created.
# Line 36  C irecord is the record number to be wri Line 38  C irecord is the record number to be wri
38  C Global variables / common blocks  C Global variables / common blocks
39  #include "SIZE.h"  #include "SIZE.h"
40  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
41  #include "PARAMS.h"  #include "PARAMS.h"
42    
43  C Routine arguments  C Routine arguments
44        CHARACTER*(*) fName        CHARACTER*(*) fName
45        INTEGER filePrec        INTEGER filePrec
46          CHARACTER*(2) arrType
47        INTEGER nArr        INTEGER nArr
48        _RS     arr(*)        _RL     arr(*)
49        INTEGER bi,bj        INTEGER bi,bj
50        INTEGER irecord        INTEGER irecord
51        INTEGER myIter        INTEGER myIter
# Line 51  C Routine arguments Line 53  C Routine arguments
53  C Functions  C Functions
54        INTEGER ILNBLNK        INTEGER ILNBLNK
55        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
56          EXTERNAL ILNBLNK
57          EXTERNAL MDS_RECLEN
58  C Local variables  C Local variables
59        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName
60        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
61        LOGICAL fileIsOpen        LOGICAL fileIsOpen
62        INTEGER iG,jG,irec,k,dUnit,IL,pIL        INTEGER iG,jG,iRec,k,dUnit,IL,pIL
63        INTEGER dimList(3,3),ndims        INTEGER dimList(3,3), nDims, map2gl(2)
64        INTEGER length_of_rec        INTEGER length_of_rec
65        INTEGER loc_size        INTEGER loc_size
66        PARAMETER( loc_size = Nx+Ny+Nr )        PARAMETER( loc_size = Nx+Ny+Nr )
67        real*4 r4seg(loc_size)        real*4 r4seg(loc_size)
68        real*8 r8seg(loc_size)        real*8 r8seg(loc_size)
69    
70          DATA map2gl / 0, 1 /
71    
72  C Only DO I/O IF I am the master thread  C Only DO I/O IF I am the master thread
73        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
74    C--   we write a non-tiled array (bi=bj=0) only 1 time (if ProcId=0):
75  #ifdef ALLOW_USE_MPI        IF ( (myProcId.EQ.0 .AND. bi.EQ.0 .AND. bj.EQ.0)
76        IF ( (mpiMyId.EQ.0 .AND. bi.EQ.0 .AND. bj.EQ.0)       &                     .OR. bi.NE.0 .OR.  bj.NE.0 ) THEN
      &                    .OR. bi.NE.0 .OR.  bj.NE.0 ) THEN  
 C--   we are writing a non-tiled array (bi=bj=0), only 1 time.  
 #endif  
77    
78  C Record number must be >= 1  C Record number must be >= 1
79          IF (irecord .LT. 1) THEN          IF (irecord .LT. 1) THEN
80            WRITE(msgBuf,'(A,I9.8)')            WRITE(msgBuf,'(A,I9)')
81       &      ' MDSWRITEVEC_LOC: argument irecord = ',irecord       &      ' MDS_WRITEVEC_LOC: argument irecord = ',irecord
82            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
83            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
84       &     ' MDSWRITEVEC_LOC: invalid value for irecord'       &     ' MDS_WRITEVEC_LOC: invalid value for irecord'
85            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
86            STOP 'ABNORMAL END: S/R MDSWRITEVEC_LOC'            STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'
87          ENDIF          ENDIF
88    
89  C Assume nothing  C Assume nothing
90          fileIsOpen=.FALSE.          fileIsOpen = .FALSE.
91          IL  = ILNBLNK( fName )          IL  = ILNBLNK( fName )
92          irec = irecord          iRec = irecord
93    
94    C Check buffer size
95            IF ( nArr.GT.loc_size ) THEN
96              WRITE(msgBuf,'(3A)')
97         &     ' MDS_WRITEVEC_LOC: writing to file "', fName(1:IL), '":'
98              CALL PRINT_ERROR( msgBuf, myThid )
99              WRITE(msgBuf,'(A,I9)')
100         &      ' MDS_WRITEVEC_LOC: dim of arr to write=', nArr
101              CALL PRINT_ERROR( msgBuf, myThid )
102              WRITE(msgBuf,'(A,I9)')
103         &      ' MDS_WRITEVEC_LOC: exceeds buffer size=', loc_size
104              CALL PRINT_ERROR( msgBuf, myThid )
105              STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'
106            ENDIF
107    
108  C Assign special directory  C Assign special directory
109          IF ( mdsioLocalDir .NE. ' ' ) THEN          IF ( mdsioLocalDir .NE. ' ' ) THEN
# Line 125  C-      we are writing a tiled array (bi Line 142  C-      we are writing a tiled array (bi
142          ENDIF          ENDIF
143          IF ( debugLevel.GE.debLevB ) THEN          IF ( debugLevel.GE.debLevB ) THEN
144            WRITE(msgBuf,'(2A)')            WRITE(msgBuf,'(2A)')
145       &      ' MDSWRITEVEC_LOC: open file: ',dataFname(1:pIL+13)       &      ' MDS_WRITEVEC_LOC: open file: ',dataFname(1:pIL+13)
146            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
147       &                        SQUEEZE_RIGHT , 1)       &                        SQUEEZE_RIGHT , 1)
148          ENDIF          ENDIF
149    
150          IF (fileIsOpen) THEN          IF (fileIsOpen) THEN
151            IF (filePrec .EQ. precFloat32) THEN            IF ( arrType.EQ.'RS' ) THEN
152              DO k=1,nArr              CALL MDS_WR_REC_RS( arr, r4seg, r8seg,
153                r4seg(k) = arr(k)       I                          filePrec, dUnit, iRec, nArr, myThid )
154              ENDDO            ELSEIF ( arrType.EQ.'RL' ) THEN
155  #ifdef _BYTESWAPIO              CALL MDS_WR_REC_RL( arr, r4seg, r8seg,
156              CALL MDS_BYTESWAPR4( nArr, r4seg )       I                          filePrec, dUnit, iRec, nArr, myThid )
 #endif  
             WRITE(dUnit,rec=irec) (r4seg(k),k=1,nArr)  
           ELSEIF (filePrec .EQ. precFloat64) THEN  
             DO k=1,nArr  
               r8seg(k) = arr(k)  
             ENDDO  
 #ifdef _BYTESWAPIO  
             CALL MDS_BYTESWAPR8( nArr, r8seg )  
 #endif  
             WRITE(dUnit,rec=irec) (r8seg(k),k=1,nArr)  
157            ELSE            ELSE
158              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
159       &        ' MDSWRITEVEC_LOC: illegal value for filePrec'       &          ' MDS_WRITEVEC_LOC: illegal value for arrType'
160              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
161              STOP 'ABNORMAL END: S/R MDSWRITEVEC_LOC'              STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'
162            ENDIF            ENDIF
163          ELSE          ELSE
164            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
165       &      ' MDSWRITEVEC_LOC: should never reach this point'       &      ' MDS_WRITEVEC_LOC: should never reach this point'
166            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
167            STOP 'ABNORMAL END: S/R MDSWRITEVEC_LOC'            STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'
168          ENDIF          ENDIF
169    
170  C If we were writing to a tiled MDS file then we close it here  C If we were writing to a tiled MDS file then we close it here
# Line 192  C--     we are writing a tiled array (bi Line 199  C--     we are writing a tiled array (bi
199          dimList(1,3)=nArr          dimList(1,3)=nArr
200          dimList(2,3)=1          dimList(2,3)=1
201          dimList(3,3)=nArr          dimList(3,3)=nArr
202          ndims=3          nDims=3
203          IF (nArr .EQ. 1) ndims=2          IF (nArr .EQ. 1) nDims=2
204          CALL MDSWRITEMETA( metaFName, dataFName,          CALL MDS_WRITE_META(
205       &       filePrec, ndims, dimList, irec, myIter, myThid )       I              metaFName, dataFName, the_run_name, ' ',
206         I              filePrec, nDims, dimList, map2gl, 0, ' ',
207         I              0, UNSET_RL, iRec, myIter, myThid )
208    c    I              metaFName, dataFName, the_run_name, titleLine,
209    c    I              filePrec, nDims, dimList, map2gl, nFlds, fldList,
210    c    I              nTimRec, timList, irecord, myIter, myThid )
211    
 #ifdef ALLOW_USE_MPI  
212        ENDIF        ENDIF
 #endif  
   
213        _END_MASTER( myThid )        _END_MASTER( myThid )
214    
215        RETURN        RETURN
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22