/[MITgcm]/MITgcm/pkg/ctrl/ctrl_set_unpack_xz.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_set_unpack_xz.F

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

revision 1.11 by heimbach, Thu Jun 14 18:55:36 2007 UTC revision 1.12 by jmc, Tue Oct 9 00:00:01 2007 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
5    
# Line 128  c--   Only the master thread will do I/O Line 130  c--   Only the master thread will do I/O
130        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
131    
132        do iobcs=1,nobcs        do iobcs=1,nobcs
133           call MDSREADFIELD_XZ_GL(           call MDSREADFIELD_XZ_GL(
134       &        masktype, ctrlprec, 'RL',       &        masktype, ctrlprec, 'RL',
135       &        Nr, globmskxz(1,1,1,1,1,1,iobcs), iobcs,mythid)       &        Nr, globmskxz(1,1,1,1,1,1,iobcs), iobcs,mythid)
136  #ifdef CTRL_UNPACK_PRECISE  #ifdef CTRL_UNPACK_PRECISE
# Line 163  cgg       do iobcs = 1, nobcs Line 165  cgg       do iobcs = 1, nobcs
165  cgg       And now back-calculate what iobcs should be.  cgg       And now back-calculate what iobcs should be.
166           do j=1,sny           do j=1,sny
167              iobcs= mod((irec-1)*sny+j-1,nobcs)+1              iobcs= mod((irec-1)*sny+j-1,nobcs)+1
168        
169              read(cunit) filencvarindex(ivartype)              read(cunit) filencvarindex(ivartype)
170              if (filencvarindex(ivartype) .NE. ncvarindex(ivartype))              if (filencvarindex(ivartype) .NE. ncvarindex(ivartype))
171       &           then       &           then
# Line 200  cgg       And now back-calculate what io Line 202  cgg       And now back-calculate what io
202                     do i = imin,imax                     do i = imin,imax
203                      if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then                      if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then
204                         cbuffindex = cbuffindex + 1                         cbuffindex = cbuffindex + 1
205                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
206       &                      cbuff(cbuffindex)       &                      cbuff(cbuffindex)
207  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
208                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
209       &                      globfld3d(i,bi,ip,jj,bj,jp,kk)/       &                      globfld3d(i,bi,ip,jj,bj,jp,kk)/
210  # ifdef CTRL_UNPACK_PRECISE  # ifdef CTRL_UNPACK_PRECISE
211       &                      sqrt(weightfldxz(i,bi,ip,bj,jp,k,iobcs))       &                      sqrt(weightfldxz(i,bi,ip,bj,jp,k,iobcs))
# Line 224  c     -- end of k loop -- Line 226  c     -- end of k loop --
226           enddo           enddo
227  c     -- end of j loop --  c     -- end of j loop --
228           enddo           enddo
229                
230           call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',           call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',
231       &                             Nr, globfld3d, irec,       &                             Nr, globfld3d, irec,
232       &                             optimcycle, mythid)       &                             optimcycle, mythid)
# Line 275  cgg       And now back-calculate what io Line 277  cgg       And now back-calculate what io
277                       cbuffindex = cbuffindex + 1                       cbuffindex = cbuffindex + 1
278                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)
279  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
280                       globfldxz(i,bi,ip,bj,jp,k) =                       globfldxz(i,bi,ip,bj,jp,k) =
281       &                    globfldxz(i,bi,ip,bj,jp,k)/       &                    globfldxz(i,bi,ip,bj,jp,k)/
282  # ifdef CTRL_UNPACK_PRECISE  # ifdef CTRL_UNPACK_PRECISE
283       &                    sqrt(weightfldxz(i,bi,ip,bj,jp,k,iobcs))       &                    sqrt(weightfldxz(i,bi,ip,bj,jp,k,iobcs))
# Line 294  cgg       And now back-calculate what io Line 296  cgg       And now back-calculate what io
296  c  c
297  c     -- end of k loop --  c     -- end of k loop --
298           enddo           enddo
299                
300           call MDSWRITEFIELD_XZ_GL( fname, ctrlprec, 'RL',           call MDSWRITEFIELD_XZ_GL( fname, ctrlprec, 'RL',
301       &                             Nr, globfldxz, irec,       &                             Nr, globfldxz, irec,
302       &                             optimcycle, mythid)       &                             optimcycle, mythid)
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22