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

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

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

revision 1.2 by adcroft, Thu Sep 27 18:24:45 2001 UTC revision 1.3 by heimbach, Fri Dec 14 18:56:01 2001 UTC
# Line 65  C Local variables Line 65  C Local variables
65        character*(80) dataFName        character*(80) dataFName
66        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
67        logical exst        logical exst
68        Real*4 r4seg(sNx+2*oLx)        Real*4 r4seg(sNx)
69        Real*8 r8seg(sNx+2*oLx)        Real*8 r8seg(sNx)
70        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
71        integer length_of_rec        integer length_of_rec
72        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
# Line 121  C If negative check for global file with Line 121  C If negative check for global file with
121    
122  C If we are reading from a global file then we open it here  C If we are reading from a global file then we open it here
123        if (globalFile) then        if (globalFile) then
124         length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )         length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
125         open( dUnit, file=dataFName, status='old',         open( dUnit, file=dataFName, status='old',
126       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
127         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
# Line 144  C (This is a place-holder for the active Line 144  C (This is a place-holder for the active
144       &      ' MDSREADFIELDXZ: opening file: ',dataFName       &      ' MDSREADFIELDXZ: opening file: ',dataFName
145            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
146       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
147            length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
148            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
149       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
150            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 176  C (This is a place-holder for the active Line 176  C (This is a place-holder for the active
176             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
177              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
178  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
179              call MDS_BYTESWAPR4(sNx+2*oLx,r4seg)              call MDS_BYTESWAPR4(sNx,r4seg)
180  #endif  #endif
181              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
182               call MDS_SEG4toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r4seg,arr)               call MDS_SEG4toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r4seg,arr)
# Line 191  C (This is a place-holder for the active Line 191  C (This is a place-holder for the active
191             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
192              read(dUnit,rec=irec) r8seg              read(dUnit,rec=irec) r8seg
193  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
194              call MDS_BYTESWAPR8( sNx+2*oLx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
195  #endif  #endif
196              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
197               call MDS_SEG8toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r8seg,arr)               call MDS_SEG8toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r8seg,arr)
# Line 288  C Local variables Line 288  C Local variables
288        character*(80) dataFName        character*(80) dataFName
289        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
290        logical exst        logical exst
291        Real*4 r4seg(sNy+2*oLy)        Real*4 r4seg(sNy)
292        Real*8 r8seg(sNy+2*oLy)        Real*8 r8seg(sNy)
293        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
294        integer length_of_rec        integer length_of_rec
295        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
# Line 344  C If negative check for global file with Line 344  C If negative check for global file with
344    
345  C If we are reading from a global file then we open it here  C If we are reading from a global file then we open it here
346        if (globalFile) then        if (globalFile) then
347         length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )         length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
348         open( dUnit, file=dataFName, status='old',         open( dUnit, file=dataFName, status='old',
349       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
350         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
# Line 367  C (This is a place-holder for the active Line 367  C (This is a place-holder for the active
367       &      ' MDSREADFIELDYZ: opening file: ',dataFName       &      ' MDSREADFIELDYZ: opening file: ',dataFName
368            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
369       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
370            length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
371            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
372       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
373            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 387  C (This is a place-holder for the active Line 387  C (This is a place-holder for the active
387          if (fileIsOpen) then          if (fileIsOpen) then
388           do k=1,nNz           do k=1,nNz
389             if (globalFile) then             if (globalFile) then
390              iG = myXGlobalLo-1 + (bi-1)*sNx              iG = (myXGlobalLo-1)/sNx + (bi-1)
391              jG = (myYGlobalLo-1)/sNy + (bj-1)              jG = myYGlobalLo-1 + (bj-1)*sNy
392              irec=1 + INT(iG/sNx) + nSx*nPx*jG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(jG/sNy) + nSy*nPy*iG + nSx*nPx*nSy*nPy*(k-1)
393       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)
394             else             else
395              iG = 0              iG = 0
# Line 399  C (This is a place-holder for the active Line 399  C (This is a place-holder for the active
399             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
400              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
401  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
402              call MDS_BYTESWAPR4(sNy+2*oLy,r4seg)              call MDS_BYTESWAPR4(sNy,r4seg)
403  #endif  #endif
404              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
405               call MDS_SEG4toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r4seg,arr)               call MDS_SEG4toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r4seg,arr)
# Line 414  C (This is a place-holder for the active Line 414  C (This is a place-holder for the active
414             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
415              read(dUnit,rec=irec) r8seg              read(dUnit,rec=irec) r8seg
416  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
417              call MDS_BYTESWAPR8( sNy+2*oLy, r8seg )              call MDS_BYTESWAPR8( sNy, r8seg )
418  #endif  #endif
419              if (arrType .eq. 'RS') then              if (arrType .eq. 'RS') then
420               call MDS_SEG8toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r8seg,arr)               call MDS_SEG8toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r8seg,arr)
# Line 516  C Functions Line 516  C Functions
516  C Local variables  C Local variables
517        character*(80) dataFName        character*(80) dataFName
518        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
519        Real*4 r4seg(sNx+2*oLx)        Real*4 r4seg(sNx)
520        Real*8 r8seg(sNx+2*oLx)        Real*8 r8seg(sNx)
521        integer length_of_rec        integer length_of_rec
522        logical fileIsOpen        logical fileIsOpen
523        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
# Line 549  C If we are writing to a global file the Line 549  C If we are writing to a global file the
549        if (globalFile) then        if (globalFile) then
550         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
551         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
552          length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
553          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
554       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
555          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
556         else         else
557          length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
558          open( dUnit, file=dataFName, status='old',          open( dUnit, file=dataFName, status='old',
559       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
560          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
# Line 571  C If we are writing to a tiled MDS file Line 571  C If we are writing to a tiled MDS file
571           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
572       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
573           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
574            length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
575            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
576       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
577            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
578           else           else
579            length_of_rec=MDS_RECLEN( filePrec, sNx+2*oLx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
580            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
581       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
582            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 606  C If we are writing to a tiled MDS file Line 606  C If we are writing to a tiled MDS file
606               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'
607              endif              endif
608  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
609              call MDS_BYTESWAPR4(sNx+2*oLx,r4seg)              call MDS_BYTESWAPR4(sNx,r4seg)
610  #endif  #endif
611              write(dUnit,rec=irec) r4seg              write(dUnit,rec=irec) r4seg
612             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
# Line 621  C If we are writing to a tiled MDS file Line 621  C If we are writing to a tiled MDS file
621               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDXZ'
622              endif                            endif              
623  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
624              call MDS_BYTESWAPR8( sNx+2*oLx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
625  #endif  #endif
626              write(dUnit,rec=irec) r8seg              write(dUnit,rec=irec) r8seg
627             else             else
# Line 725  C Functions Line 725  C Functions
725  C Local variables  C Local variables
726        character*(80) dataFName        character*(80) dataFName
727        integer iG,jG,irec,bi,bj,k,dUnit,IL        integer iG,jG,irec,bi,bj,k,dUnit,IL
728        Real*4 r4seg(sNy+2*oLy)        Real*4 r4seg(sNy)
729        Real*8 r8seg(sNy+2*oLy)        Real*8 r8seg(sNy)
730        integer length_of_rec        integer length_of_rec
731        logical fileIsOpen        logical fileIsOpen
732        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
# Line 758  C If we are writing to a global file the Line 758  C If we are writing to a global file the
758        if (globalFile) then        if (globalFile) then
759         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
760         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
761          length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
762          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
763       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
764          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
765         else         else
766          length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )          length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
767          open( dUnit, file=dataFName, status='old',          open( dUnit, file=dataFName, status='old',
768       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
769          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
# Line 780  C If we are writing to a tiled MDS file Line 780  C If we are writing to a tiled MDS file
780           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
781       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
782           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
783            length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
784            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
785       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
786            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
787           else           else
788            length_of_rec=MDS_RECLEN( filePrec, sNy+2*oLy, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
789            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
790       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
791            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 794  C If we are writing to a tiled MDS file Line 794  C If we are writing to a tiled MDS file
794          if (fileIsOpen) then          if (fileIsOpen) then
795           do k=1,nNz           do k=1,nNz
796             if (globalFile) then             if (globalFile) then
797              iG = myXGlobalLo-1 + (bi-1)*sNx              iG = (myXGlobalLo-1)/sNx + (bi-1)
798              jG = (myYGlobalLo-1)/sNy + (bj-1)              jG = myYGlobalLo-1 + (bj-1)*sNy
799              irec=1 + INT(iG/sNx) + nSx*nPx*jG + nSx*nPx*nSy*nPy*(k-1)              irec=1 + INT(jG/sNy) + nSy*nPy*iG + nSx*nPx*nSy*nPy*(k-1)
800       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)       &           + nSx*nPx*nSy*nPy*nNz*(irecord-1)
801             else             else
802              iG = 0              iG = 0
# Line 815  C If we are writing to a tiled MDS file Line 815  C If we are writing to a tiled MDS file
815               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'
816              endif              endif
817  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
818              call MDS_BYTESWAPR4(sNy+2*oLy,r4seg)              call MDS_BYTESWAPR4(sNy,r4seg)
819  #endif  #endif
820              write(dUnit,rec=irec) r4seg              write(dUnit,rec=irec) r4seg
821             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
# Line 830  C If we are writing to a tiled MDS file Line 830  C If we are writing to a tiled MDS file
830               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'               stop 'ABNORMAL END: S/R MDSWRITEFIELDYZ'
831              endif                          endif            
832  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
833              call MDS_BYTESWAPR8( sNy+2*oLy, r8seg )              call MDS_BYTESWAPR8( sNy, r8seg )
834  #endif  #endif
835              write(dUnit,rec=irec) r8seg              write(dUnit,rec=irec) r8seg
836             else             else
# Line 893  C Global variables / common blocks Line 893  C Global variables / common blocks
893  C Arguments  C Arguments
894        integer sn,ol,nNz,bi,bj,k        integer sn,ol,nNz,bi,bj,k
895        logical copyTo        logical copyTo
896        Real*4 seg(sn+2*ol)        Real*4 seg(sn)
897        _RL arr(1-ol:sn+ol,nNz,nSx,nSy)        _RL arr(1-ol:sn+ol,nNz,nSx,nSy)
898            
899  C Local  C Local
900        integer ii        integer ii
901  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
902        if (copyTo) then        if (copyTo) then
903         do ii=1-ol,sn+ol         do ii=1,sn
904          arr(ii,k,bi,bj)=seg(ii+ol)          arr(ii,k,bi,bj)=seg(ii)
905         enddo         enddo
906        else        else
907         do ii=1-ol,sn+ol         do ii=1,sn
908          seg(ii+ol)=arr(ii,k,bi,bj)          seg(ii)=arr(ii,k,bi,bj)
909         enddo         enddo
910        endif        endif
911  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 933  C Global variables / common blocks Line 933  C Global variables / common blocks
933  C Arguments  C Arguments
934        integer sn,ol,nNz,bi,bj,k        integer sn,ol,nNz,bi,bj,k
935        logical copyTo        logical copyTo
936        Real*4 seg(sn+2*ol)        Real*4 seg(sn)
937        _RS arr(1-ol:sn+ol,nNz,nSx,nSy)        _RS arr(1-ol:sn+ol,nNz,nSx,nSy)
938            
939  C Local  C Local
940        integer ii        integer ii
941  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
942        if (copyTo) then        if (copyTo) then
943         do ii=1-ol,sn+ol         do ii=1,sn
944          arr(ii,k,bi,bj)=seg(ii+ol)          arr(ii,k,bi,bj)=seg(ii)
945         enddo         enddo
946        else        else
947         do ii=1-ol,sn+ol         do ii=1,sn
948          seg(ii+ol)=arr(ii,k,bi,bj)          seg(ii)=arr(ii,k,bi,bj)
949         enddo         enddo
950        endif        endif
951  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 973  C Global variables / common blocks Line 973  C Global variables / common blocks
973  C Arguments  C Arguments
974        integer sn,ol,nNz,bi,bj,k        integer sn,ol,nNz,bi,bj,k
975        logical copyTo        logical copyTo
976        Real*8 seg(sn+2*ol)        Real*8 seg(sn)
977        _RL arr(1-ol:sn+ol,nNz,nSx,nSy)        _RL arr(1-ol:sn+ol,nNz,nSx,nSy)
978            
979  C Local  C Local
980        integer ii        integer ii
981  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
982        if (copyTo) then        if (copyTo) then
983         do ii=1-ol,sn+ol         do ii=1,sn
984          arr(ii,k,bi,bj)=seg(ii+ol)          arr(ii,k,bi,bj)=seg(ii)
985         enddo         enddo
986        else        else
987         do ii=1-ol,sn+ol         do ii=1,sn
988          seg(ii+ol)=arr(ii,k,bi,bj)          seg(ii)=arr(ii,k,bi,bj)
989         enddo         enddo
990        endif        endif
991  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 1013  C Global variables / common blocks Line 1013  C Global variables / common blocks
1013  C Arguments  C Arguments
1014        integer sn,ol,nNz,bi,bj,k        integer sn,ol,nNz,bi,bj,k
1015        logical copyTo        logical copyTo
1016        Real*8 seg(sn+2*ol)        Real*8 seg(sn)
1017        _RS arr(1-ol:sn+ol,nNz,nSx,nSy)        _RS arr(1-ol:sn+ol,nNz,nSx,nSy)
1018            
1019  C Local  C Local
1020        integer ii        integer ii
1021  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1022        if (copyTo) then        if (copyTo) then
1023         do ii=1-ol,sn+ol         do ii=1,sn
1024          arr(ii,k,bi,bj)=seg(ii+ol)          arr(ii,k,bi,bj)=seg(ii)
1025         enddo         enddo
1026        else        else
1027         do ii=1-ol,sn+ol         do ii=1,sn
1028          seg(ii+ol)=arr(ii,k,bi,bj)          seg(ii)=arr(ii,k,bi,bj)
1029         enddo         enddo
1030        endif        endif
1031  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22