/[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.4 by jmc, Sun Aug 2 20:42:43 2009 UTC revision 1.5 by jmc, Tue Sep 1 19:08:27 2009 UTC
# Line 11  C !INTERFACE: Line 11  C !INTERFACE:
11       I   filePrec,       I   filePrec,
12       U   ioUnit,       U   ioUnit,
13       I   arrType,       I   arrType,
14       I   nArr,       I   nSize,
15       I   arr,       I   fldRL, fldRS,
16       I   bi, bj,       I   bi, bj,
17       I   irecord,       I   irecord,
18       I   myIter,       I   myIter,
# Line 24  C Line 24  C
24  C fName    string  :: base name for file to written  C fName    string  :: base name for file to written
25  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)
26  C ioUnit   integer :: fortran file IO unit  C ioUnit   integer :: fortran file IO unit
27  C nArr     integer :: number of elements from input array "arr" to be written  C nSize    integer :: number of elements from input array "fldRL/RS" to be written
28  C arrType  char(2) :: declaration type of "arr": either "RS" or "RL"  C arrType  char(2) :: which array (fldRL/RS) to write, either "RL" or "RS"
29  C arr       RS/RL  :: array to WRITE, arr(nArr)  C fldRL    ( RL )  :: array to write if arrType="RL", fldRL(nSize)
30    C fldRS    ( RS )  :: array to write if arrType="RS", fldRS(nSize)
31  C bi,bj    integer :: tile indices (if tiled array) or 0,0 if not a tiled array  C bi,bj    integer :: tile indices (if tiled array) or 0,0 if not a tiled array
32  C irecord  integer :: record number to WRITE =|irecord|  C irecord  integer :: record number to WRITE =|irecord|
33  C myIter   integer :: time step number  C myIter   integer :: time step number
# Line 37  C  ioUnit = 0 : open file, write and clo Line 38  C  ioUnit = 0 : open file, write and clo
38  C  ioUnit =-1 : open file, write and leave it open (return IO unit in ioUnit)  C  ioUnit =-1 : open file, write and leave it open (return IO unit in ioUnit)
39  C  ioUnit > 0 : assume file "ioUnit" is open, and write to it.  C  ioUnit > 0 : assume file "ioUnit" is open, and write to it.
40  C MDS_WRITEVEC_LOC writes either to a file of the form "fName.data" and  C MDS_WRITEVEC_LOC writes either to a file of the form "fName.data" and
41  C "fName.meta" IF bi=bj=0. Otherwise it writes to MDS tiled files of the  C "fName.meta" if bi=bj=0. Otherwise it writes to MDS tiled files of the
42  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".
43  C If irecord>0, a meta-file is created (skipped if irecord<0).  C If irecord>0, a meta-file is created (skipped if irecord<0).
44  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is described by filePrec, set either
45  C to floatPrec32 or floatPrec64.  C to floatPrec32 or floatPrec64.
46  C |irecord|=iRec is the record number to be written and must be >=1.  C |irecord|=iRec is the record number to be written and must be >=1.
47    
# Line 57  C !INPUT/OUTPUT PARAMETERS: Line 58  C !INPUT/OUTPUT PARAMETERS:
58        INTEGER ioUnit        INTEGER ioUnit
59        INTEGER filePrec        INTEGER filePrec
60        CHARACTER*(2) arrType        CHARACTER*(2) arrType
61        INTEGER nArr        INTEGER nSize
62        _RL     arr(*)        _RL     fldRL(*)
63          _RS     fldRS(*)
64        INTEGER bi,bj        INTEGER bi,bj
65        INTEGER irecord        INTEGER irecord
66        INTEGER myIter        INTEGER myIter
# Line 74  C !LOCAL VARIABLES: Line 76  C !LOCAL VARIABLES:
76        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName
77        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
78        LOGICAL fileIsOpen        LOGICAL fileIsOpen
79        INTEGER iG,jG,iRec,k,dUnit,IL,pIL        INTEGER iG,jG,iRec,dUnit,IL,pIL
80        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
81        INTEGER length_of_rec        INTEGER length_of_rec
82        INTEGER loc_size        INTEGER loc_size
83        PARAMETER( loc_size = Nx+Ny+Nr )        PARAMETER( loc_size = Nx+Ny+Nr )
84        real*4 r4seg(loc_size)        Real*4 r4seg(loc_size)
85        real*8 r8seg(loc_size)        Real*8 r8seg(loc_size)
86        _RL dummyRL(1)        _RL dummyRL(1)
87        CHARACTER*8 blank8c        CHARACTER*8 blank8c
88  CEOP  CEOP
# Line 112  C Record number must be >= 1 Line 114  C Record number must be >= 1
114          ENDIF          ENDIF
115    
116  C Check buffer size  C Check buffer size
117          IF ( nArr.GT.loc_size ) THEN          IF ( nSize.GT.loc_size ) THEN
118            WRITE(msgBuf,'(3A)')            WRITE(msgBuf,'(3A)')
119       &     ' MDS_WRITEVEC_LOC: writing to file "', fName(1:IL), '":'       &     ' MDS_WRITEVEC_LOC: writing to file "', fName(1:IL), '":'
120            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
121            WRITE(msgBuf,'(A,I9)')            WRITE(msgBuf,'(A,I9)')
122       &      ' MDS_WRITEVEC_LOC: dim of arr to write=', nArr       &      ' MDS_WRITEVEC_LOC: dim of array to write=', nSize
123            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
124            WRITE(msgBuf,'(A,I9)')            WRITE(msgBuf,'(A,I9)')
125       &      ' MDS_WRITEVEC_LOC: exceeds buffer size=', loc_size       &      ' MDS_WRITEVEC_LOC: exceeds buffer size=', loc_size
# Line 158  C-    we are writing a tiled array (bi>0 Line 160  C-    we are writing a tiled array (bi>0
160            ENDIF            ENDIF
161    
162  C--   Open the file:  C--   Open the file:
163            length_of_rec=MDS_RECLEN( filePrec, nArr, myThid )            length_of_rec=MDS_RECLEN( filePrec, nSize, myThid )
164            IF (iRec .EQ. 1) THEN            IF (iRec .EQ. 1) THEN
165              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
166       &            access='direct', recl=length_of_rec )       &            access='direct', recl=length_of_rec )
# Line 179  C- End if block: File Unit is already op Line 181  C- End if block: File Unit is already op
181    
182          IF (fileIsOpen) THEN          IF (fileIsOpen) THEN
183            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
184              CALL MDS_WR_REC_RS( arr, r4seg, r8seg,              CALL MDS_WR_REC_RS( fldRS, r4seg, r8seg,
185       I                          filePrec, dUnit, iRec, nArr, myThid )       I                          filePrec, dUnit, iRec, nSize, myThid )
186            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
187              CALL MDS_WR_REC_RL( arr, r4seg, r8seg,              CALL MDS_WR_REC_RL( fldRL, r4seg, r8seg,
188       I                          filePrec, dUnit, iRec, nArr, myThid )       I                          filePrec, dUnit, iRec, nSize, myThid )
189            ELSE            ELSE
190              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
191       &          ' MDS_WRITEVEC_LOC: illegal value for arrType'       &          ' MDS_WRITEVEC_LOC: illegal value for arrType'
# Line 228  C--   we are writing a tiled array (bi>0 Line 230  C--   we are writing a tiled array (bi>0
230              dimList(2,2)=jG              dimList(2,2)=jG
231              dimList(3,2)=jG              dimList(3,2)=jG
232            ENDIF            ENDIF
233            dimList(1,3)=nArr            dimList(1,3)=nSize
234            dimList(2,3)=1            dimList(2,3)=1
235            dimList(3,3)=nArr            dimList(3,3)=nSize
236            nDims=3            nDims=3
237            IF ( nArr.EQ.1 ) nDims=2            IF ( nSize.EQ.1 ) nDims=2
238            CALL MDS_WRITE_META(            CALL MDS_WRITE_META(
239       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
240       I              filePrec, nDims, dimList, map2gl, 0, blank8c,       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22