/[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.8 by heimbach, Wed Jan 12 20:33:13 2005 UTC revision 1.9 by heimbach, Fri Feb 18 20:21:15 2005 UTC
# Line 83  C Functions Line 83  C Functions
83        integer MDS_RECLEN        integer MDS_RECLEN
84  C Local variables  C Local variables
85        character*(80) dataFName        character*(80) dataFName
86        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,ii,i,j,k,dUnit,IL
87        logical exst        logical exst
88        _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)
89        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 91  C Local variables Line 91  C Local variables
91        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
92        integer length_of_rec        integer length_of_rec
93        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
94    cph-usesingle(
95          integer ii,jj
96          integer x_size,y_size,iG_IO,jG_IO,npe
97          PARAMETER ( x_size = Nx )
98          PARAMETER ( y_size = Ny )
99          Real*4 xy_buffer_r4(x_size,y_size)
100          Real*8 xy_buffer_r8(x_size,y_size)
101          Real*8 global(Nx,Ny)
102          _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
103    cph-usesingle)
104    
105  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
106    
107  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 116  C Assume nothing Line 127  C Assume nothing
127  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
128        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
129    
130          if ( useSingleCPUIO ) then
131    
132    #ifdef ALLOW_USE_MPI
133            IF( mpiMyId .EQ. 0 ) THEN
134    #else
135            IF ( .TRUE. ) THEN
136    #endif /* ALLOW_USE_MPI */
137    
138  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
139        dataFName = fName           dataFName = fName
140        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
141        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
142    
143  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
144        if (.NOT. globalFile) then           if (.NOT. globalFile) then
145         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
146              inquire( file=dataFname, exist=exst )
147              if (exst) globalFile = .TRUE.
148             endif
149    
150    C If global file is visible to process 0, then open it here.
151    C Otherwise stop program.
152             if ( globalFile) then
153              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
154              open( dUnit, file=dataFName, status='old',
155         &         access='direct', recl=length_of_rec )
156             else
157              write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName
158              call print_message( msgbuf, standardmessageunit,
159         &                        SQUEEZE_RIGHT , mythid)
160              call print_error( msgbuf, mythid )
161              write(msgbuf,'(a)')
162         &      ' MDSREADFIELD: File does not exist'
163              call print_message( msgbuf, standardmessageunit,
164         &                        SQUEEZE_RIGHT , mythid)
165              call print_error( msgbuf, mythid )
166              stop 'ABNORMAL END: S/R MDSREADFIELD'
167             endif
168    
169            ENDIF
170    
171    c-- useSingleCpuIO
172          else
173    C Only do I/O if I am the master thread
174    
175    C Check first for global file with simple name (ie. fName)
176           dataFName = fName
177         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
178         if (exst) then         if (exst) then
179          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
180       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName
181          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
182       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
183         endif         endif
184    
185    C If negative check for global file with MDS name (ie. fName.data)
186           if (.NOT. globalFile) then
187            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
188            inquire( file=dataFname, exist=exst )
189            if (exst) then
190             write(msgbuf,'(a,a)')
191         &     ' MDSREADFIELD_GL: opening global file: ',dataFName
192             call print_message( msgbuf, standardmessageunit,
193         &                       SQUEEZE_RIGHT , mythid)
194             globalFile = .TRUE.
195            endif
196           endif
197    
198    c-- useSingleCpuIO
199        endif        endif
200    
201        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        if ( .not. useSingleCpuIO ) then
202    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
203          if ( .not. ( globalFile ) ) then
204    
205  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
206        if (globalFile) then        if (globalFile) then
# Line 266  C If global file was opened then close i Line 327  C If global file was opened then close i
327         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
328        endif        endif
329    
330    c      end of if ( .not. ( globalFile ) ) then
331          endif
332    
333    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
334          else
335    
336           DO k=1,nNz
337    
338    #ifdef ALLOW_USE_MPI
339             IF( mpiMyId .EQ. 0 ) THEN
340    #else
341             IF ( .TRUE. ) THEN
342    #endif /* ALLOW_USE_MPI */
343              irec = k+nNz*(irecord-1)
344              if (filePrec .eq. precFloat32) then
345               read(dUnit,rec=irec) xy_buffer_r4
346    #ifdef _BYTESWAPIO
347               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
348    #endif
349               DO J=1,Ny
350                DO I=1,Nx
351                 global(I,J) = xy_buffer_r4(I,J)
352                ENDDO
353               ENDDO
354              elseif (filePrec .eq. precFloat64) then
355               read(dUnit,rec=irec) xy_buffer_r8
356    #ifdef _BYTESWAPIO
357               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
358    #endif
359               DO J=1,Ny
360                DO I=1,Nx
361                 global(I,J) = xy_buffer_r8(I,J)
362                ENDDO
363               ENDDO
364              else
365               write(msgbuf,'(a)')
366         &            ' MDSREADFIELD: illegal value for filePrec'
367               call print_error( msgbuf, mythid )
368               stop 'ABNORMAL END: S/R MDSREADFIELD'
369              endif
370             ENDIF
371            DO jp=1,nPy
372             DO ip=1,nPx
373              DO bj = myByLo(myThid), myByHi(myThid)
374               DO bi = myBxLo(myThid), myBxHi(myThid)
375                DO J=1,sNy
376                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
377                 DO I=1,sNx
378                  II=((ip-1)*nSx+(bi-1))*sNx+I
379                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
380                 ENDDO
381                ENDDO
382               ENDDO
383              ENDDO
384             ENDDO
385            ENDDO
386    
387           ENDDO
388    c      ENDDO k=1,nNz
389    
390            close( dUnit )
391    
392        endif        endif
393  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
394    
# Line 669  C Functions Line 792  C Functions
792        integer MDS_RECLEN        integer MDS_RECLEN
793  C Local variables  C Local variables
794        character*(80) dataFName        character*(80) dataFName
795        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,ii,i,j,k,dUnit,IL
796        logical exst        logical exst
797        _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)
798        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 677  C Local variables Line 800  C Local variables
800        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
801        integer length_of_rec        integer length_of_rec
802        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
803    cph-usesingle(
804          integer ii,jj
805          integer x_size,y_size,iG_IO,jG_IO,npe
806          PARAMETER ( x_size = Nx )
807          PARAMETER ( y_size = Ny )
808          Real*4 xy_buffer_r4(x_size,y_size)
809          Real*8 xy_buffer_r8(x_size,y_size)
810          Real*8 global(Nx,Ny)
811          _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
812    cph-usesingle)
813    
814  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
815    
816  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 702  C Assume nothing Line 836  C Assume nothing
836  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
837        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
838    
839          if ( useSingleCPUIO ) then
840    
841    C master thread of process 0, only, opens a global file
842    #ifdef ALLOW_USE_MPI
843            IF( mpiMyId .EQ. 0 ) THEN
844    #else
845            IF ( .TRUE. ) THEN
846    #endif /* ALLOW_USE_MPI */
847    
848  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
849        dataFName = fName           dataFName = fName
850        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
851        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
852    
853  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
854        if (.NOT. globalFile) then           if (.NOT. globalFile) then
855         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
856              inquire( file=dataFname, exist=exst )
857              if (exst) globalFile = .TRUE.
858             endif
859    
860    C If global file is visible to process 0, then open it here.
861    C Otherwise stop program.
862             if ( globalFile) then
863              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
864              open( dUnit, file=dataFName, status='old',
865         &         access='direct', recl=length_of_rec )
866             else
867              write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName
868              call print_message( msgbuf, standardmessageunit,
869         &                        SQUEEZE_RIGHT , mythid)
870              call print_error( msgbuf, mythid )
871              write(msgbuf,'(a)')
872         &      ' MDSREADFIELD: File does not exist'
873              call print_message( msgbuf, standardmessageunit,
874         &                        SQUEEZE_RIGHT , mythid)
875              call print_error( msgbuf, mythid )
876              stop 'ABNORMAL END: S/R MDSREADFIELD'
877             endif
878    
879            ENDIF
880    
881    c-- useSingleCpuIO
882          else
883    
884    C Check first for global file with simple name (ie. fName)
885           dataFName = fName
886         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
887         if (exst) then         if (exst) then
888          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
889       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName
890          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
891       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
892         endif         endif
893    
894    C If negative check for global file with MDS name (ie. fName.data)
895           if (.NOT. globalFile) then
896            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
897            inquire( file=dataFname, exist=exst )
898            if (exst) then
899             write(msgbuf,'(a,a)')
900         &     ' MDSREADFIELD_GL: opening global file: ',dataFName
901             call print_message( msgbuf, standardmessageunit,
902         &                       SQUEEZE_RIGHT , mythid)
903             globalFile = .TRUE.
904            endif
905           endif
906    
907    c-- useSingleCpuIO
908        endif        endif
909    
910        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        if ( .not. useSingleCpuIO ) then
911    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
912          if ( .not. ( globalFile ) ) then
913    
914  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
915        if (globalFile) then        if (globalFile) then
# Line 852  C If global file was opened then close i Line 1036  C If global file was opened then close i
1036         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1037        endif        endif
1038    
1039    c      end of if ( .not. ( globalFile ) ) then
1040          endif
1041    
1042    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1043          else
1044    
1045           DO k=1,nLocz
1046    
1047    #ifdef ALLOW_USE_MPI
1048             IF( mpiMyId .EQ. 0 ) THEN
1049    #else
1050             IF ( .TRUE. ) THEN
1051    #endif /* ALLOW_USE_MPI */
1052              irec = k+nNz*(irecord-1)
1053              if (filePrec .eq. precFloat32) then
1054               read(dUnit,rec=irec) xy_buffer_r4
1055    #ifdef _BYTESWAPIO
1056               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1057    #endif
1058               DO J=1,Ny
1059                DO I=1,Nx
1060                 global(I,J) = xy_buffer_r4(I,J)
1061                ENDDO
1062               ENDDO
1063              elseif (filePrec .eq. precFloat64) then
1064               read(dUnit,rec=irec) xy_buffer_r8
1065    #ifdef _BYTESWAPIO
1066               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1067    #endif
1068               DO J=1,Ny
1069                DO I=1,Nx
1070                 global(I,J) = xy_buffer_r8(I,J)
1071                ENDDO
1072               ENDDO
1073              else
1074               write(msgbuf,'(a)')
1075         &            ' MDSREADFIELD: illegal value for filePrec'
1076               call print_error( msgbuf, mythid )
1077               stop 'ABNORMAL END: S/R MDSREADFIELD'
1078              endif
1079             ENDIF
1080            DO jp=1,nPy
1081             DO ip=1,nPx
1082              DO bj = myByLo(myThid), myByHi(myThid)
1083               DO bi = myBxLo(myThid), myBxHi(myThid)
1084                DO J=1,sNy
1085                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1086                 DO I=1,sNx
1087                  II=((ip-1)*nSx+(bi-1))*sNx+I
1088                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1089                 ENDDO
1090                ENDDO
1091               ENDDO
1092              ENDDO
1093             ENDDO
1094            ENDDO
1095    
1096           ENDDO
1097    c      ENDDO k=1,nNz
1098    
1099            close( dUnit )
1100    
1101        endif        endif
1102  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1103    
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22