/[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.1 by edhill, Sat Jan 31 04:13:09 2004 UTC revision 1.2 by edhill, Wed Feb 4 05:45:09 2004 UTC
# Line 17  C---+----1----+----2----+----3----+----4 Line 17  C---+----1----+----2----+----3----+----4
17  #include "netcdf.inc"  #include "netcdf.inc"
18  #include "mnc_common.h"  #include "mnc_common.h"
19  #include "EEPARAMS.h"  #include "EEPARAMS.h"
20  #include "EESUPPORT.h"  #include "SIZE.h"
21  #include "PARAMS.h"  
22  #include "GRID.h"  #define mnc_rtype_YY
23    
24  C     Arguments  C     Arguments
25        integer myThid, bi,bj, indu        integer myThid, bi,bj, indu
# 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, indv,nvf,nvl, n1,n2        integer i,j, indv,nvf,nvl, n1,n2, igrid, ntot
34        integer bis,bie, bjs,bje, iG,jG, uniq_tnum        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids
35        integer tile_num        integer ndim, indf, err, lbi,lbj
36          integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), kr
37          integer j1,j2,j3,j4,j5, k1,k2,k3,k4,k5
38        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
39        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_CHAR) fname
40    
41  C     Temporary storage for the simultaneous type conversion and  C     Temporary storage for the simultaneous type conversion and
42  C     re-shaping before passing to NetCDF  C     re-shaping before passing to NetCDF
 #define mnc_rtype_YY  
43  #ifdef  mnc_rtype_D  #ifdef  mnc_rtype_D
44        REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )
45  #endif  #endif
46  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
47        REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )
48  #endif  #endif
 #undef mnc_rtype_YY  
49    
50  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
51        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
# Line 54  C     Check that the Variable Type exist Line 54  C     Check that the Variable Type exist
54        nvf = IFNBLNK(vtype)        nvf = IFNBLNK(vtype)
55        nvl = ILNBLNK(vtype)        nvl = ILNBLNK(vtype)
56        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv)
57        IF (indg .LT. 1) THEN        IF (indv .LT. 1) THEN
58          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',
59       &       vtype(nff:nfl), ''' is not defined'       &       vtype(nvf:nvl), ''' is not defined'
60          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
61          stop 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'          stop 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'
62        ENDIF        ENDIF
63          igrid = mnc_cw_vgind(indv)
64    
65          bis = bi
66          bie = bi
67        IF (bi .LT. 1) THEN        IF (bi .LT. 1) THEN
68          bis = 1          bis = 1
69          bie = nSx          bie = nSx
       ELSE  
         bis = bi  
         bie = bi  
70        ENDIF        ENDIF
71          bjs = bj
72          bje = bj
73        IF (bj .LT. 1) THEN        IF (bj .LT. 1) THEN
74          bjs = 1          bjs = 1
75          bje = nSy          bje = nSy
       ELSE  
         bjs = bj  
         bje = bj  
