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

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

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

revision 1.2 by jmc, Mon Mar 19 02:30:49 2007 UTC revision 1.5 by jahn, Tue Dec 30 00:13:35 2008 UTC
# Line 12  C !INTERFACE: Line 12  C !INTERFACE:
12       I   globalFile,       I   globalFile,
13       I   useCurrentDir,       I   useCurrentDir,
14       I   arrType,       I   arrType,
15       I   zSize,nNz,       I   kSize,kLo,kHi,
16       I   arr,       I   arr,
17       I   jrecord,       I   jrecord,
18       I   myIter,       I   myIter,
# Line 27  C globalFile (logical):: selects between Line 27  C globalFile (logical):: selects between
27  C useCurrentDir(logic):: always write to the current directory (even if  C useCurrentDir(logic):: always write to the current directory (even if
28  C                        "mdsioLocalDir" is set)  C                        "mdsioLocalDir" is set)
29  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
30  C zSize     (integer) :: size of third dimension: normally either 1 or Nr  C kSize     (integer) :: size of third dimension: normally either 1 or Nr
31  C nNz       (integer) :: number of vertical levels to write  C kLo       (integer) :: 1rst vertical level (of array "arr") to write
32  C arr       ( RS/RL ) :: array to write, arr(:,:,zSize,:,:)  C kHi       (integer) :: last vertical level (of array "arr") to write
33    C arr       ( RS/RL ) :: array to write, arr(:,:,kSize,:,:)
34  C irecord   (integer) :: record number to write  C irecord   (integer) :: record number to write
35  C myIter    (integer) :: time step number  C myIter    (integer) :: time step number
36  C myThid    (integer) :: thread identifier  C myThid    (integer) :: thread identifier
37  C  C
38  C MDS_WRITE_FIELD creates either a file of the form "fName.data" and  C MDS_WRITE_FIELD creates either a file of the form "fName.data" and
39  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise  C  "fName.meta" if the logical flag "globalFile" is set true. Otherwise
40  C it creates MDS tiled files of the form "fName.xxx.yyy.data" and  C  it creates MDS tiled files of the form "fName.xxx.yyy.data" and
41  C "fName.xxx.yyy.meta". If jrecord > 0, a meta-file is created.  C  "fName.xxx.yyy.meta". If jrecord > 0, a meta-file is created.
42  C Currently, the meta-files are not read because it is difficult  C Currently, the meta-files are not read because it is difficult
43  C to parse files in fortran. We should read meta information before  C  to parse files in fortran. We should read meta information before
44  C adding records to an existing multi-record file.  C  adding records to an existing multi-record file.
45  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
46  C to floatPrec32 or floatPrec64. The precision or declaration of  C  to floatPrec32 or floatPrec64. The precision or declaration of
47  C the array argument must be consistently described by the char*(2)  C  the array argument must be consistently described by the char*(2)
48  C string arrType, either "RS" or "RL". nNz allows for both 2-D and  C  string arrType, either "RS" or "RL".
49  C 3-D arrays to be handled. nNz=1 implies a 2-D model field and  C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with
50  C nNz=Nr implies a 3-D model field. irecord=|jrecord| is the record number  C  the option to only write a sub-set of consecutive vertical levels (from
51  C to be written and must be >= 1. NOTE: It is currently assumed that  C  kLo to kHi); (kSize,kLo,kHi)=(1,1,1) implies a 2-D model field and
52  C the highest record number in the file was the last record written.  C  (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.
53  C Nor is there a consistency check between the routine arguments and file.  C irecord=|jrecord| is the record number to be written and must be >= 1.
54  C ie. if you write record 2 after record 4 the meta information  C NOTE: It is currently assumed that the highest record number in the file
55  C will record the number of records to be 2. This, again, is because  C  was the last record written. Nor is there a consistency check between the
56  C we have read the meta information. To be fixed.  C  routine arguments and file, i.e., if you write record 2 after record 4
57    C  the meta information will record the number of records to be 2. This,
58    C  again, is because we have read the meta information. To be fixed.
59  C  C
60  C Created: 03/16/99 adcroft@mit.edu  C Created: 03/16/99 adcroft@mit.edu
61  C Changed: 01/06/02 menemenlis@jpl.nasa.gov  C Changed: 01/06/02 menemenlis@jpl.nasa.gov
# Line 80  C !INPUT PARAMETERS: Line 83  C !INPUT PARAMETERS:
83        LOGICAL globalFile        LOGICAL globalFile
84        LOGICAL useCurrentDir        LOGICAL useCurrentDir
85        CHARACTER*(2) arrType        CHARACTER*(2) arrType
86        INTEGER zSize, nNz        INTEGER kSize, kLo, kHi
87  cph(  cph(
88  cph      Real arr(*)  cph      Real arr(*)
89        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,zSize,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,kSize,nSx,nSy)
90  cph)  cph)
91        INTEGER jrecord        INTEGER jrecord
92        INTEGER myIter        INTEGER myIter
# Line 105  C !LOCAL VARIABLES: Line 108  C !LOCAL VARIABLES:
108        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
109        LOGICAL writeMetaF        LOGICAL writeMetaF
110        INTEGER irecord        INTEGER irecord
111        INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,bi,bj,i,j,k,nNz
112          INTEGER irec,dUnit,IL,pIL
113        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
114        INTEGER iGjLoc, jGjLoc        INTEGER iGjLoc, jGjLoc
115        INTEGER x_size,y_size,length_of_rec        INTEGER length_of_rec
116  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
117        INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo        INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo
       PARAMETER ( x_size = exch2_domain_nxt * sNx )  
       PARAMETER ( y_size = exch2_domain_nyt * sNy )  
 #else  
       PARAMETER ( x_size = Nx )  
       PARAMETER ( y_size = Ny )  
