/[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.6 by heimbach, Wed Nov 17 03:04:36 2004 UTC revision 1.8 by heimbach, Wed Jan 12 20:33:13 2005 UTC
# Line 67  C Created: 03/16/99 adcroft@mit.edu Line 67  C Created: 03/16/99 adcroft@mit.edu
67  C Global variables / common blocks  C Global variables / common blocks
68  #include "SIZE.h"  #include "SIZE.h"
69  #include "EEPARAMS.h"  #include "EEPARAMS.h"
70    #include "EESUPPORT.h"
71  #include "PARAMS.h"  #include "PARAMS.h"
72    
73  C Routine arguments  C Routine arguments
# Line 137  C If negative check for global file with Line 138  C If negative check for global file with
138          globalFile = .TRUE.          globalFile = .TRUE.
139         endif         endif
140        endif        endif
141    
142          if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
143    
144    C If we are reading from a global file then we open it here
145          if (globalFile) then
146           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
147           open( dUnit, file=dataFName, status='old',
148         &      access='direct', recl=length_of_rec )
149           fileIsOpen=.TRUE.
150          endif
151    
152  C Loop over all processors      C Loop over all processors    
153        do jp=1,nPy        do jp=1,nPy
154        do ip=1,nPx        do ip=1,nPx
# Line 182  C (This is a place-holder for the active Line 194  C (This is a place-holder for the active
194          if (fileIsOpen) then          if (fileIsOpen) then
195           do k=1,Nr           do k=1,Nr
196            do j=1,sNy            do j=1,sNy
197               if (globalFile) then
198                iG=bi+(ip-1)*nsx
199                jG=bj+(jp-1)*nsy
200                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
201         &             + nSx*nPx*Ny*nNz*(irecord-1)
202               else
203              iG = 0              iG = 0
204              jG = 0              jG = 0
205              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)
206               endif
207             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
208              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
209  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 247  C If global file was opened then close i Line 266  C If global file was opened then close i
266         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
267        endif        endif
268    
269          endif
270    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
271    
272        _END_MASTER( myThid )        _END_MASTER( myThid )
273    
274  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 305  C          open(dUnit, ..., status='old' Line 327  C          open(dUnit, ..., status='old'
327  C Global variables / common blocks  C Global variables / common blocks
328  #include "SIZE.h"  #include "SIZE.h"
329  #include "EEPARAMS.h"  #include "EEPARAMS.h"
330    #include "EESUPPORT.h"
331  #include "PARAMS.h"  #include "PARAMS.h"
332    
333  C Routine arguments  C Routine arguments
# Line 324  C Functions Line 347  C Functions
347        integer MDS_RECLEN        integer MDS_RECLEN
348  C Local variables  C Local variables
349        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
350        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
351        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
352        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
353        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)
# Line 332  C Local variables Line 355  C Local variables
355        integer length_of_rec        integer length_of_rec
356        logical fileIsOpen        logical fileIsOpen
357        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
358    cph-usesingle(
359          integer ii,jj
360          integer x_size,y_size,iG_IO,jG_IO,npe
361          PARAMETER ( x_size = Nx )
362          PARAMETER ( y_size = Ny )
363          Real*4 xy_buffer_r4(x_size,y_size)
364          Real*8 xy_buffer_r8(x_size,y_size)
365          Real*8 global(Nx,Ny)
366    cph-usesingle)
367    
368  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
369    
370  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 356  C Assume nothing Line 389  C Assume nothing
389  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
390        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
391    
392    cph-usesingle(
393    #ifdef ALLOW_USE_MPI
394          _END_MASTER( myThid )
395    C If option globalFile is desired but does not work or if
396    C globalFile is too slow, then try using single-CPU I/O.
397          if (useSingleCpuIO) then
398    
399    C Master thread of process 0, only, opens a global file
400           _BEGIN_MASTER( myThid )
401            IF( mpiMyId .EQ. 0 ) THEN
402             write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
403             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
404             if (irecord .EQ. 1) then
405              open( dUnit, file=dataFName, status=_NEW_STATUS,
406         &        access='direct', recl=length_of_rec )
407             else
408              open( dUnit, file=dataFName, status=_OLD_STATUS,
409         &        access='direct', recl=length_of_rec )
410             endif
411            ENDIF
412           _END_MASTER( myThid )
413    
414    C Gather array and write it to file, one vertical level at a time
415           DO k=1,nNz
416    C Loop over all processors    
417            do jp=1,nPy
418            do ip=1,nPx
419            DO bj = myByLo(myThid), myByHi(myThid)
420             DO bi = myBxLo(myThid), myBxHi(myThid)
421              DO J=1,sNy
422               JJ=((jp-1)*nSy+(bj-1))*sNy+J
423               DO I=1,sNx
424                II=((ip-1)*nSx+(bi-1))*sNx+I
425                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
426               ENDDO
427              ENDDO
428             ENDDO
429            ENDDO
430            enddo
431            enddo
432            _BEGIN_MASTER( myThid )
433             IF( mpiMyId .EQ. 0 ) THEN
434              irec=k+nNz*(irecord-1)
435              if (filePrec .eq. precFloat32) then
436               DO J=1,Ny
437                DO I=1,Nx
438                 xy_buffer_r4(I,J) = global(I,J)
439                ENDDO
440               ENDDO
441    #ifdef _BYTESWAPIO
442               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
443    #endif
444               write(dUnit,rec=irec) xy_buffer_r4
445              elseif (filePrec .eq. precFloat64) then
446               DO J=1,Ny
447                DO I=1,Nx
448                 xy_buffer_r8(I,J) = global(I,J)
449                ENDDO
450               ENDDO
451    #ifdef _BYTESWAPIO
452               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
453    #endif
454               write(dUnit,rec=irec) xy_buffer_r8
455              else
456               write(msgbuf,'(a)')
457         &       ' MDSWRITEFIELD: illegal value for filePrec'
458               call print_error( msgbuf, mythid )
459               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
460              endif
461             ENDIF
462            _END_MASTER( myThid )
463           ENDDO
464    
465    C Close data-file and create meta-file
466           _BEGIN_MASTER( myThid )
467            IF( mpiMyId .EQ. 0 ) THEN
468             close( dUnit )
469             write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'
470             dimList(1,1)=Nx
471             dimList(2,1)=1
472             dimList(3,1)=Nx
473             dimList(1,2)=Ny
474             dimList(2,2)=1
475             dimList(3,2)=Ny
476             dimList(1,3)=nNz
477             dimList(2,3)=1
478             dimList(3,3)=nNz
479             ndims=3
480             if (nNz .EQ. 1) ndims=2
481             call MDSWRITEMETA( metaFName, dataFName,
482         &     filePrec, ndims, dimList, irecord, myIter, mythid )
483            ENDIF
484           _END_MASTER( myThid )
485    C To be safe, make other processes wait for I/O completion
486           _BARRIER
487    
488          elseif ( .NOT. useSingleCpuIO ) then
489          _BEGIN_MASTER( myThid )
490    #endif /* ALLOW_USE_MPI */
491    cph-usesingle)
492    
493  C Loop over all processors      C Loop over all processors    
494        do jp=1,nPy        do jp=1,nPy
# Line 464  C End of ip,jp loops Line 597  C End of ip,jp loops
597         enddo         enddo
598        enddo        enddo
599    
   
600        _END_MASTER( myThid )        _END_MASTER( myThid )
601    
602    cph-usesingle(
603    #ifdef ALLOW_USE_MPI
604    C endif useSingleCpuIO
605          endif
606    #endif /* ALLOW_USE_MPI */
607    cph-usesingle)
608    
609  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
610        return        return
611        end        end
# Line 513  C Created: 03/16/99 adcroft@mit.edu Line 652  C Created: 03/16/99 adcroft@mit.edu
652  C Global variables / common blocks  C Global variables / common blocks
653  #include "SIZE.h"  #include "SIZE.h"
654  #include "EEPARAMS.h"  #include "EEPARAMS.h"
655    #include "EESUPPORT.h"
656  #include "PARAMS.h"  #include "PARAMS.h"
657    
658  C Routine arguments  C Routine arguments
# Line 584  C If negative check for global file with Line 724  C If negative check for global file with
724          globalFile = .TRUE.          globalFile = .TRUE.
725         endif         endif
726        endif        endif
727    
728          if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
729    
730    C If we are reading from a global file then we open it here
731          if (globalFile) then
732           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
733           open( dUnit, file=dataFName, status='old',
734         &      access='direct', recl=length_of_rec )
735           fileIsOpen=.TRUE.
736          endif
737    
738  C Loop over all processors      C Loop over all processors    
739        do jp=1,nPy        do jp=1,nPy
740        do ip=1,nPx        do ip=1,nPx
# Line 629  C (This is a place-holder for the active Line 780  C (This is a place-holder for the active
780          if (fileIsOpen) then          if (fileIsOpen) then
781           do k=1,nLocz           do k=1,nLocz
782            do j=1,sNy            do j=1,sNy
783               if (globalFile) then
784                iG=bi+(ip-1)*nsx
785                jG=bj+(jp-1)*nsy
786                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
787         &             + nSx*nPx*Ny*nLocz*(irecord-1)
788               else
789              iG = 0              iG = 0
790              jG = 0              jG = 0
791              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)
792               endif
793             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
794              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
795  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 694  C If global file was opened then close i Line 852  C If global file was opened then close i
852         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
853        endif        endif
854    
855          endif
856    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
857    
858        _END_MASTER( myThid )        _END_MASTER( myThid )
859    
860  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 752  C          open(dUnit, ..., status='old' Line 913  C          open(dUnit, ..., status='old'
913  C Global variables / common blocks  C Global variables / common blocks
914  #include "SIZE.h"  #include "SIZE.h"
915  #include "EEPARAMS.h"  #include "EEPARAMS.h"
916    #include "EESUPPORT.h"
917  #include "PARAMS.h"  #include "PARAMS.h"
918    
919  C Routine arguments  C Routine arguments
# Line 772  C Functions Line 934  C Functions
934        integer MDS_RECLEN        integer MDS_RECLEN
935  C Local variables  C Local variables
936        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
937        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
938        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
939        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
940        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)
# Line 780  C Local variables Line 942  C Local variables
942        integer length_of_rec        integer length_of_rec
943        logical fileIsOpen        logical fileIsOpen
944        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
945    cph-usesingle(
946          integer ii,jj
947          integer x_size,y_size,iG_IO,jG_IO,npe
948          PARAMETER ( x_size = Nx )
949          PARAMETER ( y_size = Ny )
950          Real*4 xy_buffer_r4(x_size,y_size)
951          Real*8 xy_buffer_r8(x_size,y_size)
952          Real*8 global(Nx,Ny)
953    cph-usesingle)
954    
955  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
956    
957  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 805  C Assign a free unit number as the I/O c Line 977  C Assign a free unit number as the I/O c
977        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
978    
979    
980    cph-usesingle(
981    #ifdef ALLOW_USE_MPI
982          _END_MASTER( myThid )
983    C If option globalFile is desired but does not work or if
984    C globalFile is too slow, then try using single-CPU I/O.
985          if (useSingleCpuIO) then
986    
987    C Master thread of process 0, only, opens a global file
988           _BEGIN_MASTER( myThid )
989            IF( mpiMyId .EQ. 0 ) THEN
990             write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
991             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
992             if (irecord .EQ. 1) then
993              open( dUnit, file=dataFName, status=_NEW_STATUS,
994         &        access='direct', recl=length_of_rec )
995             else
996              open( dUnit, file=dataFName, status=_OLD_STATUS,
997         &        access='direct', recl=length_of_rec )
998             endif
999            ENDIF
1000           _END_MASTER( myThid )
1001    
1002    C Gather array and write it to file, one vertical level at a time
1003           DO k=1,nLocz
1004    C Loop over all processors    
1005            do jp=1,nPy
1006            do ip=1,nPx
1007            DO bj = myByLo(myThid), myByHi(myThid)
1008             DO bi = myBxLo(myThid), myBxHi(myThid)
1009              DO J=1,sNy
1010               JJ=((jp-1)*nSy+(bj-1))*sNy+J
1011               DO I=1,sNx
1012                II=((ip-1)*nSx+(bi-1))*sNx+I
1013                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
1014               ENDDO
1015              ENDDO
1016             ENDDO
1017            ENDDO
1018            enddo
1019            enddo
1020            _BEGIN_MASTER( myThid )
1021             IF( mpiMyId .EQ. 0 ) THEN
1022              irec=k+nLocz*(irecord-1)
1023              if (filePrec .eq. precFloat32) then
1024               DO J=1,Ny
1025                DO I=1,Nx
1026                 xy_buffer_r4(I,J) = global(I,J)
1027                ENDDO
1028               ENDDO
1029    #ifdef _BYTESWAPIO
1030               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1031    #endif
1032               write(dUnit,rec=irec) xy_buffer_r4
1033              elseif (filePrec .eq. precFloat64) then
1034               DO J=1,Ny
1035                DO I=1,Nx
1036                 xy_buffer_r8(I,J) = global(I,J)
1037                ENDDO
1038               ENDDO
1039    #ifdef _BYTESWAPIO
1040               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1041    #endif
1042               write(dUnit,rec=irec) xy_buffer_r8
1043              else
1044               write(msgbuf,'(a)')
1045         &       ' MDSWRITEFIELD: illegal value for filePrec'
1046               call print_error( msgbuf, mythid )
1047               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
1048              endif
1049             ENDIF
1050            _END_MASTER( myThid )
1051           ENDDO
1052    
1053    C Close data-file and create meta-file
1054           _BEGIN_MASTER( myThid )
1055            IF( mpiMyId .EQ. 0 ) THEN
1056             close( dUnit )
1057             write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'
1058             dimList(1,1)=Nx
1059             dimList(2,1)=1
1060             dimList(3,1)=Nx
1061             dimList(1,2)=Ny
1062             dimList(2,2)=1
1063             dimList(3,2)=Ny
1064             dimList(1,3)=nLocz
1065             dimList(2,3)=1
1066             dimList(3,3)=nLocz
1067             ndims=3
1068             if (nLocz .EQ. 1) ndims=2
1069             call MDSWRITEMETA( metaFName, dataFName,
1070         &     filePrec, ndims, dimList, irecord, myIter, mythid )
1071            ENDIF
1072           _END_MASTER( myThid )
1073    C To be safe, make other processes wait for I/O completion
1074           _BARRIER
1075    
1076          elseif ( .NOT. useSingleCpuIO ) then
1077          _BEGIN_MASTER( myThid )
1078    #endif /* ALLOW_USE_MPI */
1079    cph-usesingle)
1080    
1081  C Loop over all processors      C Loop over all processors    
1082        do jp=1,nPy        do jp=1,nPy
1083        do ip=1,nPx        do ip=1,nPx
# Line 912  C End of ip,jp loops Line 1185  C End of ip,jp loops
1185         enddo         enddo
1186        enddo        enddo
1187    
   
1188        _END_MASTER( myThid )        _END_MASTER( myThid )
1189    
1190    #ifdef ALLOW_USE_MPI
1191    C endif useSingleCpuIO
1192          endif
1193    #endif /* ALLOW_USE_MPI */
1194    
1195  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1196        return        return
1197        end        end
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22