Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:45:28 UTC

view on githubraw file Latest commit 4fee7a55 on 2004-05-06 02:01:34 UTC
c806179eb4 Alis*0001       program cvprofiles
                0002 c
                0003 c=======================================================================
                0004 c     converts binary float profiles to netCDF
                0005 c
                0006 c     * must be compiled with a FORTRAN90 compiler and netcdf library
                0007 c       f90 cvprofiles.F /usr/local/lib/libnetcdf.a
                0008 c       f90 cvprofiles.F /net/ice/ecco/lib/libnetcdf.a (for the ECCO cluster)
                0009 c     * uses namelist data.profiles
                0010 c
                0011 c     Arne Biastoch, abiastoch@ucsd.edu, 11/16/2000
                0012 c
                0013 c=======================================================================
                0014 c
                0015       integer stdin, stdout, stderr
                0016       parameter (stdin = 5, stdout = 6, stderr = 6)
                0017 c
                0018       parameter (maxcoord=3000, maxdepth=100)
                0019       character iotext*80, expnam*60, stamp*32
                0020 c
                0021 c variables for filenames
                0022       integer narg, npart
                0023       character*6 cpart
                0024       character*1 split
                0025       integer factor(6)
                0026       data factor / 1.e5, 1.e4, 1.e3, 1.e2, 1.e1, 1.e0 /
                0027       character*(80) dataFName
                0028       logical exst
                0029 c
                0030 c     parameter(spval=-1.0e+23)
                0031       parameter(spval=-999.)
                0032 
                0033 c number of variables per record
                0034 c     parameter(imax=10)
                0035       integer narg
                0036       logical preflag
                0037 c
                0038 c netCDF ids
                0039 c
                0040       integer  iret, ncid, VARid
                0041       integer  partdim,Timedim,Dep_tdim, Dep_wdim, Dep_wm1dim
                0042       integer  partid, Timeid
                0043       integer  xpartid, ypartid, kpartid
                0044       integer  tempid, saltid, uvelid, vvelid, zetaid
                0045       integer  Dep_tid, Dep_wid, Dep_wm1id 
                0046 c
                0047 c variable shapes, corner and edge lengths
                0048 c
                0049       integer dims(4), corner(4), edges(4)
                0050 c
                0051       character*1 inumber(4)
                0052 c
                0053 c attribute vectors
                0054 c
                0055       integer  longval(1)
                0056       real  floatval(2)
                0057       character*1 charval(1)
                0058       character name*24, unit*16, grid*2
                0059       logical   usingSphericalPolarGrid
                0060       logical iedge
                0061 c 
                0062 c data variables for NetCDF
                0063 c
                0064       real, dimension(:), allocatable :: Dep_t, Dep_w, Dep_wm1
                0065       real, dimension(:),   allocatable :: pnum,time
                0066       real, dimension(:,:), allocatable :: xpart,ypart,kpart,zeta
                0067       real, dimension(:,:,:), allocatable :: uvel,vvel,temp,salt
                0068       double precision, dimension(:), allocatable ::  tmp
                0069 c
                0070 c these variables cannot be allocatable because they appear in the namelist
                0071 c
                0072       real delZ(maxdepth)
                0073 c
                0074 c namelist contains
                0075 c
                0076       data npart /10/
                0077       character*50 outname2
                0078       character*50 fName, outname
                0079       data fName / 'float_profiles' /
                0080       character*20 startDate
                0081       data startDate / '01-JAN-1992:12:00:00' /
                0082       data expnam /'Experimentname not set in data.profiles'/
                0083       data usingSphericalPolarGrid /.true./
                0084       namelist /dimensions/ expnam, startDate, usingSphericalPolarGrid
                0085       namelist /floats/ fName
                0086       namelist /coord/ Nr, delZ
                0087 c
                0088 c in most systems netcdf.inc should be side in /usr/local/include
                0089 c     include '/usr/local/include/netcdf.inc'
                0090 c     include '/users/guests2/ux451985/netcdf/include/netcdf.inc'
                0091       include '/net/ice/ecco/include/netcdf.inc'
                0092 
                0093       ioun=11
                0094       open(ioun,file='data.profiles',status='old',form='formatted')
                0095       read  (unit=ioun, end=666, nml=dimensions)
                0096       write (stdout,dimensions)
                0097       close (ioun)
                0098  666  continue
                0099       open(ioun,file='data.profiles',status='old',form='formatted')
                0100       read  (unit=ioun, end=777, nml=coord)
                0101 c     write (stdout,coord)
                0102       close (ioun)
                0103  777  continue
                0104       open(ioun,file='data.profiles',status='old',form='formatted')
                0105       read  (unit=ioun, end=999, nml=floats)
                0106       write (stdout,floats)
                0107       close (ioun)
                0108  999  continue
                0109 
                0110 c
                0111 c     big data set:
                0112 c     if the data set contains a big number of particles and timesteps
                0113 c     it has to be read in chunks. This takes longer but fits better
                0114 c     into the memory. The argument preflag is used to indicate a big 
                0115 c     data set.
                0116 c
                0117       preflag = .false.
                0118       narg=iargc()
                0119       if ( narg .gt. 0 ) preflag = .true.
                0120 
                0121 c
                0122 c strip names
                0123 c
                0124       IL=ILNBLNK( fName )
                0125 
                0126 c check existent files
                0127 c
                0128       iGmax=1
                0129       do m=1,100
                0130          write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0131      &             fName(1:IL),'.',iGmax,'.',1,'.data'
                0132          inquire( file=dataFname, exist=exst )
                0133          if (exst)  iGmax = iGmax + 1
                0134       enddo
                0135 
                0136       jGmax=1
                0137       do m=1,100
                0138          write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0139      &             fName(1:IL),'.',1,'.',jGmax,'.data'
                0140          inquire( file=dataFname, exist=exst )
                0141          if (exst)  jGmax = jGmax + 1
                0142       enddo
                0143 
                0144       iGmax = iGmax - 1
                0145       jGmax = jGmax - 1
                0146       print*, 'There are ',iGmax,' x ',jGmax,' files'
                0147 
                0148 c open first file and get dimensions (float number and time)
                0149 c     
                0150       imax=(6+4*Nr)
                0151       ilen=imax*8
                0152 
                0153       allocate (tmp(imax))
                0154 c
                0155       write(dataFname(1:80),'(2a,a)')
                0156      &          fName(1:IL),'.001.001.data'
                0157        open(1,file=dataFname,status='old',form='unformatted'
                0158      &      ,access='direct',recl=ilen)
                0159 c
                0160        read(1,rec=1) tmp
                0161        rcountstart = SNGL(tmp(2))
                0162        rcountdelta = SNGL(tmp(4))
                0163        icount      = INT(tmp(5))
                0164        npart       = INT(tmp(6))
                0165        close(1)
                0166       print*, 'npart    = ',npart
                0167       print*, 'timesteps= ',icount
                0168       if (preflag) then
                0169          print*, 'big data set --> read in chunks'
                0170       endif
                0171 
                0172 
                0173 c-----------------------------------------------------------------------
                0174 c     allocate variables
                0175 c-----------------------------------------------------------------------
                0176 c
                0177       allocate (pnum(npart))
                0178       allocate (time(icount))
                0179       allocate (Dep_t(Nr))
                0180       allocate (Dep_w(Nr+1))
                0181       allocate (Dep_wm1(Nr))
                0182       allocate (xpart(npart,icount))
                0183       allocate (ypart(npart,icount))
                0184       allocate (kpart(npart,icount))
                0185       allocate (temp(npart,Nr,icount))
                0186       if (.not. preflag) then
                0187          allocate (uvel(npart,Nr,icount))
                0188          allocate (vvel(npart,Nr,icount))
                0189          allocate (salt(npart,Nr,icount))
                0190       endif
                0191       allocate (zeta(npart,icount))
                0192 
                0193 c initialize arrays
                0194 c
                0195       do m=1,npart
                0196          do n=1,icount
                0197             xpart(m,n) = spval
                0198             ypart(m,n) = spval
                0199             kpart(m,n) = spval
                0200             do k=1,Nr
                0201              if (.not. preflag) uvel(m,k,n) = spval
                0202              if (.not. preflag) vvel(m,k,n) = spval
                0203              temp(m,k,n) = spval
                0204              if (.not. preflag) salt(m,k,n) = spval
                0205             enddo
                0206             zeta(m,n) = spval
                0207          enddo
                0208       enddo
                0209 c
                0210 c
                0211 c test if depth axis is evenly spaced (in that case no edges have to
                0212 c be set)
                0213 c
                0214       iedge=.false.
                0215       do k=2,Nr
                0216          if (delZ(k) .ne. delZ(k-1)) then
                0217             iedge=.true.
                0218             goto 20
                0219          endif
                0220       enddo
                0221  20   continue
                0222 c
                0223       Dep_w(1)=0.
                0224       Dep_wm1(1)=0.
                0225       do k=2,Nr+1
                0226          Dep_w(k)=Dep_w(k-1)+delZ(k-1)
                0227          if (k .ne. Nr+1) Dep_wm1(k) = Dep_w(k)
                0228       enddo
                0229 c
                0230       do k=1,Nr
                0231          Dep_t(k)=(Dep_w(k)+Dep_w(k+1))*0.5
                0232       enddo
                0233 c
                0234 c generate axes
                0235 c
                0236       time(1)=rcountstart
                0237       do m=2,icount
                0238          time(m) = time(m-1)+rcountdelta
                0239       enddo
                0240       print*, 'time: ',time
                0241 c
                0242       do ip=1,npart
                0243          pnum(ip) = FLOAT(ip)
                0244       enddo
                0245 c      print*, 'pnum: ',pnum
                0246 c
                0247 c
                0248 c-----------------------------------------------------------------------
                0249 c     open files and read input
                0250 c-----------------------------------------------------------------------
                0251 c
                0252       itotalrecord = 0
                0253 
                0254       do iG=1,iGmax
                0255          do jG=1,jGmax
                0256 c
                0257             write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0258      &                fName(1:IL),'.',iG,'.',jG,'.data'
                0259             open(1,file=dataFname,status='old',form='unformatted'
                0260      &           ,access='direct',recl=ilen)
                0261 c
                0262             read(1,rec=1) tmp
                0263             imaxrecord = INT(tmp(1))
                0264             print*,'read ',dataFname,imaxrecord
                0265             itotalrecord = itotalrecord + imaxrecord
                0266 c                goto 200
                0267 
                0268             do irec=2,imaxrecord+1
                0269 
                0270                read(1,rec=irec) tmp
                0271                ip = INT(tmp(1))
                0272                if (ip .gt. npart) then
                0273                   print*,'ip out of order: ',ip,npart
                0274                   stop
                0275                endif
                0276                np = INT((tmp(2)-rcountstart)/rcountdelta+1)
                0277 
                0278 
                0279                if (usingSphericalPolarGrid) then
                0280                xpart(ip,np)  = SNGL(tmp(3))
                0281                ypart(ip,np)  = SNGL(tmp(4))
                0282                else
                0283                xpart(ip,np)  = SNGL(tmp(3))/1000.
                0284                ypart(ip,np)  = SNGL(tmp(4))/1000.
                0285                endif
                0286                kpart(ip,np)  = SNGL(tmp(5))
                0287                zeta(ip,np)   = SNGL(tmp(6))
                0288                do k=1,Nr
                0289                 if (.not. preflag) uvel(ip,k,np)   = SNGL(tmp(6+k))
                0290                 if (.not. preflag) vvel(ip,k,np)   = SNGL(tmp(6+1*Nr+k))
                0291                                    temp(ip,k,np)   = SNGL(tmp(6+2*Nr+k))
                0292                 if (.not. preflag) salt(ip,k,np)   = SNGL(tmp(6+3*Nr+k))
                0293                   if (temp(ip,k,np) .eq. 0.) then
                0294                     if (.not. preflag)  uvel(ip,k,np)   = spval
                0295                     if (.not. preflag)  vvel(ip,k,np)   = spval
                0296                                         temp(ip,k,np)   = spval
                0297                     if (.not. preflag)  salt(ip,k,np)   = spval
                0298                   endif
                0299                enddo
                0300 c            print*, 'rec= ',irec,' npart= ',ip,' timestep= ',np
                0301 c     &      ,time(np),tmp
                0302 c     &     ,xpart(ip,np),ypart(ip,np),kpart(ip,np),uvel(ip,np,1),
                0303 c     &      vvel(ip,np,1),temp(ip,np,1),salt(ip,np,1),zeta(ip,np)
                0304  100           continue
                0305             enddo
                0306 
                0307             close(1)
                0308  200            continue
                0309          enddo
                0310       enddo
                0311 
                0312       print*,icount,' x ',npart,' = ',icount*npart,' records expected,',
                0313      & ' found ',itotalrecord,' float records'
                0314       print*,'==> ',icount*npart-itotalrecord,' float records missing'
                0315 c
                0316 c-----------------------------------------------------------------------
                0317 c     define netCDF variables
                0318 c-----------------------------------------------------------------------
                0319 c
                0320       write(stdout,*) ' Start Converting'
                0321 c
                0322 c enter define mode: NCCLOB=overwrite, NCNOCLOB=do not overwrite
                0323 c
                0324       IL=ILNBLNK( fname )
                0325       outname2=fname(1:IL)//'.cdf'
                0326       write (stdout,*)
                0327      &       ' ==>  Writing a profiles to file ',outname2(1:IL+4)
                0328       ncid = nccre(outname2(1:IL+4), NCCLOB, iret)
                0329       if (iret .ne. 0) write(stdout,*) 'Error: Open NetCDF file'
                0330 c 
                0331 c define dimensions
                0332 c
                0333       partdim = ncddef(ncid, 'Particles', npart, iret)
                0334       Dep_tdim  = ncddef(ncid, 'Depth_t',     Nr, iret)
                0335       Dep_wm1dim= ncddef(ncid, 'Depth_wm1',   Nr, iret)
                0336       Dep_wdim  = ncddef(ncid, 'Depth_w',   Nr+1, iret)
                0337       Timedim = ncddef(ncid, 'Time', NCUNLIM, iret)
                0338       if (iret .ne. 0) write(stdout,*) 'Error: define dimensions'
                0339 c
                0340 c define variables
                0341 c
                0342       dims(1)  = partdim
                0343       partid  = ncvdef (ncid,'Particles',NCFLOAT,1,dims,iret)
                0344       dims(1)  = Dep_tdim
                0345       Dep_tid  = ncvdef (ncid,'Depth_t',    NCFLOAT,1,dims,iret)
                0346       dims(1)  = Dep_wdim
                0347       Dep_wid  = ncvdef (ncid,'Depth_w',    NCFLOAT,1,dims,iret)
                0348       dims(1)  = Dep_wm1dim
                0349       Dep_wm1id= ncvdef (ncid,'Depth_wm1',  NCFLOAT,1,dims,iret)
                0350       dims(1)  = Timedim
                0351       Timeid   = ncvdef (ncid,'Time',   NCFLOAT,1,dims,iret)
                0352       if (iret .ne. 0) write(stdout,*) 'Error: define axis ids'
                0353 c
                0354       dims(1) = partdim
                0355       dims(2) = Timedim
                0356       xpartid = ncvdef (ncid,'xpart', NCFLOAT,2,dims,iret)
                0357       ypartid = ncvdef (ncid,'ypart', NCFLOAT,2,dims,iret)
                0358       kpartid = ncvdef (ncid,'kpart', NCFLOAT,2,dims,iret)
                0359       zetaid  = ncvdef (ncid,'zeta',  NCFLOAT,2,dims,iret)
                0360 c
                0361       dims(1) = partdim
                0362       dims(2) = Dep_tdim
                0363       dims(3) = Timedim
                0364       uvelid  = ncvdef (ncid,'uvel',  NCFLOAT,3,dims,iret)
                0365       vvelid  = ncvdef (ncid,'vvel',  NCFLOAT,3,dims,iret)
                0366       tempid  = ncvdef (ncid,'temp',  NCFLOAT,3,dims,iret)
                0367       saltid  = ncvdef (ncid,'salt',  NCFLOAT,3,dims,iret)
                0368       if (iret .ne. 0) write(stdout,*) 'Error: define variable ids'
                0369 c
                0370 c-----------------------------------------------------------------------
                0371 c     assign attributes
                0372 c-----------------------------------------------------------------------
                0373 c
                0374       charval(1) = ' '
                0375 c      
                0376       name = 'Particles Number    '
                0377 c      unit = 'particle number  '
                0378       call ncaptc(ncid, partid, 'long_name', NCCHAR, 24, name, iret) 
                0379       call ncaptc(ncid, partid, 'units',     NCCHAR, 16, unit, iret) 
                0380 c
                0381       name = 'Time'
                0382       unit = 'seconds'
                0383       call ncaptc(ncid, Timeid, 'long_name', NCCHAR, 24, name, iret) 
                0384       call ncaptc(ncid, Timeid, 'units',     NCCHAR, 16, unit, iret) 
                0385       call ncaptc(ncid, Timeid,'time_origin',NCCHAR, 20,startDate, iret)
                0386       if (iret .ne. 0) write(stdout,*) 'Error: assign axis attributes'
                0387 c
                0388 c      
                0389       name = 'Depth of T grid points  '
                0390       unit = 'meters          '
                0391       call ncaptc(ncid, Dep_tid, 'long_name', NCCHAR, 24, name, iret) 
                0392       call ncaptc(ncid, Dep_tid, 'units',     NCCHAR, 16, unit, iret) 
                0393       call ncaptc(ncid, Dep_tid, 'positive',  NCCHAR, 4, 'down',iret)     
                0394 c     call ncaptc(ncid, Dep_tid, 'point_spacing',NCCHAR,6,'uneven',iret)     
                0395       if (iedge)
                0396      & call ncaptc(ncid, Dep_tid, 'edges',NCCHAR, 7,'Depth_w',iret)     
                0397 c      
                0398       name = 'Depth at top of T box'
                0399       unit = 'meters          '
                0400       call ncaptc(ncid, Dep_wm1id, 'long_name', NCCHAR, 24, name, iret) 
                0401       call ncaptc(ncid, Dep_wm1id, 'units',     NCCHAR, 16, unit, iret) 
                0402       call ncaptc(ncid, Dep_wm1id, 'positive',  NCCHAR, 4, 'down',iret)     
                0403 c
                0404       name = 'Depth at bottom of T box'
                0405       unit = 'meters          '
                0406       call ncaptc(ncid, Dep_wid, 'long_name', NCCHAR, 24, name, iret) 
                0407       call ncaptc(ncid, Dep_wid, 'units',     NCCHAR, 16, unit, iret) 
                0408       call ncaptc(ncid, Dep_wid, 'positive',  NCCHAR, 4, 'down',iret)     
                0409       floatval(1) = spval
                0410 c
                0411       if (usingSphericalPolarGrid) then
                0412          name = 'LONGITUDE '
                0413          unit = 'degrees_W '
                0414       else
                0415          name = 'X_t '
                0416          unit = 'kilometer '
                0417       endif
                0418       call ncaptc(ncid, xpartid, 'long_name', NCCHAR, 24, name, iret) 
                0419       call ncaptc(ncid, xpartid, 'units',     NCCHAR, 16, unit, iret) 
                0420       call ncapt (ncid, xpartid,'missing_value',NCFLOAT,1,floatval,iret)
                0421       call ncapt (ncid, xpartid,'_FillValue', NCFLOAT, 1,floatval, iret)
                0422 c
                0423       if (usingSphericalPolarGrid) then
                0424          name = 'LATITUDE '
                0425          unit = 'degrees_N '
                0426       else
                0427          name = 'Y_t '
                0428          unit = 'kilometer '
                0429       endif
                0430       call ncaptc(ncid, ypartid, 'long_name', NCCHAR, 24, name, iret) 
                0431       call ncaptc(ncid, ypartid, 'units',     NCCHAR, 16, unit, iret) 
                0432       call ncapt (ncid, ypartid,'missing_value',NCFLOAT,1,floatval,iret)
                0433       call ncapt (ncid, ypartid,'_FillValue', NCFLOAT, 1,floatval, iret)
                0434 c
                0435       name = 'LEVEL '
                0436       unit = 'LEVEL '
                0437       call ncaptc(ncid, kpartid, 'long_name', NCCHAR, 24, name, iret) 
                0438       call ncaptc(ncid, kpartid, 'units',     NCCHAR, 16, unit, iret) 
                0439       call ncapt (ncid, kpartid,'missing_value',NCFLOAT,1,floatval,iret)
                0440       call ncapt (ncid, kpartid,'_FillValue', NCFLOAT, 1,floatval, iret)
                0441 c
                0442       name = 'POTENTIAL TEMPERATURE '
                0443       unit = 'deg C '
                0444       call ncaptc(ncid, tempid, 'long_name', NCCHAR, 24, name, iret) 
                0445       call ncaptc(ncid, tempid, 'units',     NCCHAR, 16, unit, iret) 
                0446       call ncapt (ncid, tempid, 'missing_value',NCFLOAT,1,floatval,iret)
                0447       call ncapt (ncid, tempid, '_FillValue', NCFLOAT, 1,floatval, iret)
                0448 c
                0449       name = 'SALINITY '
                0450       unit = 'PSU '
                0451       call ncaptc(ncid, saltid, 'long_name', NCCHAR, 24, name, iret) 
                0452       call ncaptc(ncid, saltid, 'units',     NCCHAR, 16, unit, iret) 
                0453       call ncapt (ncid, saltid, 'missing_value',NCFLOAT,1,floatval,iret)
                0454       call ncapt (ncid, saltid, '_FillValue', NCFLOAT, 1,floatval, iret)
                0455 c
                0456       name = 'U VELOCITY '
                0457       unit = 'm/sec'
                0458       call ncaptc(ncid, uvelid, 'long_name', NCCHAR, 24, name, iret) 
                0459       call ncaptc(ncid, uvelid, 'units',     NCCHAR, 16, unit, iret) 
                0460       call ncapt (ncid, uvelid, 'missing_value',NCFLOAT,1,floatval,iret)
                0461       call ncapt (ncid, uvelid, '_FillValue', NCFLOAT, 1,floatval, iret)
                0462 c
                0463       name = 'V VELOCITY '
                0464       unit = 'm/sec'
                0465       call ncaptc(ncid, vvelid, 'long_name', NCCHAR, 24, name, iret) 
                0466       call ncaptc(ncid, vvelid, 'units',     NCCHAR, 16, unit, iret) 
                0467       call ncapt (ncid, vvelid, 'missing_value',NCFLOAT,1,floatval,iret)
                0468       call ncapt (ncid, vvelid, '_FillValue', NCFLOAT, 1,floatval, iret)
                0469 c
                0470       name = 'SEA SURFACE HEIGHT '
                0471       unit = 'm '
                0472       call ncaptc(ncid, zetaid, 'long_name', NCCHAR, 24, name, iret) 
                0473       call ncaptc(ncid, zetaid, 'units',     NCCHAR, 16, unit, iret) 
                0474       call ncapt (ncid, zetaid,'missing_value',NCFLOAT, 1,floatval,iret)
                0475       call ncapt (ncid, zetaid,'_FillValue', NCFLOAT, 1, floatval, iret)
                0476 c
                0477       if (iret .ne. 0) write(stdout,*) 'Error: define variable attrib.'
                0478 c
                0479       expname= ' '
                0480       stamp = ' '
                0481       call ncaptc(ncid, NCGLOBAL, 'title',   NCCHAR, 60, expnam, iret)
                0482       call ncaptc(ncid, NCGLOBAL, 'history', NCCHAR, 32, stamp, iret)
                0483 c
                0484 c-----------------------------------------------------------------------
                0485 c     leave define mode
                0486 c-----------------------------------------------------------------------
                0487 c
                0488       call ncendf(ncid, iret)
                0489 c
                0490 c
                0491 c-----------------------------------------------------------------------
                0492 c     put variables in netCDF file
                0493 c-----------------------------------------------------------------------
                0494 c
                0495 c store Particles
                0496       corner(1) = 1
                0497       edges(1) = npart
                0498       call ncvpt(ncid, partid, corner, edges, pnum, iret)
                0499 c
                0500 c store Time      
                0501       corner(1) = 1 
                0502       edges(1) = icount
                0503       call ncvpt(ncid, Timeid, corner, edges, Time, iret)
                0504 c
                0505 c store Depth_t
                0506       corner(1) = 1
                0507       edges(1) = Nr
                0508       call ncvpt(ncid, Dep_tid, corner, edges, Dep_t, iret)
                0509 c store Depth_w
                0510       corner(1) = 1
                0511       edges(1) = Nr+1
                0512       call ncvpt(ncid, Dep_wid, corner, edges, Dep_w, iret)
                0513 c store Depth_wm1
                0514       corner(1) = 1
                0515       edges(1) = Nr
                0516       call ncvpt(ncid, Dep_wm1id, corner, edges, Dep_wm1, iret)
                0517 c store 2D values
                0518       corner(1) = 1
                0519       corner(2) = 1
                0520       edges(1) = npart
                0521       edges(2) = icount
                0522       VARid=xpartid
                0523       call ncvpt(ncid, VARid, corner, edges, xpart, iret)
                0524       VARid=ypartid
                0525       call ncvpt(ncid, VARid, corner, edges, ypart, iret)
                0526       VARid=kpartid
                0527       call ncvpt(ncid, VARid, corner, edges, kpart, iret)
                0528       VARid=zetaid
                0529       call ncvpt(ncid, VARid, corner, edges, zeta, iret)
                0530 c store values
                0531       corner(1) = 1
                0532       corner(2) = 1
                0533       corner(3) = 1
                0534       edges(1) = npart
                0535       edges(2) = Nr
                0536       edges(3) = icount
                0537       VARid=tempid
                0538       call ncvpt(ncid, VARid, corner, edges, temp, iret)
                0539 
                0540       if (preflag) then
                0541 c read in salt into temp array
                0542       do iG=1,iGmax
                0543          do jG=1,jGmax
                0544 c
                0545             write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0546      &                fName(1:IL),'.',iG,'.',jG,'.data'
                0547             open(1,file=dataFname,status='old',form='unformatted'
                0548      &           ,access='direct',recl=ilen)
                0549 c
                0550             read(1,rec=1) tmp
                0551             imaxrecord = INT(tmp(1))
                0552             print*,'read salt from ',dataFname
                0553             do irec=2,imaxrecord+1
                0554 
                0555                read(1,rec=irec) tmp
                0556                ip = INT(tmp(1))
                0557                np = INT((tmp(2)-rcountstart)/rcountdelta+1)
                0558                do k=1,Nr
                0559                   temp(ip,k,np)   = SNGL(tmp(6+3*Nr+k))
                0560                   if (SNGL(tmp(6+2*Nr+k)) .eq. 0.) then
                0561                      temp(ip,k,np)   = spval
                0562                   endif
                0563                enddo
                0564             enddo
                0565             close(1)
                0566          enddo
                0567       enddo
                0568          VARid=saltid
                0569          call ncvpt(ncid, VARid, corner, edges, temp, iret)
                0570 
                0571 c read in u into temp array
                0572       do iG=1,iGmax
                0573          do jG=1,jGmax
                0574 c
                0575             write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0576      &                fName(1:IL),'.',iG,'.',jG,'.data'
                0577             open(1,file=dataFname,status='old',form='unformatted'
                0578      &           ,access='direct',recl=ilen)
                0579 c
                0580             read(1,rec=1) tmp
                0581             imaxrecord = INT(tmp(1))
                0582             print*,'read uvel from ',dataFname
                0583             do irec=2,imaxrecord+1
                0584 
                0585                read(1,rec=irec) tmp
                0586                ip = INT(tmp(1))
                0587                np = INT((tmp(2)-rcountstart)/rcountdelta+1)
                0588                do k=1,Nr
                0589                   temp(ip,k,np)   = SNGL(tmp(6+k))
                0590                   if (SNGL(tmp(6+2*Nr+k)) .eq. 0.) then
                0591                      temp(ip,k,np)   = spval
                0592                   endif
                0593                enddo
                0594             enddo
                0595             close(1)
                0596          enddo
                0597       enddo
                0598          VARid=uvelid
                0599          call ncvpt(ncid, VARid, corner, edges, temp, iret)
                0600 
                0601 c read in v into temp array
                0602       do iG=1,iGmax
                0603          do jG=1,jGmax
                0604 c
                0605             write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
                0606      &                fName(1:IL),'.',iG,'.',jG,'.data'
                0607             open(1,file=dataFname,status='old',form='unformatted'
                0608      &           ,access='direct',recl=ilen)
                0609 c
                0610             read(1,rec=1) tmp
                0611             imaxrecord = INT(tmp(1))
                0612             print*,'read vvel from ',dataFname
                0613             do irec=2,imaxrecord+1
                0614 
                0615                read(1,rec=irec) tmp
                0616                ip = INT(tmp(1))
                0617                np = INT((tmp(2)-rcountstart)/rcountdelta+1)
                0618                do k=1,Nr
                0619                   temp(ip,k,np)   = SNGL(tmp(6+1*Nr+k))
                0620                   if (SNGL(tmp(6+2*Nr+k)) .eq. 0.) then
                0621                      temp(ip,k,np)   = spval
                0622                   endif
                0623                enddo
                0624             enddo
                0625             close(1)
                0626          enddo
                0627       enddo
                0628          VARid=vvelid
                0629          call ncvpt(ncid, VARid, corner, edges, temp, iret)
                0630 
                0631       else
                0632 
                0633          VARid=saltid
                0634          call ncvpt(ncid, VARid, corner, edges, salt, iret)
                0635          VARid=uvelid
                0636          call ncvpt(ncid, VARid, corner, edges, uvel, iret)
                0637          VARid=vvelid
                0638          call ncvpt(ncid, VARid, corner, edges, vvel, iret)
                0639 
                0640       endif
                0641 c
                0642       if (iret .ne. 0) write(stdout,*) 'Error: write variables'
                0643       call ncclos (ncid, iret)
                0644 c
                0645       write(stdout,*) ' End '
                0646  
                0647       end
                0648 
                0649 
                0650       INTEGER FUNCTION ILNBLNK( string )
                0651 C     /==========================================================\
                0652 C     | FUNCTION ILNBLNK                                         |
                0653 C     | o Find last non-blank in character string.               |
                0654 C     \==========================================================/
                0655       IMPLICIT NONE
                0656       CHARACTER*(*) string
                0657 CEndOfInterface
                0658       INTEGER L, LS
                0659 C
                0660       LS      = LEN(string)
                0661       ILNBLNK = LS
                0662       DO 10 L = LS, 1, -1
                0663         IF ( string(L:L) .EQ. ' ' ) GOTO 10
                0664          ILNBLNK = L
                0665          GOTO 11
                0666    10 CONTINUE
                0667    11 CONTINUE
                0668 C
                0669       RETURN
                0670       END