/[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.12 by jmc, Tue Oct 9 00:00:01 2007 UTC revision 1.15 by jmc, Mon Mar 22 02:16:43 2010 UTC
# Line 17  c     o Open boundary packing added : Line 17  c     o Open boundary packing added :
17  c          gebbie@mit.edu, 18-Mar-2003  c          gebbie@mit.edu, 18-Mar-2003
18  c  c
19  c     changed: heimbach@mit.edu 17-Jun-2003  c     changed: heimbach@mit.edu 17-Jun-2003
20  c              merged Armin's changes to replace write of  c              merged changes from Armin to replace write of
21  c              nr * globfld2d by 1 * globfld3d  c              nr * globfld2d by 1 * globfld3d
22  c              (ad hoc fix to speed up global I/O)  c              (ad hoc fix to speed up global I/O)
23  c  c
# Line 49  c     == routine arguments == Line 49  c     == routine arguments ==
49  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
50  c     == local variables ==  c     == local variables ==
51    
52          logical lxxadxx
53    
54        integer bi,bj        integer bi,bj
55        integer ip,jp        integer ip,jp
56        integer i,j,k        integer i,j,k
# Line 62  c     == local variables == Line 64  c     == local variables ==
64    
65        integer cbuffindex        integer cbuffindex
66    
67        real*4     cbuff    ( snx*nsx*npx*nsy*npy )        real*4 cbuff      ( snx*nsx*npx*nsy*npy )
68          real*4 globfldtmp2( snx,nsx,npx,nsy,npy )
69          real*4 globfldtmp3( snx,nsx,npx,nsy,npy )
70        _RL     globfldxz( snx,nsx,npx,nsy,npy,nr )        _RL     globfldxz( snx,nsx,npx,nsy,npy,nr )
71        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
72        _RL     globmskxz( snx,nsx,npx,nsy,npy,nr,nobcs )        _RL     globmskxz( snx,nsx,npx,nsy,npy,nr,nobcs )
# Line 71  c     == local variables == Line 75  c     == local variables ==
75  #endif  #endif
76    
77  cgg(  cgg(
78          integer reclen, irectrue
79          integer cunit2, cunit3
80        integer igg        integer igg
81        _RL     gg        _RL     gg
82        character*(80) weightname        character*(80) weightname
83          character*(80) cfile2, cfile3
84  cgg)  cgg)
85    
86  c     == external ==  c     == external ==
# Line 92  cc     == end of interface == Line 99  cc     == end of interface ==
99        imin = 1        imin = 1
100        imax = snx        imax = snx
101    
102          lxxadxx = .TRUE.
103    
104  c     Initialise temporary file  c     Initialise temporary file
105        do k = 1,nr        do k = 1,nr
106           do jp = 1,nPy           do jp = 1,nPy
# Line 99  c     Initialise temporary file Line 108  c     Initialise temporary file
108                 do ip = 1,nPx                 do ip = 1,nPx
109                    do bi = itlo,ithi                    do bi = itlo,ithi
110                       do i = imin,imax                       do i = imin,imax
111                          globfldxz(i,bi,ip,bj,jp,k) = 0. _d 0                          globfldxz  (i,bi,ip,bj,jp,k) = 0. _d 0
112                            globfldtmp2(i,bi,ip,bj,jp)   = 0.
113                            globfldtmp3(i,bi,ip,bj,jp)   = 0.
114                          do iobcs=1,nobcs                          do iobcs=1,nobcs
115                             globmskxz(i,bi,ip,bj,jp,k,iobcs) = 0. _d 0                             globmskxz(i,bi,ip,bj,jp,k,iobcs) = 0. _d 0
116                          enddo                          enddo
# Line 129  c     Initialise temporary file Line 140  c     Initialise temporary file
140  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
141        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
142    
143          if ( doPackDiag ) then
144             write(cfile2(1:80),'(80a)') ' '
145             write(cfile3(1:80),'(80a)') ' '
146             if ( lxxadxx ) then
147                write(cfile2(1:80),'(a,I2.2,a,I4.4,a)')
148         &           'diag_unpack_nondim_ctrl_',
149         &           ivartype, '_', optimcycle, '.bin'
150                write(cfile3(1:80),'(a,I2.2,a,I4.4,a)')
151         &           'diag_unpack_dimens_ctrl_',
152         &           ivartype, '_', optimcycle, '.bin'
153             else
154                write(cfile2(1:80),'(a,I2.2,a,I4.4,a)')
155         &           'diag_unpack_nondim_grad_',
156         &           ivartype, '_', optimcycle, '.bin'
157                write(cfile3(1:80),'(a,I2.2,a,I4.4,a)')
158         &           'diag_unpack_dimens_grad_',
159         &           ivartype, '_', optimcycle, '.bin'
160             endif
161    
162             reclen = snx*nsx*npx*nsy*npy*4
163             call mdsfindunit( cunit2, mythid )
164             open( cunit2, file=cfile2, status='unknown',
165         &        access='direct', recl=reclen )
166             call mdsfindunit( cunit3, mythid )
167             open( cunit3, file=cfile3, status='unknown',
168         &        access='direct', recl=reclen )
169          endif
170    
171        do iobcs=1,nobcs        do iobcs=1,nobcs
172           call MDSREADFIELD_XZ_GL(           call MDSREADFIELD_XZ_GL(
173       &        masktype, ctrlprec, 'RL',       &        masktype, ctrlprec, 'RL',
# Line 159  cph                           weightfldx Line 198  cph                           weightfldx
198  #endif /* CTRL_UNPACK_PRECISE */  #endif /* CTRL_UNPACK_PRECISE */
199        enddo        enddo
200    
201        nrec_nl=int(ncvarrecs(ivartype)/sny)        if ( useSingleCPUio ) then
202    C     MDSWRITEFIELD_XZ_GL does not know about useSingleCPUio, so the faster
203    C     method that works for .not.useSingleCPUio cannot be used
204           nrec_nl = 0
205          else
206           nrec_nl = int(ncvarrecs(ivartype)/Ny)
207          endif
208        do irec = 1, nrec_nl        do irec = 1, nrec_nl
209  cgg       do iobcs = 1, nobcs  cgg       do iobcs = 1, nobcs
210  cgg       And now back-calculate what iobcs should be.  cgg       And now back-calculate what iobcs should be.
# Line 176  cgg       And now back-calculate what io Line 221  cgg       And now back-calculate what io
221              read(cunit) filej              read(cunit) filej
222              read(cunit) filei              read(cunit) filei
223              do k = 1, Nr              do k = 1, Nr
224                   irectrue = (irec-1)*nobcs*nr + (iobcs-1)*nr + k
225                 cbuffindex = nwetglobal(k,iobcs)                 cbuffindex = nwetglobal(k,iobcs)
226                 if ( cbuffindex .gt. 0 ) then                 if ( cbuffindex .gt. 0 ) then
227                    read(cunit) filencbuffindex                    read(cunit) filencbuffindex
# Line 192  cgg       And now back-calculate what io Line 238  cgg       And now back-calculate what io
238                    endif                    endif
239                    read(cunit) (cbuff(ii), ii=1,cbuffindex)                    read(cunit) (cbuff(ii), ii=1,cbuffindex)
240                 endif                 endif
241    
242                 cbuffindex = 0                 cbuffindex = 0
243                 jj=mod((j-1)*nr+k-1,sny)+1                 jj=mod((j-1)*nr+k-1,sny)+1
244                 kk=int((j-1)*nr+k-1)/sny+1                 kk=int((j-1)*nr+k-1)/sny+1
# Line 204  cgg       And now back-calculate what io Line 251  cgg       And now back-calculate what io
251                         cbuffindex = cbuffindex + 1                         cbuffindex = cbuffindex + 1
252                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
253       &                      cbuff(cbuffindex)       &                      cbuff(cbuffindex)
254    cph(
255                           globfldtmp2(i,bi,ip,bj,jp) =
256         &                      cbuff(cbuffindex)
257    cph)
258  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
259                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
260       &                      globfld3d(i,bi,ip,jj,bj,jp,kk)/       &                      globfld3d(i,bi,ip,jj,bj,jp,kk)/
# Line 216  cgg       And now back-calculate what io Line 267  cgg       And now back-calculate what io
267                      else                      else
268                         globfld3d(i,bi,ip,jj,bj,jp,kk) = 0. _d 0                         globfld3d(i,bi,ip,jj,bj,jp,kk) = 0. _d 0
269                      endif                      endif
270    cph(
271                        globfldtmp3(i,bi,ip,bj,jp) =
272         &                   globfld3d(i,bi,ip,jj,bj,jp,kk)
273    cph)
274                     enddo                     enddo
275                    enddo                    enddo
276                   enddo                   enddo
277                  enddo                  enddo
278                 enddo                 enddo
279  c  c
280                   if ( doPackDiag ) then
281                      write(cunit2,rec=irectrue) globfldtmp2
282                      write(cunit3,rec=irectrue) globfldtmp3
283                   endif
284    c
285  c     -- end of k loop --  c     -- end of k loop --
286           enddo           enddo
287  c     -- end of j loop --  c     -- end of j loop --
# Line 236  cgg       enddo Line 296  cgg       enddo
296  c     -- end of irec loop --  c     -- end of irec loop --
297        enddo        enddo
298    
299        do irec = nrec_nl*sny+1, ncvarrecs(ivartype)        do irec = nrec_nl*ny+1, ncvarrecs(ivartype)
300  cgg       do iobcs = 1, nobcs  cgg       do iobcs = 1, nobcs
301  cgg       And now back-calculate what iobcs should be.  cgg       And now back-calculate what iobcs should be.
302           iobcs= mod(irec-1,nobcs)+1           iobcs= mod(irec-1,nobcs)+1
# Line 251  cgg       And now back-calculate what io Line 311  cgg       And now back-calculate what io
311           read(cunit) filej           read(cunit) filej
312           read(cunit) filei           read(cunit) filei
313           do k = 1, Nr           do k = 1, Nr
314                irectrue = (irec-1)*nobcs*nr + (iobcs-1)*nr + k
315              cbuffindex = nwetglobal(k,iobcs)              cbuffindex = nwetglobal(k,iobcs)
316              if ( cbuffindex .gt. 0 ) then              if ( cbuffindex .gt. 0 ) then
317                 read(cunit) filencbuffindex                 read(cunit) filencbuffindex
# Line 267  cgg       And now back-calculate what io Line 328  cgg       And now back-calculate what io
328                 endif                 endif
329                 read(cunit) (cbuff(ii), ii=1,cbuffindex)                 read(cunit) (cbuff(ii), ii=1,cbuffindex)
330              endif              endif
331    
332              cbuffindex = 0              cbuffindex = 0
333              do jp = 1,nPy              do jp = 1,nPy
334               do bj = jtlo,jthi               do bj = jtlo,jthi
# Line 276  cgg       And now back-calculate what io Line 338  cgg       And now back-calculate what io
338                    if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then                    if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then
339                       cbuffindex = cbuffindex + 1                       cbuffindex = cbuffindex + 1
340                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)
341    cph(
342                         globfldtmp2(i,bi,ip,bj,jp) = cbuff(cbuffindex)
343    cph)
344  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
345                       globfldxz(i,bi,ip,bj,jp,k) =                       globfldxz(i,bi,ip,bj,jp,k) =
346       &                    globfldxz(i,bi,ip,bj,jp,k)/       &                    globfldxz(i,bi,ip,bj,jp,k)/
# Line 288  cgg       And now back-calculate what io Line 353  cgg       And now back-calculate what io
353                    else                    else
354                       globfldxz(i,bi,ip,bj,jp,k) = 0. _d 0                       globfldxz(i,bi,ip,bj,jp,k) = 0. _d 0
355                    endif                    endif
356    cph(
357                      globfldtmp3(i,bi,ip,bj,jp) =
358         &                 globfldxz(i,bi,ip,bj,jp,k)
359    cph)
360                  enddo                  enddo
361                 enddo                 enddo
362                enddo                enddo
363               enddo               enddo
364              enddo              enddo
365  c  c
366                if ( doPackDiag ) then
367                   write(cunit2,rec=irectrue) globfldtmp2
368                   write(cunit3,rec=irectrue) globfldtmp3
369                endif
370    c
371  c     -- end of k loop --  c     -- end of k loop --
372           enddo           enddo
373    
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22