/[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.31 by edhill, Mon Jun 27 20:19:52 2005 UTC revision 1.32 by edhill, Sat Sep 10 18:30:07 2005 UTC
# Line 93  C     !USES: Line 93  C     !USES:
93  #include "netcdf.inc"  #include "netcdf.inc"
94  #include "mnc_common.h"  #include "mnc_common.h"
95  #include "SIZE.h"  #include "SIZE.h"
96  #include "MNC_SIZE.h"  #include "MNC_BUFF.h"
97  #include "EEPARAMS.h"  #include "EEPARAMS.h"
98  #include "PARAMS.h"  #include "PARAMS.h"
99  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
# Line 107  CEOP Line 107  CEOP
107    
108  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
109        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu
110        integer bis,bie, bjs,bje, uniq_tnum, nfname, iseq        integer bis,bie, bjs,bje, uniq_tnum, uniq_fnum, nfname, iseq
111        integer fid, idv, indvids, ndim, indf, err        integer fid, idv, indvids, ndim, indf, err
112        integer lbi,lbj, bidim,bjdim, unlim_sz, kr        integer lbi,lbj, bidim,bjdim, unlim_sz, kr
113        integer p(9),s(9),e(9), dimnc(9)        integer p(9),s(9),e(9), dimnc(9)
# Line 117  C     !LOCAL VARIABLES: Line 117  C     !LOCAL VARIABLES:
117        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
118        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_CHAR) fname
119        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_CHAR) path_fname
120          character*(MNC_MAX_CHAR) tmpnm
121        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
122        REAL*4  resh_r( MNC_MAX_BUFF )        REAL*4  resh_r( MNC_MAX_BUFF )
123        INTEGER resh_i( MNC_MAX_BUFF )        INTEGER resh_i( MNC_MAX_BUFF )
# Line 188  C         Create the file name Line 189  C         Create the file name
189            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
190            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
191            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
192    
193    #ifdef MNC_WRITE_OLDNAMES
194    
195            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
196            fname(1:ntot) = fbname(n1:n2)            fname(1:ntot) = fbname(n1:n2)
197            ntot = ntot + 1            ntot = ntot + 1
# Line 204  C         Create the file name Line 208  C         Create the file name
208              nfname = ntot + 14              nfname = ntot + 14
209            ENDIF            ENDIF
210    
211    #else
212    
213              CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
214              k = ILNBLNK(tmpnm)
215              IF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .GT. -1 ) THEN
216                write(fname,'(a,a1,i10.10,a2,a,a3)') fbname(n1:n2),
217         &           '.', mnc_cw_cit(2,mnc_cw_fgci(indfg)),
218         &           '.t',tmpnm(1:k),'.nc'
219              ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN
220    C           Leave off the myIter value entirely
221                write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t',
222         &           tmpnm(1:k),'.nc'
223              ELSE
224    C           We have an error--bad flag value
225                write(msgbuf,'(4a)')
226         &           'MNC_CW_RX_W ERROR: bad mnc_cw_cit(1,...) ',
227         &           'flag value for base name ''', fbname(fg1:fg2),
228         &           ''''
229                CALL print_error(msgbuf, mythid)
230                STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
231              ENDIF
232              nfname = ILNBLNK(fname)
233    
234    #endif
235    
236  C         Add the path to the file name  C         Add the path to the file name
237            IF (mnc_use_outdir) THEN            IF (mnc_use_outdir) THEN
238              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
# Line 249  C           file based on the byte count Line 278  C           file based on the byte count
278  C               Delete the now-full fname from the lookup tables since  C               Delete the now-full fname from the lookup tables since
279  C               we are all done writing to it.  C               we are all done writing to it.
280                  CALL MNC_FILE_CLOSE(fname, myThid)                  CALL MNC_FILE_CLOSE(fname, myThid)
                 iseq = iseq + 1  
281                  indu = 1                  indu = 1
282                  mnc_cw_fgud(indfg) = 1                  mnc_cw_fgud(indfg) = 1
283    
284    #ifdef MNC_WRITE_OLDNAMES
285                    iseq = iseq + 1
286                  mnc_cw_fgis(indfg) = iseq                  mnc_cw_fgis(indfg) = iseq
287    #else
288                    IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
289                      write(msgbuf,'(5a)')
290         &            'MNC_CW_RX_W ERROR: output file for base name ''',
291         &            fbname(fg1:fg2), ''' is about to exceed the max ',
292         &            'file size and is NOT ALLOWED an iteration value ',
293         &            'within its file name'
294                      CALL print_error(msgbuf, mythid)
295                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
296                    ELSEIF (mnc_cw_cit(3,mnc_cw_fgci(indfg)) .LT. 0) THEN
297                      write(msgbuf,'(5a)')
298         &            'MNC_CW_RX_W ERROR: output file for base name ''',
299         &            fbname(fg1:fg2), ''' is about to exceed the max ',
300         &            'file size and no next-iter has been specified--',
301         &            'please see the MNC CITER functions'
302                      CALL print_error(msgbuf, mythid)
303                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
304                    ENDIF
305                    mnc_cw_cit(2,mnc_cw_fgci(indfg))
306         &               = mnc_cw_cit(3,mnc_cw_fgci(indfg))
307                    mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1
308    #endif
309                  fs_isdone = 1                  fs_isdone = 1
310                  GOTO 10                  GOTO 10
311    
312                ENDIF                ENDIF
313              ENDIF              ENDIF
314            ENDIF            ENDIF
# Line 442  C         Write the variable one vector Line 496  C         Write the variable one vector
496        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
497          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
498       &       '--please increase to at least ',       &       '--please increase to at least ',
499       &       vcount(1), ' in ''MNC_SIZE.h'''       &       vcount(1), ' in ''MNC_BUFF.h'''
500          CALL PRINT_ERROR(msgBuf , 1)          CALL PRINT_ERROR(msgBuf , 1)
501          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'
502        ENDIF        ENDIF
# Line 550  C     !USES: Line 604  C     !USES:
604  #include "netcdf.inc"  #include "netcdf.inc"
605  #include "mnc_common.h"  #include "mnc_common.h"
606  #include "SIZE.h"  #include "SIZE.h"
607  #include "MNC_SIZE.h"  #include "MNC_BUFF.h"
608  #include "EEPARAMS.h"  #include "EEPARAMS.h"
609  #include "PARAMS.h"  #include "PARAMS.h"
610  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
# Line 563  CEOP Line 617  CEOP
617    
618  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
619        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu
620        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv        integer bis,bie, bjs,bje, uniq_tnum,uniq_fnum, nfname, fid, idv
621        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
622        integer ind_vt, npath, unlid        integer ind_vt, npath, unlid, f_or_t, ixoff,iyoff
623  C     integer f_sNx,f_sNy, alen, atype, ind_fv_ids, ierr, indf  C     integer f_sNx,f_sNy, alen, atype, ind_fv_ids, ierr, indf
624        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)
625        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
626        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
627        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_CHAR) fname
628        character*(MNC_MAX_CHAR) fname_zs        character*(MNC_MAX_CHAR) fname_zs
629          character*(MNC_MAX_CHAR) tmpnm
630        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_CHAR) path_fname
631        integer indfg, fg1,fg2        integer indfg, fg1,fg2
632        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
# Line 634  C     Set the bi,bj indicies Line 689  C     Set the bi,bj indicies
689  C         Create the file name  C         Create the file name
690            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
691            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
692    
693    #ifdef MNC_READ_OLDNAMES
694    
695            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
696            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
697            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
# Line 673  C           zero sequence number inserte Line 731  C           zero sequence number inserte
731            ENDIF            ENDIF
732            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
733    
734            write(msgbuf,'(6a)')            write(msgbuf,'(5a)')
735       &         'MNC_CW_RX_R: cannot get id for variable ''',       &         'MNC_CW_RX_R: cannot get id for variable ''',
736       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''
737            err = NF_INQ_VARID(fid, vtype, idv)            err = NF_INQ_VARID(fid, vtype, idv)
738            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
739              f_or_t = 0
740    
741    #else
742    
743    C         The sequence for PER-FACE and PER-TILE is:
744    C         (1) check whether a PER-FACE file exists
745    C         .   (a) if only one face is used for the entire domain,
746    C         .       then omit the face index from the file name
747    C         .   (b) if the PER-FACE file exists and is somehow faulty,
748    C         .       then we die with an error message
749    C         (2) if no PER-FACE file exists, then use a PER-TILE file
750    
751    C         Create the PER-FACE file name
752              n1 = IFNBLNK(fbname)
753              n2 = ILNBLNK(fbname)
754    C         Add an iteraton count to the file name if its requested
755              IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
756                WRITE(fname,'(a,a1)') fbname(n1:n2), '.'
757              ELSE
758                WRITE(fname,'(a,a1,i10.10,a1)') fbname(n1:n2), '.',
759         &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'
760              ENDIF
761              ntot = ILNBLNK(fname)
762              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
763              npath = ILNBLNK(mnc_indir_str)
764    C         Add the face index
765              CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)
766              IF ( uniq_fnum .EQ. -1 ) THEN
767    C           There is only one face
768                WRITE(path_fname,'(2a,a2)')
769         &           mnc_indir_str(1:npath), fname(1:ntot), 'nc'
770              ELSE
771                CALL MNC_PSNCM(tmpnm, uniq_fnum, MNC_DEF_FMNC)
772                k = ILNBLNK(tmpnm)
773                WRITE(path_fname,'(2a,a1,a,a3)')
774         &           mnc_indir_str(1:npath), fname(1:ntot), 'f',
775         &           tmpnm(1:k), '.nc'
776              ENDIF
777    
778    C         Try to open the PER-FACE file
779              err = NF_OPEN(path_fname, NF_NOWRITE, fid)
780              IF ( err .EQ. NF_NOERR ) THEN
781                f_or_t = 0
782              ELSE
783    
784    C           Create the PER-TILE file name
785                CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
786                k = ILNBLNK(tmpnm)
787                path_fname(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
788                WRITE(path_fname,'(2a,a1,a,a3)')
789         &           mnc_indir_str(1:npath), fname(1:ntot), 't',
790         &           tmpnm(1:k), '.nc'
791                err = NF_OPEN(path_fname, NF_NOWRITE, fid)
792                IF ( err .EQ. NF_NOERR ) THEN
793                  f_or_t = 1
794                ELSE
795                  k = ILNBLNK(path_fname)
796                  write(msgbuf,'(4a)')
797         &             'MNC_CW_RX_R: cannot open either a per-face or a ',
798         &             'per-tile file: last try was ''', path_fname(1:k),
799         &             ''''
800                  CALL print_error(msgbuf, mythid)
801                  STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
802                ENDIF
803    
804              ENDIF
805    
806              ntot = ILNBLNK(path_fname)
807              write(msgbuf,'(5a)')
808         &         'MNC_CW_RX_R: cannot get netCDF id for variable ''',
809         &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),
810         &         ''''
811              err = NF_INQ_VARID(fid, vtype, idv)
812              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
813    
814    #endif
815    
816              IF ( f_or_t .EQ. 1 ) THEN
817                write(msgbuf,'(4a)')
818         &           'MNC_CW_RX_R: per-face reads are not yet ',
819         &           'implemented -- so pester Ed to finish them'
820                CALL print_error(msgbuf, mythid)
821                STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
822    
823    C           Get the X,Y PER-FACE offsets
824                CALL MNC_CW_GET_XYFO(lbi,lbj, ixoff,iyoff, myThid)
825    
826              ENDIF
827    
828  C         Check that the current sNy,sNy values and the in-file values  C         Check that the current sNy,sNy values and the in-file values
829  C         are compatible and WARN (only warn) if not  C         are compatible and WARN (only warn) if not
# Line 755  C         the unlimited dimension offset Line 901  C         the unlimited dimension offset
901              IF (i .LE. ndim) THEN              IF (i .LE. ndim) THEN
902                s(i) = mnc_cw_is(i,igrid)                s(i) = mnc_cw_is(i,igrid)
903                e(i) = mnc_cw_ie(i,igrid)                e(i) = mnc_cw_ie(i,igrid)
904    
905                  IF ( f_or_t .EQ. 1 ) THEN
906    C               Add the per-face X,Y offsets to the udo offset vector
907    C               since they accomplish the same thing
908                    IF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'X' ) THEN
909                      udo(i) = ixoff - 1
910                    ELSEIF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'Y' ) THEN
911                      udo(i) = iyoff - 1
912                    ENDIF
913                  ENDIF
914    
915              ENDIF              ENDIF
916  C           Check for the unlimited dimension  C           Check for the unlimited dimension
917              IF ((i .EQ. ndim)              IF ((i .EQ. ndim)
# Line 828  C         Read the variable one vector a Line 985  C         Read the variable one vector a
985        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
986          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
987       &       '--please increase to at least ',       &       '--please increase to at least ',
988       &       vcount(1), ' in ''MNC_SIZE.h'''       &       vcount(1), ' in ''MNC_BUFF.h'''
989          CALL PRINT_ERROR(msgBuf , 1)          CALL PRINT_ERROR(msgBuf , 1)
990          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'
991        ENDIF        ENDIF
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32
  ViewVC Help
Powered by ViewVC 1.1.22