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
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015 integer stdin, stdout, stderr
0016 parameter (stdin = 5, stdout = 6, stderr = 6)
0017
0018 parameter (maxcoord=3000, maxdepth=100)
0019 character iotext*80, expnam*60, stamp*32
0020
0021
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
0030
0031 parameter(spval=-999.)
0032
0033
0034
0035 integer narg
0036 logical preflag
0037
0038
0039
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
0047
0048
0049 integer dims(4), corner(4), edges(4)
0050
0051 character*1 inumber(4)
0052
0053
0054
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
0062
0063
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
0070
0071
0072 real delZ(maxdepth)
0073
0074
0075
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
0088
0089
0090
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
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
0111
0112
0113
0114
0115
0116
0117 preflag = .false.
0118 narg=iargc()
0119 if ( narg .gt. 0 ) preflag = .true.
0120
0121
0122
0123
0124 IL=ILNBLNK( fName )
0125
0126
0127
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
0149
0150 imax=(6+4*Nr)
0151 ilen=imax*8
0152
0153 allocate (tmp(imax))
0154
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
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
0174
0175
0176
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
0194
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
0210
0211
0212
0213
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
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
0230 do k=1,Nr
0231 Dep_t(k)=(Dep_w(k)+Dep_w(k+1))*0.5
0232 enddo
0233
0234
0235
0236 time(1)=rcountstart
0237 do m=2,icount
0238 time(m) = time(m-1)+rcountdelta
0239 enddo
0240 print*, 'time: ',time
0241
0242 do ip=1,npart
0243 pnum(ip) = FLOAT(ip)
0244 enddo
0245
0246
0247
0248
0249
0250
0251
0252 itotalrecord = 0
0253
0254 do iG=1,iGmax
0255 do jG=1,jGmax
0256
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
0262 read(1,rec=1) tmp
0263 imaxrecord = INT(tmp(1))
0264 print*,'read ',dataFname,imaxrecord
0265 itotalrecord = itotalrecord + imaxrecord
0266
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
0301
0302
0303
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
0316
0317
0318
0319
0320 write(stdout,*) ' Start Converting'
0321
0322
0323
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
0331
0332
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
0340
0341
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
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
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
0370
0371
0372
0373
0374 charval(1) = ' '
0375
0376 name = 'Particles Number '
0377
0378 call ncaptc(ncid, partid, 'long_name', NCCHAR, 24, name, iret)
0379 call ncaptc(ncid, partid, 'units', NCCHAR, 16, unit, iret)
0380
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
0388
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
0395 if (iedge)
0396 & call ncaptc(ncid, Dep_tid, 'edges',NCCHAR, 7,'Depth_w',iret)
0397
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
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
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
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
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
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
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
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
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
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
0477 if (iret .ne. 0) write(stdout,*) 'Error: define variable attrib.'
0478
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
0484
0485
0486
0487
0488 call ncendf(ncid, iret)
0489
0490
0491
0492
0493
0494
0495
0496 corner(1) = 1
0497 edges(1) = npart
0498 call ncvpt(ncid, partid, corner, edges, pnum, iret)
0499
0500
0501 corner(1) = 1
0502 edges(1) = icount
0503 call ncvpt(ncid, Timeid, corner, edges, Time, iret)
0504
0505
0506 corner(1) = 1
0507 edges(1) = Nr
0508 call ncvpt(ncid, Dep_tid, corner, edges, Dep_t, iret)
0509
0510 corner(1) = 1
0511 edges(1) = Nr+1
0512 call ncvpt(ncid, Dep_wid, corner, edges, Dep_w, iret)
0513
0514 corner(1) = 1
0515 edges(1) = Nr
0516 call ncvpt(ncid, Dep_wm1id, corner, edges, Dep_wm1, iret)
0517
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
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
0542 do iG=1,iGmax
0543 do jG=1,jGmax
0544
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
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
0572 do iG=1,iGmax
0573 do jG=1,jGmax
0574
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
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
0602 do iG=1,iGmax
0603 do jG=1,jGmax
0604
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
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
0642 if (iret .ne. 0) write(stdout,*) 'Error: write variables'
0643 call ncclos (ncid, iret)
0644
0645 write(stdout,*) ' End '
0646
0647 end
0648
0649
0650 INTEGER FUNCTION ILNBLNK( string )
0651
0652
0653
0654
0655 IMPLICIT NONE
0656 CHARACTER*(*) string
0657
0658 INTEGER L, LS
0659
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
0669 RETURN
0670 END