/[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.17 by jmc, Tue Jan 5 02:55:14 2010 UTC revision 1.20 by jmc, Thu Aug 2 02:07:03 2012 UTC
# Line 23  C---+----1----+----2----+----3----+----4 Line 23  C---+----1----+----2----+----3----+----4
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 98  C     ---------------------------------- Line 98  C     ----------------------------------
98  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
99        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
100    
101    #ifndef REAL4_IS_SLOW
102          if (arrType .eq. 'RS') then
103           write(msgbuf,'(a)')
104         &   ' MDSREADFIELD_GL is wrong for arrType="RS" (=real*4)'
105           call print_error( msgbuf, mythid )
106           stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
107          endif
108    #endif
109    
110  C Record number must be >= 1  C Record number must be >= 1
111        if (irecord .LT. 1) then        if (irecord .LT. 1) then
112         write(msgbuf,'(a,i9.8)')         write(msgbuf,'(a,i9.8)')
# Line 227  C If we are reading from a tiled MDS fil Line 236  C If we are reading from a tiled MDS fil
236  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"
237  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
238           if (exst) then           if (exst) then
239            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevB ) then
240             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
241       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
242             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
# Line 272  C (This is a place-holder for the active Line 281  C (This is a place-holder for the active
281              call MDS_BYTESWAPR4( sNx, r4seg )              call MDS_BYTESWAPR4( sNx, r4seg )
282  #endif  #endif
283              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
284    #ifdef REAL4_IS_SLOW
285               call MDS_SEG4toRS( j,bi,bj,k,Nr, r4seg, .TRUE., arr )               call MDS_SEG4toRS( j,bi,bj,k,Nr, r4seg, .TRUE., arr )
286    #endif
287              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
288               call MDS_SEG4toRL( j,bi,bj,k,Nr, r4seg, .TRUE., arr )               call MDS_SEG4toRL( j,bi,bj,k,Nr, r4seg, .TRUE., arr )
289              else              else
# Line 287  C (This is a place-holder for the active Line 298  C (This is a place-holder for the active
298              call MDS_BYTESWAPR8( sNx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
299  #endif  #endif
300              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
301    #ifdef REAL4_IS_SLOW
302               call MDS_SEG8toRS( j,bi,bj,k,Nr, r8seg, .TRUE., arr )               call MDS_SEG8toRS( j,bi,bj,k,Nr, r8seg, .TRUE., arr )
303    #endif
304              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
305               call MDS_SEG8toRL( j,bi,bj,k,Nr, r8seg, .TRUE., arr )               call MDS_SEG8toRL( j,bi,bj,k,Nr, r8seg, .TRUE., arr )
306              else              else
# Line 416  C---+----1----+----2----+----3----+----4 Line 429  C---+----1----+----2----+----3----+----4
429  C  C
430  C Arguments:  C Arguments:
431  C  C
432  C fName         string  base name for file to written  C fName     (string)  :: base name for file to write
433  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)
434  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
435  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
436  C arr           RS/RL   array to write, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to write, arr(:,:,nNz,:,:)
437  C irecord       integer record number to read  C irecord   (integer) :: record number to write
438  C myIter        integer time step number  C myIter    (integer) :: time step number
439  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
440  C  C
441  C MDSWRITEFIELD creates either a file of the form "fName.data" and  C MDSWRITEFIELD creates either a file of the form "fName.data" and
442  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 510  C     ---------------------------------- Line 523  C     ----------------------------------
523  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
524        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
525    
526    #ifndef REAL4_IS_SLOW
527          if (arrType .eq. 'RS') then
528           write(msgbuf,'(a)')
529         &   ' MDSWRITEFIELD_GL is wrong for arrType="RS" (=real*4)'
530           call print_error( msgbuf, mythid )
531           stop 'ABNORMAL END: S/R MDSWRITEFIELD_GL'
532          endif
533    #endif
534    
535  C Record number must be >= 1  C Record number must be >= 1
536        if (irecord .LT. 1) then        if (irecord .LT. 1) then
537         write(msgbuf,'(a,i9.8)')         write(msgbuf,'(a,i9.8)')
# Line 676  C If we are writing to a tiled MDS file Line 698  C If we are writing to a tiled MDS file
698              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)
699             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
700              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
701    #ifdef REAL4_IS_SLOW
702               call MDS_SEG4toRS( j,bi,bj,k,Nr, r4seg, .FALSE., arr )               call MDS_SEG4toRS( j,bi,bj,k,Nr, r4seg, .FALSE., arr )
703    #endif
704              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
705               call MDS_SEG4toRL( j,bi,bj,k,Nr, r4seg, .FALSE., arr )               call MDS_SEG4toRL( j,bi,bj,k,Nr, r4seg, .FALSE., arr )
706              else              else
# Line 691  C If we are writing to a tiled MDS file Line 715  C If we are writing to a tiled MDS file
715              write(dUnit,rec=irec) r4seg              write(dUnit,rec=irec) r4seg
716             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
717              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
718    #ifdef REAL4_IS_SLOW
719               call MDS_SEG8toRS( j,bi,bj,k,Nr, r8seg, .FALSE., arr )               call MDS_SEG8toRS( j,bi,bj,k,Nr, r8seg, .FALSE., arr )
720    #endif
721              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
722               call MDS_SEG8toRL( j,bi,bj,k,Nr, r8seg, .FALSE., arr )               call MDS_SEG8toRL( j,bi,bj,k,Nr, r8seg, .FALSE., arr )
723              else              else
# Line 783  C---+----1----+----2----+----3----+----4 Line 809  C---+----1----+----2----+----3----+----4
809  C  C
810  C Arguments:  C Arguments:
811  C  C
812  C fName         string  base name for file to read  C fName     (string)  :: base name for file to read
813  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)
814  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
815  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
816  C arr           RS/RL   array to read into, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to read into, arr(:,:,nNz,:,:)
817  C irecord       integer record number to read  C irecord   (integer) :: record number to read
818  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
819  C  C
820  C MDSREADFIELD first checks to see if the file "fName" exists, then  C MDSREADFIELD first checks to see if the file "fName" exists, then
821  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 859  C     ---------------------------------- Line 885  C     ----------------------------------
885  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
886        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
887    
888    #ifndef REAL4_IS_SLOW
889          if (arrType .eq. 'RS') then
890           write(msgbuf,'(a)')
891         &   ' MDSREADFIELD_GL is wrong for arrType="RS" (=real*4)'
892           call print_error( msgbuf, mythid )
893           stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
894          endif
895    #endif
896    
897  C Record number must be >= 1  C Record number must be >= 1
898        if (irecord .LT. 1) then        if (irecord .LT. 1) then
899         write(msgbuf,'(a,i9.8)')         write(msgbuf,'(a,i9.8)')
# Line 988  C If we are reading from a tiled MDS fil Line 1023  C If we are reading from a tiled MDS fil
1023  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"
1024  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
1025           if (exst) then           if (exst) then
1026            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevB ) then
1027             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
1028       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
1029             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
# Line 1033  C (This is a place-holder for the active Line 1068  C (This is a place-holder for the active
1068              call MDS_BYTESWAPR4( sNx, r4seg )              call MDS_BYTESWAPR4( sNx, r4seg )
1069  #endif  #endif
1070              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
1071    #ifdef REAL4_IS_SLOW
1072               call MDS_SEG4toRS( j,bi,bj,k,nLocz, r4seg, .TRUE., arr )               call MDS_SEG4toRS( j,bi,bj,k,nLocz, r4seg, .TRUE., arr )
1073    #endif
1074              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
1075               call MDS_SEG4toRL( j,bi,bj,k,nLocz, r4seg, .TRUE., arr )               call MDS_SEG4toRL( j,bi,bj,k,nLocz, r4seg, .TRUE., arr )
1076              else              else
# Line 1048  C (This is a place-holder for the active Line 1085  C (This is a place-holder for the active
1085              call MDS_BYTESWAPR8( sNx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
1086  #endif  #endif
1087              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
1088    #ifdef REAL4_IS_SLOW
1089               call MDS_SEG8toRS( j,bi,bj,k,nLocz, r8seg, .TRUE., arr )               call MDS_SEG8toRS( j,bi,bj,k,nLocz, r8seg, .TRUE., arr )
1090    #endif
1091              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
1092               call MDS_SEG8toRL( j,bi,bj,k,nLocz, r8seg, .TRUE., arr )               call MDS_SEG8toRL( j,bi,bj,k,nLocz, r8seg, .TRUE., arr )
1093              else              else
# Line 1177  C---+----1----+----2----+----3----+----4 Line 1216  C---+----1----+----2----+----3----+----4
1216  C  C
1217  C Arguments:  C Arguments:
1218  C  C
1219  C fName         string  base name for file to written  C fName     (string)  :: base name for file to write
1220  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)
1221  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: type of array "arr": either "RS" or "RL"
1222  C nNz           integer size of third dimension: normally either 1 or Nr  C nNz       (integer) :: size of third dimension: normally either 1 or Nr
1223  C arr           RS/RL   array to write, arr(:,:,nNz,:,:)  C arr        (RS/RL)  :: array to write, arr(:,:,nNz,:,:)
1224  C irecord       integer record number to read  C irecord   (integer) :: record number to write
1225  C myIter        integer time step number  C myIter    (integer) :: time step number
1226  C myThid        integer thread identifier  C myThid    (integer) :: thread identifier
1227  C  C
1228  C MDSWRITEFIELD creates either a file of the form "fName.data" and  C MDSWRITEFIELD creates either a file of the form "fName.data" and
1229  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 1272  C     ---------------------------------- Line 1311  C     ----------------------------------
1311  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
1312        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
1313    
1314    #ifndef REAL4_IS_SLOW
1315          if (arrType .eq. 'RS') then
1316           write(msgbuf,'(a)')
1317         &   ' MDSWRITEFIELD_GL is wrong for arrType="RS" (=real*4)'
1318           call print_error( msgbuf, mythid )
1319           stop 'ABNORMAL END: S/R MDSWRITEFIELD_GL'
1320          endif
1321    #endif
1322    
1323  C Record number must be >= 1  C Record number must be >= 1
1324        if (irecord .LT. 1) then        if (irecord .LT. 1) then
1325         write(msgbuf,'(a,i9.8)')         write(msgbuf,'(a,i9.8)')
# Line 1439  C If we are writing to a tiled MDS file Line 1487  C If we are writing to a tiled MDS file
1487              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)
1488             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
1489              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
1490    #ifdef REAL4_IS_SLOW
1491               call MDS_SEG4toRS( j,bi,bj,k,nLocz, r4seg, .FALSE., arr )               call MDS_SEG4toRS( j,bi,bj,k,nLocz, r4seg, .FALSE., arr )
1492    #endif
1493              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
1494               call MDS_SEG4toRL( j,bi,bj,k,nLocz, r4seg, .FALSE., arr )               call MDS_SEG4toRL( j,bi,bj,k,nLocz, r4seg, .FALSE., arr )
1495              else              else
# Line 1454  C If we are writing to a tiled MDS file Line 1504  C If we are writing to a tiled MDS file
1504              write(dUnit,rec=irec) r4seg              write(dUnit,rec=irec) r4seg
1505             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
1506              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
1507    #ifdef REAL4_IS_SLOW
1508               call MDS_SEG8toRS( j,bi,bj,k,nLocz, r8seg, .FALSE., arr )               call MDS_SEG8toRS( j,bi,bj,k,nLocz, r8seg, .FALSE., arr )
1509    #endif
1510              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
1511               call MDS_SEG8toRL( j,bi,bj,k,nLocz, r8seg, .FALSE., arr )               call MDS_SEG8toRL( j,bi,bj,k,nLocz, r8seg, .FALSE., arr )
1512              else              else
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22