/[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.2 by jmc, Tue Dec 30 02:13:01 2008 UTC revision 1.3 by jmc, Tue Feb 3 22:57:01 2009 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
6    CBOP
7    C !ROUTINE: MDS_WRITEVEC_LOC
8    C !INTERFACE:
9        SUBROUTINE MDS_WRITEVEC_LOC(        SUBROUTINE MDS_WRITEVEC_LOC(
10       I   fName,       I   fName,
11       I   filePrec,       I   filePrec,
12         U   ioUnit,
13       I   arrType,       I   arrType,
14       I   nArr,       I   nArr,
15       I   arr,       I   arr,
# Line 14  C $Name$ Line 18  C $Name$
18       I   myIter,       I   myIter,
19       I   myThid )       I   myThid )
20    
21    C !DESCRIPTION:
22  C Arguments:  C Arguments:
23  C  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
27  C nArr     integer :: number of elements from input array "arr" to be written  C nArr     integer :: number of elements from input array "arr" to be written
28  C arrType  char(2) :: declaration type of "arr": either "RS" or "RL"  C arrType  char(2) :: declaration type of "arr": either "RS" or "RL"
29  C arr       RS/RL  :: array to WRITE, arr(nArr)  C arr       RS/RL  :: array to WRITE, arr(nArr)
30  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
31  C irecord  integer :: record number to WRITE  C irecord  integer :: record number to WRITE =|irecord|
32  C myIter   integer :: time step number  C myIter   integer :: time step number
33  C myThid   integer :: my Thread Id number  C myThid   integer :: my Thread Id number
34  C  C
35  C MDS_WRITEVEC_LOC creates either a file of the form "fName.data" and  C MDS_WRITEVEC_LOC according to ioUnit:
36  C "fName.meta" IF bi=bj=0. Otherwise it creates MDS tiled files of the  C  ioUnit = 0 : open file, write and close the file (return ioUnit=0).
37    C  ioUnit =-1 : open file, write and leave it open (return IO unit in ioUnit)
38    C  ioUnit > 0 : assume file "ioUnit" is open, and write to it.
39    C MDS_WRITEVEC_LOC writes either to a file of the form "fName.data" and
40    C "fName.meta" IF bi=bj=0. Otherwise it writes to MDS tiled files of the
41  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".  C form "fName.xxx.yyy.data" and "fName.xxx.yyy.meta".
42  C A meta-file is always created.  C If irecord>0, a meta-file is created (skipped if irecord<0).
43  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
44  C to floatPrec32 or floatPrec64.  C to floatPrec32 or floatPrec64.
45  C irecord 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.
46    
47    C !USES:
48        IMPLICIT NONE        IMPLICIT NONE
49    
50  C Global variables / common blocks  C Global variables / common blocks
51  #include "SIZE.h"  #include "SIZE.h"
52  #include "EEPARAMS.h"  #include "EEPARAMS.h"
53  #include "PARAMS.h"  #include "PARAMS.h"
54    
55  C Routine arguments  C !INPUT/OUTPUT PARAMETERS:
56        CHARACTER*(*) fName        CHARACTER*(*) fName
57          INTEGER ioUnit
58        INTEGER filePrec        INTEGER filePrec
59        CHARACTER*(2) arrType        CHARACTER*(2) arrType
60        INTEGER nArr        INTEGER nArr
# Line 50  C Routine arguments Line 63  C Routine arguments
63        INTEGER irecord        INTEGER irecord
64        INTEGER myIter        INTEGER myIter
65        INTEGER myThid        INTEGER myThid
66  C Functions  
67    C !FUNCTIONS:
68        INTEGER ILNBLNK        INTEGER ILNBLNK
69        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
70        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
71        EXTERNAL MDS_RECLEN        EXTERNAL MDS_RECLEN
72  C Local variables  
73    C !LOCAL VARIABLES:
74        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName        CHARACTER*(MAX_LEN_FNAM) dataFName, metaFName, pfName
75        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
76        LOGICAL fileIsOpen        LOGICAL fileIsOpen
# Line 66  C Local variables Line 81  C Local variables
81        PARAMETER( loc_size = Nx+Ny+Nr )        PARAMETER( loc_size = Nx+Ny+Nr )
82        real*4 r4seg(loc_size)        real*4 r4seg(loc_size)
83        real*8 r8seg(loc_size)        real*8 r8seg(loc_size)
84    CEOP
85    
86        DATA map2gl / 0, 1 /        DATA map2gl / 0, 1 /
87    
88    C We write a non-tiled array (bi=bj=0) only 1 time (if ProcId=0):
89          IF ( myProcId.EQ.0 .OR. bi.NE.0 .OR. bj.NE.0 ) THEN
90    
91  C Only DO I/O IF I am the master thread  C Only DO I/O IF I am the master thread
92        _BEGIN_MASTER( myThid )          _BEGIN_MASTER( myThid )
93  C--   we write a non-tiled array (bi=bj=0) only 1 time (if ProcId=0):  
94        IF ( (myProcId.EQ.0 .AND. bi.EQ.0 .AND. bj.EQ.0)  C Assume nothing
95       &                     .OR. bi.NE.0 .OR.  bj.NE.0 ) THEN          fileIsOpen = .FALSE.
96            IL  = ILNBLNK( fName )
97            iRec = ABS(irecord)
98    
99  C Record number must be >= 1  C Record number must be >= 1
100          IF (irecord .LT. 1) THEN          IF ( iRec.LT.1 ) THEN
101            WRITE(msgBuf,'(A,I9)')            WRITE(msgBuf,'(A,I9)')
102       &      ' MDS_WRITEVEC_LOC: argument irecord = ',irecord       &      ' MDS_WRITEVEC_LOC: argument irecord = ',irecord
103            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
# Line 86  C Record number must be >= 1 Line 107  C Record number must be >= 1
107            STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'            STOP 'ABNORMAL END: S/R MDS_WRITEVEC_LOC'
108          ENDIF          ENDIF
109    
 C Assume nothing  
         fileIsOpen = .FALSE.  
         IL  = ILNBLNK( fName )  
         iRec = irecord  
   
110  C Check buffer size  C Check buffer size
111          IF ( nArr.GT.loc_size ) THEN          IF ( nArr.GT.loc_size ) THEN
112            WRITE(msgBuf,'(3A)')            WRITE(msgBuf,'(3A)')
# Line 115  C Assign special directory Line 131  C Assign special directory
131           pIL = IL           pIL = IL
132          ENDIF          ENDIF
133    
134  C Assign a free unit number as the I/O channel for this routine          IF ( ioUnit.GT.0 ) THEN
135          CALL MDSFINDUNIT( dUnit, myThid )  C- Assume file Unit is already open with correct Rec-Length & Precision
136              fileIsOpen = .TRUE.
137  C--     Set the file Name:            dUnit = ioUnit
         IF ( bi.EQ.0 .AND. bj.EQ.0 ) THEN  
 C-      we are writing a non-tiled array (bi=bj=0):  
           WRITE(dataFname,'(2A)') fName(1:IL),'.data'  
138          ELSE          ELSE
139  C-      we are writing a tiled array (bi>0,bj>0):  C- Need to open file IO unit with File-name, Rec-Length & Precision
140            iG=bi+(myXGlobalLo-1)/sNx  
141            jG=bj+(myYGlobalLo-1)/sNy  C     Assign a free unit number as the I/O channel for this routine
142            WRITE(dataFname,'(2A,I3.3,A,I3.3,A)')            CALL MDSFINDUNIT( dUnit, myThid )
143    
144    C--   Set the file Name:
145              IF ( bi.EQ.0 .AND. bj.EQ.0 ) THEN
146    C-    we are writing a non-tiled array (bi=bj=0):
147                WRITE(dataFname,'(2A)') fName(1:IL),'.data'
148              ELSE
149    C-    we are writing a tiled array (bi>0,bj>0):
150                iG=bi+(myXGlobalLo-1)/sNx
151                jG=bj+(myYGlobalLo-1)/sNy
152                WRITE(dataFname,'(2A,I3.3,A,I3.3,A)')
153       &             pfName(1:pIL),'.',iG,'.',jG,'.data'       &             pfName(1:pIL),'.',iG,'.',jG,'.data'
154          ENDIF            ENDIF
155    
156          length_of_rec=MDS_RECLEN( filePrec, nArr, myThid )  C--   Open the file:
157          IF (irecord .EQ. 1) THEN            length_of_rec=MDS_RECLEN( filePrec, nArr, myThid )
158            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            IF (iRec .EQ. 1) THEN
159       &          access='direct', recl=length_of_rec )              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
160            fileIsOpen=.TRUE.       &            access='direct', recl=length_of_rec )
161          ELSE              fileIsOpen=.TRUE.
162            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,            ELSE
163       &          access='direct', recl=length_of_rec )              OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
164            fileIsOpen=.TRUE.       &            access='direct', recl=length_of_rec )
165          ENDIF              fileIsOpen=.TRUE.
166          IF ( debugLevel.GE.debLevB ) THEN            ENDIF
167            WRITE(msgBuf,'(2A)')            IF ( debugLevel.GE.debLevB ) THEN
168                WRITE(msgBuf,'(2A)')
169       &      ' MDS_WRITEVEC_LOC: open file: ',dataFname(1:pIL+13)       &      ' MDS_WRITEVEC_LOC: open file: ',dataFname(1:pIL+13)
170            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
171       &                        SQUEEZE_RIGHT , 1)       &                          SQUEEZE_RIGHT , 1)
172              ENDIF
173    C- End if block: File Unit is already open / Need to open it
174          ENDIF          ENDIF
175    
176          IF (fileIsOpen) THEN          IF (fileIsOpen) THEN
# Line 168  C-      we are writing a tiled array (bi Line 194  C-      we are writing a tiled array (bi
194          ENDIF          ENDIF
195    
196  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
197          IF ( fileIsOpen ) THEN          IF ( fileIsOpen .AND. ioUnit.EQ.0 ) THEN
198            CLOSE( dUnit )            CLOSE( dUnit )
199            fileIsOpen = .FALSE.            fileIsOpen = .FALSE.
200          ENDIF          ENDIF
201            IF ( ioUnit.EQ.-1 ) ioUnit = dUnit
202    
203            IF ( irecord.GT.0 ) THEN
204  C Create meta-file for each tile IF we are tiling  C Create meta-file for each tile IF we are tiling
205          IF ( bi.EQ.0 .AND. bj.EQ.0 ) THEN            IF ( bi.EQ.0 .AND. bj.EQ.0 ) THEN
206  C--     we are writing a non-tiled array (bi=bj=0):  C--   we are writing a non-tiled array (bi=bj=0):
207            WRITE(metaFname,'(2A)') fName(1:IL),'.meta'              WRITE(metaFname,'(2A)') fName(1:IL),'.meta'
208            dimList(1,1)=1              dimList(1,1)=1
209            dimList(2,1)=1              dimList(2,1)=1
210            dimList(3,1)=1              dimList(3,1)=1
211            dimList(1,2)=1              dimList(1,2)=1
212            dimList(2,2)=1              dimList(2,2)=1
213            dimList(3,2)=1              dimList(3,2)=1
214          ELSE            ELSE
215  C--     we are writing a tiled array (bi>0,bj>0):  C--   we are writing a tiled array (bi>0,bj>0):
216            iG=bi+(myXGlobalLo-1)/sNx              iG=bi+(myXGlobalLo-1)/sNx
217            jG=bj+(myYGlobalLo-1)/sNy              jG=bj+(myYGlobalLo-1)/sNy
218            WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')              WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
219       &             pfName(1:pIL),'.',iG,'.',jG,'.meta'       &             pfName(1:pIL),'.',iG,'.',jG,'.meta'
220            dimList(1,1)=nSx*nPx              dimList(1,1)=nSx*nPx
221            dimList(2,1)=iG              dimList(2,1)=iG
222            dimList(3,1)=iG              dimList(3,1)=iG
223            dimList(1,2)=nSy*nPy              dimList(1,2)=nSy*nPy
224            dimList(2,2)=jG              dimList(2,2)=jG
225            dimList(3,2)=jG              dimList(3,2)=jG
226          ENDIF            ENDIF
227          dimList(1,3)=nArr            dimList(1,3)=nArr
228          dimList(2,3)=1            dimList(2,3)=1
229          dimList(3,3)=nArr            dimList(3,3)=nArr
230          nDims=3            nDims=3
231          IF (nArr .EQ. 1) nDims=2            IF ( nArr.EQ.1 ) nDims=2
232          CALL MDS_WRITE_META(            CALL MDS_WRITE_META(
233       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
234       I              filePrec, nDims, dimList, map2gl, 0, ' ',       I              filePrec, nDims, dimList, map2gl, 0, ' ',
235       I              0, UNSET_RL, iRec, myIter, myThid )       I              0, UNSET_RL, iRec, myIter, myThid )
236  c    I              metaFName, dataFName, the_run_name, titleLine,          ENDIF
 c    I              filePrec, nDims, dimList, map2gl, nFlds, fldList,  
 c    I              nTimRec, timList, irecord, myIter, myThid )  
237    
238            _END_MASTER( myThid )
239        ENDIF        ENDIF
       _END_MASTER( myThid )  
240    
241        RETURN        RETURN
242        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22