118  #endif  #endif
119        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
120        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
       Real*4 xy_buffer_r4(x_size,y_size)  
       Real*8 xy_buffer_r8(x_size,y_size)  
       Real*8 globalBuf(Nx,Ny)  
121  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
122  c     INTEGER tGy,tGx,tNy,tNx,tN  c     INTEGER tGy,tGx,tNy,tNx,tN
123        INTEGER tGy,tGx,    tNx,tN        INTEGER tGy,tGx,    tNx,tN
# Line 138  C Assume nothing Line 134  C Assume nothing
134        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
135        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
136        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
137          nNz = 1 + kHi - kLo
138        irecord = ABS(jrecord)        irecord = ABS(jrecord)
139        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
140    
# Line 158  C Record number must be >= 1 Line 155  C Record number must be >= 1
155           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
156           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
157          ENDIF          ENDIF
158    C check for valid sub-set of levels:
159            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
160             WRITE(msgBuf,'(3(A,I6))')
161         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
162         &     ' , kLo=', kLo, ' , kHi=', kHi
163             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
164         &                       SQUEEZE_RIGHT , myThid)
165             WRITE(msgBuf,'(A)')
166         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
167             CALL PRINT_ERROR( msgBuf, myThid )
168             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
169            ENDIF
170    
171  C Assign special directory  C Assign special directory
172          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
# Line 191  C Master thread of process 0, only, open Line 200  C Master thread of process 0, only, open
200         ENDIF         ENDIF
201    
202  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
203         DO k=1,nNz         DO k=kLo,kHi
204  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
205          IF ( arrType.EQ.'RS' ) THEN          IF ( arrType.EQ.'RS' ) THEN
206            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
207          ELSEIF ( arrType.EQ.'RL' ) THEN          ELSEIF ( arrType.EQ.'RL' ) THEN
208            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
209          ELSE          ELSE
210            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
211       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 287  C--    end of npe & bi loops Line 296  C--    end of npe & bi loops
296            ENDIF            ENDIF
297  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
298    
299            irec=k+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
300            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
301  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
302             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
# Line 387  C-         default (face fit into global Line 396  C-         default (face fit into global
396  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
397                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
398       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt
399       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
400       &                   )*y_size*exch2_domain_nxt       &                   )*y_size*exch2_domain_nxt
401  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
402                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
403                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
404                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)
405       &                + nSx*nPx*Ny*(k-1)       &                + nSx*nPx*Ny*(k-kLo)
406       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
407  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
408               ELSE               ELSE
409                irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)
410               ENDIF               ENDIF
411               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
412                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
413                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
414                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
415                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
416                ELSE                ELSE
417                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
418       &           ' MDS_WRITE_FIELD: illegal value for arrType'       &           ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 416  C-         default (face fit into global Line 425  C-         default (face fit into global
425                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
426               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
427                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
428                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
429                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
430                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
431                ELSE                ELSE
432                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
433       &           ' MDS_WRITE_FIELD: illegal value for arrType'       &           ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 518  C Create meta-file for the global-file ( Line 527  C Create meta-file for the global-file (
527           dimList(3,3)=nNz           dimList(3,3)=nNz
528           nDims=3           nDims=3
529           IF ( nNz.EQ.1 ) nDims=2           IF ( nNz.EQ.1 ) nDims=2
530           map2gl(1) = iGjLoc           map2gl(1) = 0
531           map2gl(2) = jGjLoc           map2gl(2) = 1
532           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
533       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
534       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22