/[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.5 by edhill, Thu Feb 26 22:31:58 2004 UTC revision 1.6 by edhill, Mon Mar 8 21:15:49 2004 UTC
# Line 24  C---+----1----+----2----+----3----+----4 Line 24  C---+----1----+----2----+----3----+----4
24  C     Arguments  C     Arguments
25        integer myThid, bi,bj, indu        integer myThid, bi,bj, indu
26        character*(*) fbname, vtype        character*(*) fbname, vtype
27        _RX var(*)        __V var(*)
28    
29  C     Functions  C     Functions
30        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
# Line 41  C     Local Variables Line 41  C     Local Variables
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
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
49    #ifdef  mnc_rtype_I
50          INTEGER resh( sNx + 2*OLx + sNy + 2*OLy )
51  #endif  #endif
52    
53  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
# Line 55  C     Check that the Variable Type exist Line 58  C     Check that the Variable Type exist
58        nvl = ILNBLNK(vtype)        nvl = ILNBLNK(vtype)
59        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)
60        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
61          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',          write(msgbuf,'(3a)') 'MNC_CW_RX_W_YY ERROR: vtype ''',
62       &       vtype(nvf:nvl), ''' is not defined'       &       vtype(nvf:nvl), ''' is not defined'
63          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
64          STOP 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_YY'
65        ENDIF        ENDIF
66        igrid = mnc_cw_vgind(indv)        igrid = mnc_cw_vgind(indv)
67    
# Line 121  C         Ensure that the variable is de Line 124  C         Ensure that the variable is de
124  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
125        CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)        CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)
126  #endif  #endif
127    #ifdef  mnc_rtype_I
128          CALL MNC_VAR_INIT_INT(myThid,fname,mnc_cw_gname(igrid),vtype)
129    #endif
130            DO i = 1,mnc_fv_ids(indf,1)            DO i = 1,mnc_fv_ids(indf,1)
131              j = 2 + 3*(i - 1)              j = 2 + 3*(i - 1)
132              IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN              IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN
# Line 130  C         Ensure that the variable is de Line 136  C         Ensure that the variable is de
136                GOTO 10                GOTO 10
137              ENDIF              ENDIF
138            ENDDO            ENDDO
139            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W_YY ERROR: ',
140       &         'cannot reference variable ''', vtype, ''''       &         'cannot reference variable ''', vtype, ''''
141            CALL print_error(msgbuf, mythid)            CALL print_error(msgbuf, mythid)
142            STOP 'ABNORMAL END: package MNC'            STOP 'ABNORMAL END: package MNC'
# Line 263  C         Write the variable one vector Line 269  C         Write the variable one vector
269  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
270        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
271  #endif  #endif
272    #ifdef  mnc_rtype_I
273          err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh)
274    #endif
275    
276                      ENDDO                      ENDDO
277                    ENDDO                    ENDDO
# Line 274  C         Write the variable one vector Line 283  C         Write the variable one vector
283  C         Sync the file  C         Sync the file
284            err = NF_SYNC(fid)            err = NF_SYNC(fid)
285            write(msgbuf,'(3a)') 'sync for file ''', fname,            write(msgbuf,'(3a)') 'sync for file ''', fname,
286       &         ''' in S/R MNC_CW_RX_WRITES_YY'       &         ''' in S/R MNC_CW_RX_W_YY'
287            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
288    
289          ENDDO          ENDDO
# Line 308  C---+----1----+----2----+----3----+----4 Line 317  C---+----1----+----2----+----3----+----4
317  C     Arguments  C     Arguments
318        integer myThid, bi,bj, indu        integer myThid, bi,bj, indu
319        character*(*) fbname, vtype        character*(*) fbname, vtype
320        _RX var(*)        __V var(*)
321    
322  C     Functions  C     Functions
323        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
324    
325  C     Local Variables  C     Local Variables
326        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot        integer i,k, indv,nvf,nvl, n1,n2, igrid, ntot
327        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv
328        integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr        integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
329        integer ind_fv_ids, ind_vt        integer ind_fv_ids, ind_vt, ierr, atype, alen
330        integer f_sNx,f_sNy,f_OLx,f_OLy, ires        integer f_sNx,f_sNy, ires
331          integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)
332          integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
333        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
334        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_CHAR) fname
335    
336  C     Temporary storage for the simultaneous type conversion and  C     Temporary storage for the simultaneous type conversion and
337  C     re-shaping before passing to NetCDF  C     re-shaping before passing to NetCDF
338  #ifdef  mnc_rtype_D  #ifdef  mnc_rtype_D
339        REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*8  resh( sNx + 2*OLx + sNy + 2*OLy )
340  #endif  #endif
341  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
342        REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*4  resh( sNx + 2*OLx + sNy + 2*OLy )
343    #endif
344    #ifdef  mnc_rtype_I
345          INTEGER resh( sNx + 2*OLx + sNy + 2*OLy )
346  #endif  #endif
347    
348  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
# Line 347  C     Check that the Variable Type exist Line 361  C     Check that the Variable Type exist
361        igrid = mnc_cw_vgind(ind_vt)        igrid = mnc_cw_vgind(ind_vt)
362    
363  C     Check for bi,bj indicies  C     Check for bi,bj indicies
364        bidim = mnc_cw_vbij(1,indv)        bidim = mnc_cw_vbij(1,ind_vt)
365        bjdim = mnc_cw_vbij(2,indv)        bjdim = mnc_cw_vbij(2,ind_vt)
366    
367  C     Set the bi,bj indicies  C     Set the bi,bj indicies
368        bis = bi        bis = bi
# Line 378  C         Create the file name Line 392  C         Create the file name
392            fname(ntot:ntot) = '.'            fname(ntot:ntot) = '.'
393            write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'            write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
394            nfname = ntot+9            nfname = ntot+9
395          write(*,*) 'The read file is: ', fname(1:nfname)
396    
397  C         Open the existing file  C         Open the existing file
398            CALL MNC_FILE_OPEN(myThid, fname, 1, indf)            CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)
399    
400  C         Check that the variable (VType) is defined within the file  C         Check that the variable (VType) is defined within the file
401            CALL MNC_GET_FVINDS(myThid, fname, vtype, indf, ind_fv_ids)            CALL MNC_GET_FVINDS(myThid, fname, vtype, indf, ind_fv_ids)
# Line 392  C         Check that the variable (VType Line 407  C         Check that the variable (VType
407              STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'              STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
408            ENDIF            ENDIF
409            fid = mnc_f_info(indf,2)            fid = mnc_f_info(indf,2)
410              idv = mnc_fv_ids(indf,ind_fv_ids+1)
411    
412          write(*,*) 'indf,ind_fv_ids = ', indf,ind_fv_ids
413    
414  C         Check that the VType sizes and in-file sizes match  C         Check that the current sNy,sNy values and the in-file values
415            err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', NF_INT, 1, f_sNx)  C         are compatible and WARN (only warn) if not
416            CALL MNC_HANDLE_ERR(myThid, err,            f_sNx = -1
417       &         'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY')            f_sNy = -1
418            err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', NF_INT, 1, f_sNy)            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)
419            CALL MNC_HANDLE_ERR(myThid, err,            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
420       &         'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY')              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)
421            err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'OLx', NF_INT, 1, f_OLx)              CALL MNC_HANDLE_ERR(myThid, err,
422            CALL MNC_HANDLE_ERR(myThid, err,       &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY')
423       &         'reading attribute ''OLx'' in S/R MNC_CW_RX_R_YY')            ENDIF
424            err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'OLy', NF_INT, 1, f_OLy)            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)
425            CALL MNC_HANDLE_ERR(myThid, err,            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
426       &         'reading attribute ''OLy'' in S/R MNC_CW_RX_R_YY')              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)
427                CALL MNC_HANDLE_ERR(myThid, err,
428         &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY')
429              ENDIF
430            IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN            IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN
431              write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY ERROR: the sizes of ',              write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY WARNING: the ',
432       &           '''sNx'' and ''sNy'' within the file ''',       &           'attributes ''sNx'' and ''sNy'' within the file ''',
433       &           fname(1:nfname), ''' do not match the current sizes',       &           fname(1:nfname), ''' do not exist or do not match ',
434       &           ' within the model'       &           'the current sizes within the model'
435              CALL print_error(msgbuf, mythid)              CALL print_error(msgbuf, mythid)
             STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'  
436            ENDIF            ENDIF
437    
438            CALL MNC_COMP_VTYPE_VAR(myThid,ind_vt, indf,ind_fv_ids, ires)  C         Check that the in-memory variable and the in-file variables
439    C         are of compatible sizes
440              ires = 1
441              CALL MNC_CHK_VTYP_R_NCVAR(myThid, ind_vt,
442         &         indf, ind_fv_ids, indu, ires)
443            IF (ires .LT. 0) THEN            IF (ires .LT. 0) THEN
444              write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY ERROR: the sizes of ',              write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY WARNING: the sizes ',
445       &           ' the in-program variable ''', vtype(nvf:nvl),       &           'of the in-program variable ''', vtype(nvf:nvl),
446       &           ''' and the corresponding variable within file ''',       &           ''' and the corresponding variable within file ''',
447       &           fname(1:nfname), ''' are not compatible -- please ',       &           fname(1:nfname), ''' are not compatible -- please ',
448       &           'check the sizes!'       &           'check the sizes'
449              CALL print_error(msgbuf, mythid)              CALL print_error(msgbuf, mythid)
450              STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'              STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
451            ENDIF            ENDIF
452    
453    C         Check for bi,bj indicies
454              bidim = mnc_cw_vbij(1,ind_vt)
455              bjdim = mnc_cw_vbij(2,ind_vt)
456              write(*,*) 'bidim,bjdim = ', bidim,bjdim
457    
458    C         Set the dimensions for the in-memory array
459              ndim = mnc_cw_ndim(igrid)
460              k = mnc_cw_dims(1,igrid)
461              IF (k .GT. 0) THEN
462                p(1) = k
463              ELSE
464                p(1) = 1
465              ENDIF
466              DO i = 2,9
467                k = mnc_cw_dims(i,igrid)
468                IF (k .LT. 1) THEN
469                  k = 1
470                ENDIF
471                IF ((bidim .GT. 0) .AND. (i .EQ. bidim)) THEN
472                  p(i) = nSx * p(i-1)
473                ELSEIF ((bjdim .GT. 0) .AND. (i .EQ. bjdim)) THEN
474                  p(i) = nSy * p(i-1)
475                ELSE
476                  p(i) = k * p(i-1)
477                ENDIF
478              ENDDO
479    
480    C         Set starting and ending indicies for the in-memory array and
481    C         the unlimited dimension offset for the NetCDF array
482              DO i = 1,9
483                udo(i) = 0
484                s(i) = 1
485                e(i) = 1
486                IF (i .LE. ndim) THEN
487                  s(i) = mnc_cw_is(i,igrid)
488                  e(i) = mnc_cw_ie(i,igrid)
489                ENDIF
490    C           Check for the unlimited dimension
491                IF ((i .EQ. ndim)
492         &           .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
493                  IF (indu .GT. 0) THEN
494    C               Use the indu value
495                    udo(i) = indu - 1
496                  ELSEIF (indu .EQ. -1) THEN
497    C               Append one to the current unlimited dim size
498                    CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
499                    udo(i) = unlim_sz
500                  ELSE
501    C               Use the current unlimited dim size
502                    CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
503                    udo(i) = unlim_sz - 1
504                  ENDIF
505                ENDIF
506              ENDDO
507              IF (bidim .GT. 0) THEN
508                s(bidim) = lbi
509                e(bidim) = lbi
510              ENDIF
511              IF (bjdim .GT. 0) THEN
512                s(bjdim) = lbj
513                e(bjdim) = lbj
514              ENDIF
515    
516          DO i = 9,1,-1
517            write(*,*) 'i,p(i),s(i),e(i) = ', i,': ',p(i),s(i),e(i)
518          ENDDO
519              
520              CALL MNC_FILE_ENDDEF(myThid,fname)
521    
522              write(msgbuf,'(5a)') 'reading variable type ''',
523         &         vtype(nvf:nvl), ''' within file ''',
524         &         fname(1:nfname), ''''
525    
526    C         Read the variable one vector at a time
527              DO j7 = s(7),e(7)
528                k7 = (j7 - 1)*p(6)
529                vstart(7) = udo(7) + j7 - s(7) + 1
530                vcount(7) = 1
531                DO j6 = s(6),e(6)
532                  k6 = (j6 - 1)*p(5) + k7
533                  vstart(6) = udo(6) + j6 - s(6) + 1
534                  vcount(6) = 1
535                  DO j5 = s(5),e(5)
536                    k5 = (j5 - 1)*p(4) + k6
537                    vstart(5) = udo(5) + j5 - s(5) + 1
538                    vcount(5) = 1
539                    DO j4 = s(4),e(4)
540                      k4 = (j4 - 1)*p(3) + k5
541                      vstart(4) = udo(4) + j4 - s(4) + 1
542                      vcount(4) = 1
543                      DO j3 = s(3),e(3)
544                        k3 = (j3 - 1)*p(2) + k4
545                        vstart(3) = udo(3) + j3 - s(3) + 1
546                        vcount(3) = 1
547                        DO j2 = s(2),e(2)
548                          k2 = (j2 - 1)*p(1) + k3
549                          vstart(2) = udo(2) + j2 - s(2) + 1
550                          vcount(2) = 1
551    
552          vstart(1) = udo(1) + 1
553          vcount(1) = e(1) - s(1) + 1
554          
555    #ifdef  mnc_rtype_D
556          err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
557    #endif
558    #ifdef  mnc_rtype_R
559          err = NF_GET_VARA_REAL(fid, idv, vstart, vcount, resh)
560    #endif
561    #ifdef  mnc_rtype_I
562          err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh)
563    #endif
564    
565          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
566    
567          kr = 0
568          DO j1 = s(1),e(1)
569            k1 = k2 + j1
570            kr = kr + 1
571            var(k1) = resh(kr)
572          ENDDO
573          
574    
575                        ENDDO
576                      ENDDO
577                    ENDDO
578                  ENDDO
579                ENDDO
580              ENDDO
581    
582    C         End the lbj,lbi loops
583          ENDDO          ENDDO
584        ENDDO        ENDDO
585    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22