/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_readwrite.template
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cw_readwrite.template

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

revision 1.2 by edhill, Wed Feb 4 05:45:09 2004 UTC revision 1.3 by edhill, Thu Feb 5 00:13:47 2004 UTC
# Line 5  C $Name$ Line 5  C $Name$
5                
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_CW_RX_WRITES_YY(        SUBROUTINE MNC_CW_RX_W_YY(
9       I     myThid,       I     myThid,
10       I     fbname, bi,bj,       I     fbname, bi,bj,
11       I     vtype,       I     vtype,
# Line 30  C     Functions Line 30  C     Functions
30        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
31    
32  C     Local Variables  C     Local Variables
33        integer i,j, indv,nvf,nvl, n1,n2, igrid, ntot        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot
34        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids
35        integer ndim, indf, err, lbi,lbj        integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
36        integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), kr        integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), udo(9)
37        integer j1,j2,j3,j4,j5, k1,k2,k3,k4,k5        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
38        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
39        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_CHAR) fname
40    
# Line 62  C     Check that the Variable Type exist Line 62  C     Check that the Variable Type exist
62        ENDIF        ENDIF
63        igrid = mnc_cw_vgind(indv)        igrid = mnc_cw_vgind(indv)
64    
65    C    
66        bis = bi        bis = bi
67        bie = bi        bie = bi
68        IF (bi .LT. 1) THEN        IF (bi .LT. 1) THEN
# Line 78  C     Check that the Variable Type exist Line 79  C     Check that the Variable Type exist
79        DO lbj = bjs,bje        DO lbj = bjs,bje
80          DO lbi = bis,bie          DO lbi = bis,bie
81    
82          write(*,*) 'lbi,lbj = ',lbi,lbj, '  ', vtype(nvf:nvl)
83    
84  C         Create the file name  C         Create the file name
85            CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)            CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)
86            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
# Line 94  C         Append to an existing or creat Line 97  C         Append to an existing or creat
97            CALL MNC_CW_FILE_AORC(myThid, fname, indf)            CALL MNC_CW_FILE_AORC(myThid, fname, indf)
98            fid = mnc_f_info(indf,2)            fid = mnc_f_info(indf,2)
99    
100  C         Ensure that all the NetCDF dims are defined and create a local  C         Ensure that all the NetCDF dimensions are defined and create a
101  C         copy  C         local copy of them
102            DO i = 1,9            DO i = 1,9
103              dimnc(i) = 1              dimnc(i) = 1
104            ENDDO            ENDDO
105            DO i = 1,mnc_cw_ndim(igrid)            DO i = 1,mnc_cw_ndim(igrid)
106              dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1              IF (mnc_cw_dims(i,igrid) .EQ. -1) THEN
107                  dimnc(i) = -1
108                ELSE
109                  dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1
110                ENDIF
111              CALL MNC_DIM_INIT(myThid,fname,              CALL MNC_DIM_INIT(myThid,fname,
112       &           mnc_cw_dn(i,igrid), dimnc(i) )       &           mnc_cw_dn(i,igrid), dimnc(i) )
113            ENDDO            ENDDO
# Line 131  C         Ensure that the variable is de Line 138  C         Ensure that the variable is de
138            stop 'ABNORMAL END: package MNC'            stop 'ABNORMAL END: package MNC'
139   10       CONTINUE   10       CONTINUE
140    
141    C         Check for bi,bj indicies
142              bidim = mnc_cw_vbij(1,indv)
143              bjdim = mnc_cw_vbij(2,indv)
144    
145  C         Set the dimensions for the in-memory array  C         Set the dimensions for the in-memory array
146            ndim = mnc_cw_ndim(igrid)            ndim = mnc_cw_ndim(igrid)
147            p(1) = mnc_cw_dims(1,igrid)            k = mnc_cw_dims(1,igrid)
148              IF (k .GT. 0) THEN
149                p(1) = k
150              ELSE
151                p(1) = 1
152              ENDIF
153            DO i = 2,9            DO i = 2,9
154              p(i) = mnc_cw_dims(i,igrid) * p(i-1)              k = mnc_cw_dims(i,igrid)
155                IF (k .LT. 1) THEN
156                  k = 1
157                ENDIF
158                IF ((bidim .GT. 0) .AND. (i .EQ. bidim)) THEN
159                  p(i) = nSx * p(i-1)
160                ELSEIF ((bjdim .GT. 0) .AND. (i .EQ. bjdim)) THEN
161                  p(i) = nSy * p(i-1)
162                ELSE
163                  p(i) = k * p(i-1)
164                ENDIF
165            ENDDO            ENDDO
166    
167  C         Set the starting and ending indicies  C         Set starting and ending indicies for the in-memory array and
168    C         the unlimited dimension offset for the NetCDF array
169            DO i = 1,9            DO i = 1,9
170              IF (i .GT. ndim) THEN              udo(i) = 0
171                s(i) = 1              s(i) = 1
172                e(i) = 1              e(i) = 1
173              ELSE              IF (i .LE. ndim) THEN
174                IF ((i .EQ. ndim)                s(i) = mnc_cw_is(i,igrid)
175       &             .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN                e(i) = mnc_cw_ie(i,igrid)
176                  s(i) = indu              ENDIF
177                  e(i) = indu  C           Check for the unlimited dimension
178                IF ((i .EQ. ndim)
179         &           .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
180                  IF (indu .GT. 0) THEN
181    C               Use the indu value
182                    udo(i) = indu - 1
183                  ELSEIF (indu .EQ. -1) THEN
184    C               Append one to the current unlimited dim size
185                    CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
186                    udo(i) = unlim_sz
187                ELSE                ELSE
188                  s(i) = mnc_cw_is(i,igrid)  C               Use the current unlimited dim size
189                  e(i) = mnc_cw_ie(i,igrid)                  CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
190                    udo(i) = unlim_sz - 1
191                ENDIF                ENDIF
192              ENDIF              ENDIF
193            ENDDO            ENDDO
194              IF (bidim .GT. 0) THEN
195                s(bidim) = lbi
196                e(bidim) = lbi
197              ENDIF
198              IF (bjdim .GT. 0) THEN
199                s(bjdim) = lbj
200                e(bjdim) = lbj
201              ENDIF
202    CEH3          DO i = 1,7
203    CEH3            write(*,*) 'i,s(i),e(i) = ', i,s(i),e(i)
204    CEH3          ENDDO
205    
206    C         Add the global attributes
207              CALL MNC_CW_SET_GATTR(myThid, fname, lbi,lbj, uniq_tnum)
208    
209    C         Add the per-variable attributes
210              DO i = 1,mnc_cw_vnat(1,indv)
211                CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vtype,
212         &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv))
213              ENDDO
214              DO i = 1,mnc_cw_vnat(2,indv)
215                CALL MNC_VAR_ADD_ATTR_INT(myThid, fname, vtype,
216         &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv))
217              ENDDO
218              DO i = 1,mnc_cw_vnat(3,indv)
219                CALL MNC_VAR_ADD_ATTR_DBL(myThid, fname, vtype,
220         &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv))
221              ENDDO
222    
223            CALL MNC_FILE_ENDDEF(myThid,fname)            CALL MNC_FILE_ENDDEF(myThid,fname)
224    
225  C         Write the variable one vector at a time  C         Write the variable one vector at a time
226            DO j5 = s(5),e(5)            DO j7 = s(7),e(7)
227              k5 = (j5 - s(5))*p(4)              k7 = (j7 - s(7))*p(6)
228              vstart(5) = j5 - s(5) + 1              vstart(7) = udo(7) + j7 - s(7) + 1
229              vcount(5) = 1              vcount(7) = 1
230              DO j4 = s(4),e(4)              DO j6 = s(6),e(6)
231                k4 = (j4 - s(4))*p(3) + k5                k6 = (j6 - s(6))*p(5) + k7
232                vstart(4) = j4 - s(4) + 1                vstart(6) = udo(6) + j6 - s(6) + 1
233                vcount(4) = 1                vcount(6) = 1
234                DO j3 = s(3),e(3)                DO j5 = s(5),e(5)
235                  k3 = (j3 - s(3))*p(2) + k4                  k5 = (j5 - s(5))*p(4) + k6
236                  vstart(3) = j3 - s(3) + 1                  vstart(5) = udo(5) + j5 - s(5) + 1
237                  vcount(3) = 1                  vcount(5) = 1
238                  DO j2 = s(2),e(2)                  DO j4 = s(4),e(4)
239                    k2 = (j2 - s(2))*p(1) + k3                    k4 = (j4 - s(4))*p(3) + k5
240                    vstart(2) = j2 - s(2) + 1                    vstart(4) = udo(4) + j4 - s(4) + 1
241                    vcount(2) = 1                    vcount(4) = 1
242                      DO j3 = s(3),e(3)
243                    kr = 0                      k3 = (j3 - s(3))*p(2) + k4
244                    DO j1 = s(1),e(1)                      vstart(3) = udo(3) + j3 - s(3) + 1
245                      k1 = k2 + j1                      vcount(3) = 1
246                      kr = kr + 1                      DO j2 = s(2),e(2)
247                      resh(kr) = var(k1)                        k2 = (j2 - s(2))*p(1) + k3
248                    ENDDO                        vstart(2) = udo(2) + j2 - s(2) + 1
249                          vcount(2) = 1
250    
251                    vstart(1) = 1  CEH3      write(*,*) 's/e: ', k2+s(1), k2+e(1)
252                    vcount(1) = e(1) - s(1) + 1        
253          kr = 0
254  CEH3      write(*,*) ' # ', j2,j3,j4,j5, '  #  ',        DO j1 = s(1),e(1)
255  CEH3     &     (vstart(i),vcount(i),i=1,5)          k1 = k2 + j1
256            kr = kr + 1
257            resh(kr) = var(k1)
258          ENDDO
259          
260          vstart(1) = udo(1) + 1
261          vcount(1) = e(1) - s(1) + 1
262    
263  #ifdef  mnc_rtype_D  #ifdef  mnc_rtype_D
264        err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh)        err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
# Line 195  CEH3     &     (vstart(i),vcount(i),i=1, Line 267  CEH3     &     (vstart(i),vcount(i),i=1,
267        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
268  #endif  #endif
269    
270                        ENDDO
271                      ENDDO
272                  ENDDO                  ENDDO
273                ENDDO                ENDDO
274              ENDDO              ENDDO
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22