76        ENDIF        ENDIF
77    
78        DO bj = bjs,bje        DO lbj = bjs,bje
79          DO bi = bis,bie          DO lbi = bis,bie
80    
81  C         Create the file name  C         Create the file name
82            CALL MNC_CW_GET_TILE_NUM(myThid, bi,bj, uniq_tnum)            CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)
83            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
84            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
85            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
# Line 89  C         Create the file name Line 88  C         Create the file name
88            ntot = ntot + 1            ntot = ntot + 1
89            fname(ntot:ntot) = '.'            fname(ntot:ntot) = '.'
90            write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'            write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
91              nfname = ntot+9
92    
93    C         Append to an existing or create a new file
94              CALL MNC_CW_FILE_AORC(myThid, fname, indf)
95              fid = mnc_f_info(indf,2)
96    
97    C         Ensure that all the NetCDF dims are defined and create a local
98    C         copy
99              DO i = 1,9
100                dimnc(i) = 1
101              ENDDO
102              DO i = 1,mnc_cw_ndim(igrid)
103                dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1
104                CALL MNC_DIM_INIT(myThid,fname,
105         &           mnc_cw_dn(i,igrid), dimnc(i) )
106              ENDDO
107    
108    C         Ensure that the "grid" is defined
109              CALL MNC_GRID_INIT(myThid,fname, mnc_cw_gname(igrid),
110         &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid))
111    
112    C         Ensure that the variable is defined
113    #ifdef  mnc_rtype_D
114          CALL MNC_VAR_INIT_DBL(myThid,fname,mnc_cw_gname(igrid),vtype)
115    #endif
116    #ifdef  mnc_rtype_R
117          CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)
118    #endif
119              DO i = 1,mnc_fv_ids(indf,1)
120                j = 2 + 3*(i - 1)
121                IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN
122                  idv = mnc_fv_ids(indf,j+1)
123                  indvids = mnc_fd_ind(indf, mnc_f_info(indf,
124         &             (mnc_fv_ids(indf,j+2) + 1)) )
125                  GOTO 10
126                ENDIF
127              ENDDO
128              write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',
129         &         'cannot reference variable ''', vtype, ''''
130              CALL print_error(msgbuf, mythid)
131              stop 'ABNORMAL END: package MNC'
132     10       CONTINUE
133    
134    C         Set the dimensions for the in-memory array
135              ndim = mnc_cw_ndim(igrid)
136              p(1) = mnc_cw_dims(1,igrid)
137              DO i = 2,9
138                p(i) = mnc_cw_dims(i,igrid) * p(i-1)
139              ENDDO
140    
141    C         Set the starting and ending indicies
142              DO i = 1,9
143                IF (i .GT. ndim) THEN
144                  s(i) = 1
145                  e(i) = 1
146                ELSE
147                  IF ((i .EQ. ndim)
148         &             .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
149                    s(i) = indu
150                    e(i) = indu
151                  ELSE
152                    s(i) = mnc_cw_is(i,igrid)
153                    e(i) = mnc_cw_ie(i,igrid)
154                  ENDIF
155                ENDIF
156              ENDDO
157    
158              CALL MNC_FILE_ENDDEF(myThid,fname)
159    
160    C         Write the variable one vector at a time
161              DO j5 = s(5),e(5)
162                k5 = (j5 - s(5))*p(4)
163                vstart(5) = j5 - s(5) + 1
164                vcount(5) = 1
165                DO j4 = s(4),e(4)
166                  k4 = (j4 - s(4))*p(3) + k5
167                  vstart(4) = j4 - s(4) + 1
168                  vcount(4) = 1
169                  DO j3 = s(3),e(3)
170                    k3 = (j3 - s(3))*p(2) + k4
171                    vstart(3) = j3 - s(3) + 1
172                    vcount(3) = 1
173                    DO j2 = s(2),e(2)
174                      k2 = (j2 - s(2))*p(1) + k3
175                      vstart(2) = j2 - s(2) + 1
176                      vcount(2) = 1
177    
178                      kr = 0
179                      DO j1 = s(1),e(1)
180                        k1 = k2 + j1
181                        kr = kr + 1
182                        resh(kr) = var(k1)
183                      ENDDO
184    
185  C         Append to existing or create new file                    vstart(1) = 1
186            CALL MNC_CW_FILE_AORC(myThid, fname)                    vcount(1) = e(1) - s(1) + 1
187    
188  C         Write the variable one row at a time  CEH3      write(*,*) ' # ', j2,j3,j4,j5, '  #  ',
189    CEH3     &     (vstart(i),vcount(i),i=1,5)
190    
191    #ifdef  mnc_rtype_D
192          err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
193    #endif
194    #ifdef  mnc_rtype_R
195          err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
196    #endif
197    
198                    ENDDO
199                  ENDDO
200                ENDDO
201              ENDDO
202    
203    C         Sync the file
204              err = NF_SYNC(fid)
205              write(msgbuf,'(3a)') 'sync for file ''', fname,
206         &         ''' in S/R MNC_CW_RX_WRITES_YY'
207              CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
208    
209          ENDDO          ENDDO
210        ENDDO        ENDDO
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22