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

Diff of /MITgcm/pkg/ctrl/ctrl_set_unpack_yz.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    ( nsx*npx*sny*nsy*npy )        real*4  cbuff     ( nsx*npx*sny*nsy*npy )
68          real*4 globfldtmp2( nsx,npx,sny,nsy,npy )
69          real*4 globfldtmp3( nsx,npx,sny,nsy,npy )
70        _RL     globfldyz( nsx,npx,sny,nsy,npy,nr )        _RL     globfldyz( nsx,npx,sny,nsy,npy,nr )
71        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
72        _RL     globmskyz( nsx,npx,sny,nsy,npy,nr,nobcs )        _RL     globmskyz( nsx,npx,sny,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 j = jmin,jmax                 do j = jmin,jmax
109                    do ip = 1,nPx                    do ip = 1,nPx
110                       do bi = itlo,ithi                       do bi = itlo,ithi
111                          globfldyz(bi,ip,j,bj,jp,k) = 0. _d 0                          globfldyz  (bi,ip,j,bj,jp,k) = 0. _d 0
112                            globfldtmp2(bi,ip,j,bj,jp)   = 0.
113                            globfldtmp3(bi,ip,j,bj,jp)   = 0.
114                          do iobcs=1,nobcs                          do iobcs=1,nobcs
115                             globmskyz(bi,ip,j,bj,jp,k,iobcs) = 0. _d 0                             globmskyz(bi,ip,j,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 = nsx*npx*sny*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_YZ_GL(           call MDSREADFIELD_YZ_GL(
173       &        masktype, ctrlprec, 'RL',       &        masktype, ctrlprec, 'RL',
# Line 176  cgg      And now back-calculate what iob Line 215  cgg      And now back-calculate what iob
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 205  cgg      And now back-calculate what iob Line 245  cgg      And now back-calculate what iob
245                         cbuffindex = cbuffindex + 1                         cbuffindex = cbuffindex + 1
246                         globfld3d(ii,bi,ip,jj,bj,jp,kk) =                         globfld3d(ii,bi,ip,jj,bj,jp,kk) =
247       &                      cbuff(cbuffindex)       &                      cbuff(cbuffindex)
248    cph(
249                           globfldtmp2(bi,ip,jj,bj,jp) =
250         &                      cbuff(cbuffindex)
251    cph)
252  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
253                         globfld3d(ii,bi,ip,jj,bj,jp,kk) =                         globfld3d(ii,bi,ip,jj,bj,jp,kk) =
254       &                      globfld3d(ii,bi,ip,jj,bj,jp,kk)/       &                      globfld3d(ii,bi,ip,jj,bj,jp,kk)/
# Line 217  cgg      And now back-calculate what iob Line 261  cgg      And now back-calculate what iob
261                      else                      else
262                         globfld3d(ii,bi,ip,jj,bj,jp,kk) = 0. _d 0                         globfld3d(ii,bi,ip,jj,bj,jp,kk) = 0. _d 0
263                      endif                      endif
264    cph(
265                        globfldtmp3(bi,ip,jj,bj,jp) =
266         &                   globfld3d(ii,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 i loop --  c     -- end of i loop --
# Line 250  c     -- end of irec loop -- Line 303  c     -- end of irec loop --
303           read(cunit) filej           read(cunit) filej
304           read(cunit) filei           read(cunit) filei
305           do k = 1, Nr           do k = 1, Nr
306                irectrue = (irec-1)*nobcs*nr + (iobcs-1)*nr + k
307              cbuffindex = nwetglobal(k,iobcs)              cbuffindex = nwetglobal(k,iobcs)
308              if ( cbuffindex .gt. 0 ) then              if ( cbuffindex .gt. 0 ) then
309                 read(cunit) filencbuffindex                 read(cunit) filencbuffindex
# Line 275  c     -- end of irec loop -- Line 329  c     -- end of irec loop --
329                    if ( globmskyz(bi,ip,j,bj,jp,k,iobcs) .ne. 0. ) then                    if ( globmskyz(bi,ip,j,bj,jp,k,iobcs) .ne. 0. ) then
330                       cbuffindex = cbuffindex + 1                       cbuffindex = cbuffindex + 1
331                       globfldyz(bi,ip,j,bj,jp,k) = cbuff(cbuffindex)                       globfldyz(bi,ip,j,bj,jp,k) = cbuff(cbuffindex)
332    cph(
333                         globfldtmp2(bi,ip,j,bj,jp) = cbuff(cbuffindex)
334    cph)
335  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
336                       globfldyz(bi,ip,j,bj,jp,k) =                       globfldyz(bi,ip,j,bj,jp,k) =
337       &                    globfldyz(bi,ip,j,bj,jp,k)/       &                    globfldyz(bi,ip,j,bj,jp,k)/
# Line 287  c     -- end of irec loop -- Line 344  c     -- end of irec loop --
344                    else                    else
345                       globfldyz(bi,ip,j,bj,jp,k) = 0. _d 0                       globfldyz(bi,ip,j,bj,jp,k) = 0. _d 0
346                    endif                    endif
347    cph(
348                      globfldtmp3(bi,ip,j,bj,jp) =
349         &                 globfldyz(bi,ip,j,bj,jp,k)
350    cph)
351                  enddo                  enddo
352                 enddo                 enddo
353                enddo                enddo
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22