/[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.13 by heimbach, Wed Jan 23 22:38:43 2008 UTC
# 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 176  cgg       And now back-calculate what io Line 215  cgg       And now back-calculate what io
215              read(cunit) filej              read(cunit) filej
216              read(cunit) filei              read(cunit) filei
217              do k = 1, Nr              do k = 1, Nr
218                   irectrue = (irec-1)*nobcs*nr + (iobcs-1)*nr + k
219                 cbuffindex = nwetglobal(k,iobcs)                 cbuffindex = nwetglobal(k,iobcs)
220                 if ( cbuffindex .gt. 0 ) then                 if ( cbuffindex .gt. 0 ) then
221                    read(cunit) filencbuffindex                    read(cunit) filencbuffindex
# Line 192  cgg       And now back-calculate what io Line 232  cgg       And now back-calculate what io
232                    endif                    endif
233                    read(cunit) (cbuff(ii), ii=1,cbuffindex)                    read(cunit) (cbuff(ii), ii=1,cbuffindex)
234                 endif                 endif
235    
236                 cbuffindex = 0                 cbuffindex = 0
237                 jj=mod((j-1)*nr+k-1,sny)+1                 jj=mod((j-1)*nr+k-1,sny)+1
238                 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 245  cgg       And now back-calculate what io
245                         cbuffindex = cbuffindex + 1                         cbuffindex = cbuffindex + 1
246                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
247       &                      cbuff(cbuffindex)       &                      cbuff(cbuffindex)
248    cph(
249                           globfldtmp2(i,bi,ip,bj,jp) =
250         &                      cbuff(cbuffindex)
251    cph)
252  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
253                         globfld3d(i,bi,ip,jj,bj,jp,kk) =                         globfld3d(i,bi,ip,jj,bj,jp,kk) =
254       &                      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 261  cgg       And now back-calculate what io
261                      else                      else
262                         globfld3d(i,bi,ip,jj,bj,jp,kk) = 0. _d 0                         globfld3d(i,bi,ip,jj,bj,jp,kk) = 0. _d 0
263                      endif                      endif
264    cph(
265                        globfldtmp3(i,bi,ip,bj,jp) =
266         &                   globfld3d(i,bi,ip,jj,bj,jp,kk)
267    cph)
268                     enddo                     enddo
269                    enddo                    enddo
270                   enddo                   enddo
271                  enddo                  enddo
272                 enddo                 enddo
273  c  c
274                   if ( doPackDiag ) then
275                      write(cunit2,rec=irectrue) globfldtmp2
276                      write(cunit3,rec=irectrue) globfldtmp3
277                   endif
278    c
279  c     -- end of k loop --  c     -- end of k loop --
280           enddo           enddo
281  c     -- end of j loop --  c     -- end of j loop --
# Line 251  cgg       And now back-calculate what io Line 305  cgg       And now back-calculate what io
305           read(cunit) filej           read(cunit) filej
306           read(cunit) filei           read(cunit) filei
307           do k = 1, Nr           do k = 1, Nr
308                irectrue = (irec-1)*nobcs*nr + (iobcs-1)*nr + k
309              cbuffindex = nwetglobal(k,iobcs)              cbuffindex = nwetglobal(k,iobcs)
310              if ( cbuffindex .gt. 0 ) then              if ( cbuffindex .gt. 0 ) then
311                 read(cunit) filencbuffindex                 read(cunit) filencbuffindex
# Line 267  cgg       And now back-calculate what io Line 322  cgg       And now back-calculate what io
322                 endif                 endif
323                 read(cunit) (cbuff(ii), ii=1,cbuffindex)                 read(cunit) (cbuff(ii), ii=1,cbuffindex)
324              endif              endif
325    
326              cbuffindex = 0              cbuffindex = 0
327              do jp = 1,nPy              do jp = 1,nPy
328               do bj = jtlo,jthi               do bj = jtlo,jthi
# Line 276  cgg       And now back-calculate what io Line 332  cgg       And now back-calculate what io
332                    if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then                    if ( globmskxz(i,bi,ip,bj,jp,k,iobcs) .ne. 0. ) then
333                       cbuffindex = cbuffindex + 1                       cbuffindex = cbuffindex + 1
334                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)                       globfldxz(i,bi,ip,bj,jp,k) = cbuff(cbuffindex)
335    cph(
336                         globfldtmp2(i,bi,ip,bj,jp) = cbuff(cbuffindex)
337    cph)
338  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
339                       globfldxz(i,bi,ip,bj,jp,k) =                       globfldxz(i,bi,ip,bj,jp,k) =
340       &                    globfldxz(i,bi,ip,bj,jp,k)/       &                    globfldxz(i,bi,ip,bj,jp,k)/
# Line 288  cgg       And now back-calculate what io Line 347  cgg       And now back-calculate what io
347                    else                    else
348                       globfldxz(i,bi,ip,bj,jp,k) = 0. _d 0                       globfldxz(i,bi,ip,bj,jp,k) = 0. _d 0
349                    endif                    endif
350    cph(
351                      globfldtmp3(i,bi,ip,bj,jp) =
352         &                 globfldxz(i,bi,ip,bj,jp,k)
353    cph)
354                  enddo                  enddo
355                 enddo                 enddo
356                enddo                enddo
357               enddo               enddo
358              enddo              enddo
359  c  c
360                if ( doPackDiag ) then
361                   write(cunit2,rec=irectrue) globfldtmp2
362                   write(cunit3,rec=irectrue) globfldtmp3
363                endif
364    c
365  c     -- end of k loop --  c     -- end of k loop --
366           enddo           enddo
367    

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

  ViewVC Help
Powered by ViewVC 1.1.22