/[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.4 by edhill, Thu Feb 5 05:42:07 2004 UTC revision 1.5 by edhill, Thu Feb 26 22:31:58 2004 UTC
# Line 58  C     Check that the Variable Type exist Line 58  C     Check that the Variable Type exist
58          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',
59       &       vtype(nvf:nvl), ''' 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)        igrid = mnc_cw_vgind(indv)
64    
65  C      C     Set the bi,bj indicies
66        bis = bi        bis = bi
67        bie = bi        bie = bi
68        IF (bi .LT. 1) THEN        IF (bi .LT. 1) THEN
# Line 133  C         Ensure that the variable is de Line 133  C         Ensure that the variable is de
133            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',
134       &         'cannot reference variable ''', vtype, ''''       &         'cannot reference variable ''', vtype, ''''
135            CALL print_error(msgbuf, mythid)            CALL print_error(msgbuf, mythid)
136            stop 'ABNORMAL END: package MNC'            STOP 'ABNORMAL END: package MNC'
137   10       CONTINUE   10       CONTINUE
138    
139  C         Check for bi,bj indicies  C         Check for bi,bj indicies
# Line 247  C         Write the variable one vector Line 247  C         Write the variable one vector
247                        vstart(2) = udo(2) + j2 - s(2) + 1                        vstart(2) = udo(2) + j2 - s(2) + 1
248                        vcount(2) = 1                        vcount(2) = 1
249    
 CEH3      write(*,*) 's/e: ', k2+s(1), k2+e(1)  
         
250        kr = 0        kr = 0
251        DO j1 = s(1),e(1)        DO j1 = s(1),e(1)
252          k1 = k2 + j1          k1 = k2 + j1
# Line 281  C         Sync the file Line 279  C         Sync the file
279    
280          ENDDO          ENDDO
281        ENDDO        ENDDO
282    
283          _END_MASTER( myThid )
284    
285          RETURN
286          END
287          
288    
289    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
290    
291    
292          SUBROUTINE MNC_CW_RX_R_YY(
293         I     myThid,
294         I     fbname, bi,bj,
295         I     vtype,
296         I     indu,
297         I     var )
298    
299          implicit none
300    
301    #include "netcdf.inc"
302    #include "mnc_common.h"
303    #include "EEPARAMS.h"
304    #include "SIZE.h"
305    
306    #define mnc_rtype_YY
307    
308    C     Arguments
309          integer myThid, bi,bj, indu
310          character*(*) fbname, vtype
311          _RX var(*)
312    
313    C     Functions
314          integer IFNBLNK, ILNBLNK
315    
316    C     Local Variables
317          integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot
318          integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids
319          integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
320          integer ind_fv_ids, ind_vt
321          integer f_sNx,f_sNy,f_OLx,f_OLy, ires
322          character*(MAX_LEN_MBUF) msgbuf
323          character*(MNC_MAX_CHAR) fname
324    
325    C     Temporary storage for the simultaneous type conversion and
326    C     re-shaping before passing to NetCDF
327    #ifdef  mnc_rtype_D
328          REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )
329    #endif
330    #ifdef  mnc_rtype_R
331          REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )
332    #endif
333    
334    C     Only do I/O if I am the master thread
335          _BEGIN_MASTER( myThid )
336    
337    C     Check that the Variable Type exists
338          nvf = IFNBLNK(vtype)
339          nvl = ILNBLNK(vtype)
340          CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt)
341          IF (indv .LT. 1) THEN
342            write(msgbuf,'(3a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
343         &       vtype(nvf:nvl), ''' is not defined'
344            CALL print_error(msgbuf, mythid)
345            STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
346          ENDIF
347          igrid = mnc_cw_vgind(ind_vt)
348    
349    C     Check for bi,bj indicies
350          bidim = mnc_cw_vbij(1,indv)
351          bjdim = mnc_cw_vbij(2,indv)
352    
353    C     Set the bi,bj indicies
354          bis = bi
355          bie = bi
356          IF (bi .LT. 1) THEN
357            bis = 1
358            bie = nSx
359          ENDIF
360          bjs = bj
361          bje = bj
362          IF (bj .LT. 1) THEN
363            bjs = 1
364            bje = nSy
365          ENDIF
366    
367          DO lbj = bjs,bje
368            DO lbi = bis,bie
369    
370    C         Create the file name
371              CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)
372              fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
373              n1 = IFNBLNK(fbname)
374              n2 = ILNBLNK(fbname)
375              ntot = n2 - n1 + 1
376              fname(1:ntot) = fbname(n1:n2)
377              ntot = ntot + 1
378              fname(ntot:ntot) = '.'
379              write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
380              nfname = ntot+9
381    
382    C         Open the existing file
383              CALL MNC_FILE_OPEN(myThid, fname, 1, indf)
384    
385    C         Check that the variable (VType) is defined within the file
386              CALL MNC_GET_FVINDS(myThid, fname, vtype, indf, ind_fv_ids)
387              IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN
388                write(msgbuf,'(4a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
389         &           vtype(nvf:nvl), ''' is not defined within file ''',
390         &           fname(1:nfname)
391                CALL print_error(msgbuf, mythid)
392                STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
393              ENDIF
394              fid = mnc_f_info(indf,2)
395    
396    C         Check that the VType sizes and in-file sizes match
397              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', NF_INT, 1, f_sNx)
398              CALL MNC_HANDLE_ERR(myThid, err,
399         &         'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY')
400              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', NF_INT, 1, f_sNy)
401              CALL MNC_HANDLE_ERR(myThid, err,
402         &         'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY')
403              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'OLx', NF_INT, 1, f_OLx)
404              CALL MNC_HANDLE_ERR(myThid, err,
405         &         'reading attribute ''OLx'' in S/R MNC_CW_RX_R_YY')
406              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'OLy', NF_INT, 1, f_OLy)
407              CALL MNC_HANDLE_ERR(myThid, err,
408         &         'reading attribute ''OLy'' in S/R MNC_CW_RX_R_YY')
409              IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN
410                write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY ERROR: the sizes of ',
411         &           '''sNx'' and ''sNy'' within the file ''',
412         &           fname(1:nfname), ''' do not match the current sizes',
413         &           ' within the model'
414                CALL print_error(msgbuf, mythid)
415                STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
416              ENDIF
417    
418              CALL MNC_COMP_VTYPE_VAR(myThid,ind_vt, indf,ind_fv_ids, ires)
419    
420              IF (ires .LT. 0) THEN
421                write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY ERROR: the sizes of ',
422         &           ' the in-program variable ''', vtype(nvf:nvl),
423         &           ''' and the corresponding variable within file ''',
424         &           fname(1:nfname), ''' are not compatible -- please ',
425         &           'check the sizes!'
426                CALL print_error(msgbuf, mythid)
427                STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
428              ENDIF
429    
430    
431            ENDDO
432          ENDDO
433    
434        _END_MASTER( myThid )        _END_MASTER( myThid )
435    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22