/[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.7 by heimbach, Wed Jan 12 19:15:03 2005 UTC revision 1.11 by heimbach, Fri Aug 19 18:01:29 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,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          if ( .not. ( globalFile ) ) then
203    
204  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
205        if (globalFile) then        if (globalFile) then
# Line 266  C If global file was opened then close i Line 326  C If global file was opened then close i
326         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
327        endif        endif
328    
329    c      end of if ( .not. ( globalFile ) ) then
330          endif
331    
332    c      else of if ( .not. ( useSingleCPUIO ) ) then
333          else
334    
335           DO k=1,nNz
336    
337    #ifdef ALLOW_USE_MPI
338             IF( mpiMyId .EQ. 0 ) THEN
339    #else
340             IF ( .TRUE. ) THEN
341    #endif /* ALLOW_USE_MPI */
342              irec = k+nNz*(irecord-1)
343              if (filePrec .eq. precFloat32) then
344               read(dUnit,rec=irec) xy_buffer_r4
345    #ifdef _BYTESWAPIO
346               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
347    #endif
348               DO J=1,Ny
349                DO I=1,Nx
350                 global(I,J) = xy_buffer_r4(I,J)
351                ENDDO
352               ENDDO
353              elseif (filePrec .eq. precFloat64) then
354               read(dUnit,rec=irec) xy_buffer_r8
355    #ifdef _BYTESWAPIO
356               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
357    #endif
358               DO J=1,Ny
359                DO I=1,Nx
360                 global(I,J) = xy_buffer_r8(I,J)
361                ENDDO
362               ENDDO
363              else
364               write(msgbuf,'(a)')
365         &            ' MDSREADFIELD: illegal value for filePrec'
366               call print_error( msgbuf, mythid )
367               stop 'ABNORMAL END: S/R MDSREADFIELD'
368              endif
369             ENDIF
370            DO jp=1,nPy
371             DO ip=1,nPx
372              DO bj = myByLo(myThid), myByHi(myThid)
373               DO bi = myBxLo(myThid), myBxHi(myThid)
374                DO J=1,sNy
375                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
376                 DO I=1,sNx
377                  II=((ip-1)*nSx+(bi-1))*sNx+I
378                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
379                 ENDDO
380                ENDDO
381               ENDDO
382              ENDDO
383             ENDDO
384            ENDDO
385    
386           ENDDO
387    c      ENDDO k=1,nNz
388    
389            close( dUnit )
390    
391        endif        endif
392  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
393    
# Line 357  C Local variables Line 479  C Local variables
479        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
480  cph-usesingle(  cph-usesingle(
481        integer ii,jj        integer ii,jj
482        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe        integer x_size,y_size,iG_IO,jG_IO,npe
483        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
484        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
485        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
# Line 669  C Functions Line 791  C Functions
791        integer MDS_RECLEN        integer MDS_RECLEN
792  C Local variables  C Local variables
793        character*(80) dataFName        character*(80) dataFName
794        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
795        logical exst        logical exst
796        _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)
797        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 677  C Local variables Line 799  C Local variables
799        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
800        integer length_of_rec        integer length_of_rec
801        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
802    cph-usesingle(
803          integer ii,jj
804          integer x_size,y_size,iG_IO,jG_IO,npe
805          PARAMETER ( x_size = Nx )
806          PARAMETER ( y_size = Ny )
807          Real*4 xy_buffer_r4(x_size,y_size)
808          Real*8 xy_buffer_r8(x_size,y_size)
809          Real*8 global(Nx,Ny)
810          _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
811    cph-usesingle)
812    
813  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
814    
815  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 835  C Assume nothing
835  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
836        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
837    
838          if ( useSingleCPUIO ) then
839    
840    C master thread of process 0, only, opens a global file
841    #ifdef ALLOW_USE_MPI
842            IF( mpiMyId .EQ. 0 ) THEN
843    #else
844            IF ( .TRUE. ) THEN
845    #endif /* ALLOW_USE_MPI */
846    
847  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
848        dataFName = fName           dataFName = fName
849        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
850        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  
851    
852  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)
853        if (.NOT. globalFile) then           if (.NOT. globalFile) then
854         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
855              inquire( file=dataFname, exist=exst )
856              if (exst) globalFile = .TRUE.
857             endif
858    
859    C If global file is visible to process 0, then open it here.
860    C Otherwise stop program.
861             if ( globalFile) then
862              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
863              open( dUnit, file=dataFName, status='old',
864         &         access='direct', recl=length_of_rec )
865             else
866              write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName
867              call print_message( msgbuf, standardmessageunit,
868         &                        SQUEEZE_RIGHT , mythid)
869              call print_error( msgbuf, mythid )
870              write(msgbuf,'(a)')
871         &      ' MDSREADFIELD: File does not exist'
872              call print_message( msgbuf, standardmessageunit,
873         &                        SQUEEZE_RIGHT , mythid)
874              call print_error( msgbuf, mythid )
875              stop 'ABNORMAL END: S/R MDSREADFIELD'
876             endif
877    
878            ENDIF
879    
880    c-- useSingleCpuIO
881          else
882    
883    C Check first for global file with simple name (ie. fName)
884           dataFName = fName
885         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
886         if (exst) then         if (exst) then
887          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
888       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName
889          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
890       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
891         endif         endif
892    
893    C If negative check for global file with MDS name (ie. fName.data)
894           if (.NOT. globalFile) then
895            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
896            inquire( file=dataFname, exist=exst )
897            if (exst) then
898             write(msgbuf,'(a,a)')
899         &     ' MDSREADFIELD_GL: opening global file: ',dataFName
900             call print_message( msgbuf, standardmessageunit,
901         &                       SQUEEZE_RIGHT , mythid)
902             globalFile = .TRUE.
903            endif
904           endif
905    
906    c-- useSingleCpuIO
907        endif        endif
908    
909        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        if ( .not. useSingleCpuIO ) then
910    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
911          if ( .not. ( globalFile ) ) then
912    
913  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
914        if (globalFile) then        if (globalFile) then
# Line 852  C If global file was opened then close i Line 1035  C If global file was opened then close i
1035         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1036        endif        endif
1037    
1038    c      end of if ( .not. ( globalFile ) ) then
1039          endif
1040    
1041    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1042          else
1043    
1044           DO k=1,nLocz
1045    
1046    #ifdef ALLOW_USE_MPI
1047             IF( mpiMyId .EQ. 0 ) THEN
1048    #else
1049             IF ( .TRUE. ) THEN
1050    #endif /* ALLOW_USE_MPI */
1051              irec = k+nNz*(irecord-1)
1052              if (filePrec .eq. precFloat32) then
1053               read(dUnit,rec=irec) xy_buffer_r4
1054    #ifdef _BYTESWAPIO
1055               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1056    #endif
1057               DO J=1,Ny
1058                DO I=1,Nx
1059                 global(I,J) = xy_buffer_r4(I,J)
1060                ENDDO
1061               ENDDO
1062              elseif (filePrec .eq. precFloat64) then
1063               read(dUnit,rec=irec) xy_buffer_r8
1064    #ifdef _BYTESWAPIO
1065               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1066    #endif
1067               DO J=1,Ny
1068                DO I=1,Nx
1069                 global(I,J) = xy_buffer_r8(I,J)
1070                ENDDO
1071               ENDDO
1072              else
1073               write(msgbuf,'(a)')
1074         &            ' MDSREADFIELD: illegal value for filePrec'
1075               call print_error( msgbuf, mythid )
1076               stop 'ABNORMAL END: S/R MDSREADFIELD'
1077              endif
1078             ENDIF
1079            DO jp=1,nPy
1080             DO ip=1,nPx
1081              DO bj = myByLo(myThid), myByHi(myThid)
1082               DO bi = myBxLo(myThid), myBxHi(myThid)
1083                DO J=1,sNy
1084                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1085                 DO I=1,sNx
1086                  II=((ip-1)*nSx+(bi-1))*sNx+I
1087                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1088                 ENDDO
1089                ENDDO
1090               ENDDO
1091              ENDDO
1092             ENDDO
1093            ENDDO
1094    
1095           ENDDO
1096    c      ENDDO k=1,nNz
1097    
1098            close( dUnit )
1099    
1100        endif        endif
1101  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1102    
# Line 944  C Local variables Line 1189  C Local variables
1189        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1190  cph-usesingle(  cph-usesingle(
1191        integer ii,jj        integer ii,jj
1192        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe        integer x_size,y_size,iG_IO,jG_IO,npe
1193        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1194        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1195        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22