NCEPLIBS-g2 4.0.0
Loading...
Searching...
No Matches
copygb.F90
Go to the documentation of this file.
1
4
149PROGRAM copygb
150 CHARACTER*256 carg,cg1,cx1,cgb,cxb,cgm,cxm,cg2,cnl
151 INTEGER karg(100), nthreads
152 INTEGER kgdsi(200),ipopt(20),jpds1(200),jpdsb(200),iuv(100)
153 CHARACTER*400 gds
154 DATA nthreads/1/
155 DATA igi/-1/,kgdsi/19*0,255,180*0/
156 DATA ip/0/,ipopt/20*-1/
157 DATA jpds1/200*-1/,jpdsb/200*-1/,iuv/33,99*0/,nuv/1/
158 DATA lwg/0/,lapp/0/,lxx/0/,lx/1/,kz1/-1/,kz2/-2/
159 DATA jb/0/,jbk/0/,lab/1/,ab/-1.e30/,lam/0/,am/0./
160 DATA cgb/' '/,cxb/' '/,cgm/' '/,cxm/' '/,cnl/' '/
161 INTEGER ids(255),ibs(255),nbs(255)
162 NAMELIST/nlcopygb/ ids,ibs,nbs
163 DATA ids/255*-9999/,ibs/255*-9999/,nbs/255*-9999/
164
165 ! PARSE COMMAND LINE OPTIONS
166 narg=iargc()
167 iarg=1
168 lstopt=0
169 DO WHILE(iarg.LE.narg.AND.lstopt.EQ.0)
170 CALL getarg(iarg,carg)
171 larg=len_trim(carg)
172 iarg=iarg+1
173 IF(carg(1:1).NE.'-') THEN
174 lstopt=1
175 iarg=iarg-1
176 ELSEIF(larg.EQ.1) THEN
177 CALL errmsg('copygb: invalid option -')
178 CALL eusage
179 CALL errexit(1)
180 ELSE
181 l=2
182 DO WHILE(l.LE.larg)
183 IF(carg(l:l).EQ.'-') THEN
184 lstopt=1
185 ELSEIF(carg(l:l).EQ.'a') THEN
186 lapp=1
187 ELSEIF(carg(l:l).EQ.'A') THEN
188 IF(l.EQ.larg) THEN
189 l=0
190 CALL getarg(iarg,carg)
191 larg=len_trim(carg)
192 iarg=iarg+1
193 ENDIF
194 IF(carg(l+1:l+1).EQ.'>') THEN
195 lab=1
196 l=l+1
197 ELSEIF(carg(l+1:l+1).EQ.'<') THEN
198 lab=-1
199 l=l+1
200 ELSE
201 CALL errmsg('copygb: invalid threshold '// &
202 carg(l+1:larg))
203 CALL eusage
204 CALL errexit(1)
205 ENDIF
206 CALL fparser(carg(l+1:larg),1,ab)
207 l=larg
208 ELSEIF(carg(l:l).EQ.'B') THEN
209 IF(l.EQ.larg) THEN
210 l=0
211 CALL getarg(iarg,carg)
212 larg=len_trim(carg)
213 iarg=iarg+1
214 ENDIF
215 lcgb=larg-l
216 cgb=carg(l+1:larg)
217 l=larg
218 ELSEIF(carg(l:l).EQ.'b') THEN
219 IF(l.EQ.larg) THEN
220 l=0
221 CALL getarg(iarg,carg)
222 larg=len_trim(carg)
223 iarg=iarg+1
224 ENDIF
225 lcxb=larg-l
226 cxb=carg(l+1:larg)
227 l=larg
228 ELSEIF(carg(l:l).EQ.'g') THEN
229 IF(l.EQ.larg) THEN
230 l=0
231 CALL getarg(iarg,carg)
232 larg=len_trim(carg)
233 iarg=iarg+1
234 ENDIF
235 karg(1)=igi
236 karg(2:100)=kgdsi(1:99)
237 CALL fparsei(carg(l+1:larg),100,karg)
238 igi=karg(1)
239 IF(igi.GT.0.AND.igi.LT.255) THEN
240 CALL makgds(igi,kgdsi,gds,lgds,iret)
241 IF(iret.NE.0) igi=-1
242 ELSEIF(igi.EQ.255) THEN
243 kgdsi(1:99)=karg(2:100)
244 ENDIF
245 IF(igi.LT.-4.OR.igi.EQ.0.OR.igi.GT.255) THEN
246 CALL errmsg('copygb: invalid output grid '// &
247 carg(l+1:larg))
248 CALL eusage
249 CALL errexit(1)
250 ENDIF
251 mi=lengds(kgdsi)
252 IF(mi.LE.0) THEN
253 CALL errmsg('copygb: unsupported output grid '// &
254 carg(l+1:larg))
255 CALL eusage
256 CALL errexit(1)
257 ENDIF
258 l=larg
259 ELSEIF(carg(l:l).EQ.'i') THEN
260 IF(l.EQ.larg) THEN
261 l=0
262 CALL getarg(iarg,carg)
263 larg=len_trim(carg)
264 iarg=iarg+1
265 ENDIF
266 karg(1)=ip
267 karg(2:21)=ipopt
268 CALL fparsei(carg(l+1:larg),21,karg)
269 ip=karg(1)
270 ipopt=karg(2:21)
271 l=larg
272 ELSEIF(carg(l:l).EQ.'K') THEN
273 IF(l.EQ.larg) THEN
274 l=0
275 CALL getarg(iarg,carg)
276 larg=len_trim(carg)
277 iarg=iarg+1
278 ENDIF
279 jbk=1
280 CALL fparsei(carg(l+1:larg),100,jpdsb)
281 IF(jpdsb(5).EQ.0) THEN
282 CALL errmsg('copygb: invalid PDS parms '// &
283 carg(l+1:larg))
284 CALL eusage
285 CALL errexit(1)
286 ENDIF
287 l=larg
288 ELSEIF(carg(l:l).EQ.'k') THEN
289 IF(l.EQ.larg) THEN
290 l=0
291 CALL getarg(iarg,carg)
292 larg=len_trim(carg)
293 iarg=iarg+1
294 ENDIF
295 IF(carg(l+1:larg).EQ.'w') THEN
296 lwg=1
297 ELSE
298 CALL fparsei(carg(l+1:larg),100,jpds1)
299 IF(jpds1(5).EQ.0) THEN
300 CALL errmsg('copygb: invalid PDS parms '// &
301 carg(l+1:larg))
302 CALL eusage
303 CALL errexit(1)
304 ENDIF
305 ENDIF
306 l=larg
307 ELSEIF(carg(l:l).EQ.'M') THEN
308 IF(l.EQ.larg) THEN
309 l=0
310 CALL getarg(iarg,carg)
311 larg=len_trim(carg)
312 iarg=iarg+1
313 ENDIF
314 IF(carg(l+1:l+1).EQ.'#') THEN
315 l=l+1
316 CALL fparser(carg(l+1:larg),1,am)
317 lam=1
318 ELSE
319 lcgm=larg-l
320 cgm=carg(l+1:larg)
321 lam=5
322 ENDIF
323 l=larg
324 ELSEIF(carg(l:l).EQ.'m') THEN
325 IF(l.EQ.larg) THEN
326 l=0
327 CALL getarg(iarg,carg)
328 larg=len_trim(carg)
329 iarg=iarg+1
330 ENDIF
331 lcxm=larg-l
332 cxm=carg(l+1:larg)
333 l=larg
334 ELSEIF(carg(l:l).EQ.'N') THEN
335 IF(l.EQ.larg) THEN
336 l=0
337 CALL getarg(iarg,carg)
338 larg=len_trim(carg)
339 iarg=iarg+1
340 ENDIF
341 lcnl=larg-l
342 cnl=carg(l+1:larg)
343 l=larg
344 ELSEIF(carg(l:l).EQ.'v') THEN
345 IF(l.EQ.larg) THEN
346 l=0
347 CALL getarg(iarg,carg)
348 larg=len_trim(carg)
349 iarg=iarg+1
350 ENDIF
351 CALL fparsei(carg(l+1:larg),100,iuv)
352 nuv=1
353 DO juv=2,100
354 IF(iuv(juv).NE.0) nuv=juv
355 ENDDO
356 l=larg
357 ELSEIF(carg(l:l).EQ.'x') THEN
358 lx=0
359 ELSEIF(carg(l:l).EQ.'X') THEN
360 lxx=1
361 ELSE
362 CALL errmsg('copygb: invalid option '//carg(l:l))
363 CALL eusage
364 CALL errexit(1)
365 ENDIF
366 l=l+1
367 ENDDO
368 ENDIF
369 ENDDO
370 !
371 ! DEFAULT OMP_NUM_THREADS COUNT TO SINGLE THREAD.
372 !
373#ifdef _OPENMP
374 CALL omp_set_num_threads (nthreads)
375#endif
376
377 ! PARSE COMMAND LINE POSITIONAL ARGUMENTS
378 nxarg=lx+2
379 IF(narg-iarg+1.NE.nxarg) THEN
380 CALL errmsg('copygb: incorrect number of arguments')
381 CALL eusage
382 CALL errexit(nxarg)
383 ENDIF
384 CALL getarg(iarg,cg1)
385 lcg1=len_trim(cg1)
386 iarg=iarg+1
387 lg1=11
388 CALL baopenr(lg1,cg1(1:lcg1),iretba)
389 IF(iretba.NE.0) THEN
390 CALL errmsg('copygb: error accessing file '//cg1(1:lcg1))
391 CALL errexit(8)
392 ENDIF
393 IF(lx.GT.0) THEN
394 CALL getarg(iarg,cx1)
395 lcx1=len_trim(cx1)
396 iarg=iarg+1
397 lx1=31
398 CALL baopenr(lx1,cx1(1:lcx1),iretba)
399 IF(iretba.NE.0) THEN
400 CALL errmsg('copygb: error accessing file '//cx1(1:lcx1))
401 CALL errexit(8)
402 ENDIF
403 ELSE
404 lx1=0
405 ENDIF
406 CALL getarg(iarg,cg2)
407 lcg2=len_trim(cg2)
408 iarg=iarg+1
409 IF(cg2(1:lcg2).EQ.'-') THEN
410 IF(lxx.GT.0) THEN
411 CALL errmsg('copygb: piping incompatible with the X option')
412 CALL errexit(1)
413 ENDIF
414 lg2=6
415 ELSE
416 lg2=51
417 IF(lapp.EQ.0) THEN
418 CALL baopenwt(lg2,cg2(1:lcg2),iretba)
419 ELSE
420 CALL baopenwa(lg2,cg2(1:lcg2),iretba)
421 ENDIF
422 IF(iretba.NE.0) THEN
423 CALL errmsg('copygb: error accessing file '//cg2(1:lcg2))
424 CALL errexit(8)
425 ENDIF
426 ENDIF
427
428 ! OPEN MAP FILE
429 IF(cgb.NE.' ') THEN
430 IF(cgb(1:2).EQ.'-1') THEN
431 IF(jpdsb(5).EQ.-1) THEN
432 jb=1
433 ELSE
434 jb=4
435 lgb=lg1
436 lxb=lx1
437 ENDIF
438 ELSE
439 jb=4
440 lgb=14
441 CALL baopenr(lgb,cgb(1:lcgb),iretba)
442 IF(iretba.NE.0) THEN
443 CALL errmsg('copygb: error accessing file '//cgb(1:lcgb))
444 CALL errexit(8)
445 ENDIF
446 IF(cxb(1:1).NE.' ') THEN
447 lxb=34
448 CALL baopenr(lxb,cxb(1:lcxb),iretba)
449 IF(iretba.NE.0) THEN
450 CALL errmsg('copygb: error accessing file '//cxb(1:lcxb))
451 CALL errexit(8)
452 ENDIF
453 ELSE
454 lxb=0
455 ENDIF
456 ENDIF
457 ENDIF
458
459 ! OPEN MERGE FILE
460 IF(cgm.NE.' ') THEN
461 lam=5
462 lgm=15
463 CALL baopenr(lgm,cgm(1:lcgm),iretba)
464 IF(iretba.NE.0) THEN
465 CALL errmsg('copygb: error accessing file '//cgm(1:lcgm))
466 CALL errexit(8)
467 ENDIF
468 IF(cxm(1:1).NE.' ') THEN
469 lxm=35
470 CALL baopenr(lxm,cxm(1:lcxm),iretba)
471 IF(iretba.NE.0) THEN
472 CALL errmsg('copygb: error accessing file '//cxm(1:lcxm))
473 CALL errexit(8)
474 ENDIF
475 ELSE
476 lxm=0
477 ENDIF
478 ENDIF
479
480 ! OPEN AND READ NAMELIST FILE
481 IF(cnl.NE.' ') THEN
482 lnl=2
483 OPEN(lnl,file=cnl(1:lcnl),status='OLD',iostat=iret)
484 IF(iret.NE.0) THEN
485 CALL errmsg('copygb: error accessing file '//cnl(1:lcnl))
486 CALL errexit(8)
487 ENDIF
488 READ(lnl,nlcopygb,iostat=iret)
489 IF(iret.NE.0) THEN
490 CALL errmsg('copygb: error reading namelist from file '// &
491 cnl(1:lcnl))
492 CALL errexit(8)
493 ENDIF
494 ENDIF
495
496 ! GO
497 IF(lxx.GT.0) THEN
498 CALL w3tagb('COPYGB ',1998,0295,0047,'NP23 ')
499 ENDIF
500 CALL cpgb(lg1,lx1,lgb,lxb,lgm,lxm,lg2, &
501 igi,kgdsi,ip,ipopt,jpds1,nuv,iuv, &
502 jpdsb,jb,jbk,lab,ab,lam,am,lxx,lwg, &
503 ids,ibs,nbs)
504 IF(lxx.GT.0) THEN
505 CALL w3tage('COPYGB ')
506 ENDIF
507
508END PROGRAM copygb
509
513SUBROUTINE eusage
514 CALL errmsg('Usage: copygb'// &
515 ' [-g "grid [kgds]"] [-i "ip [ipopts]"]'// &
516 ' [-k "kpds"] [-v "uparms"]')
517 CALL errmsg(' '// &
518 ' [-B mapgrib [-b mapindex] [-A "<> mapthreshold"]'// &
519 ' [-K "mapkpds"]]')
520 CALL errmsg(' '// &
521 ' [-M "mask"/mergegrib [-m mergeindex]] [-X] [-a]'// &
522 ' [-N namelist]')
523 CALL errmsg(' then either:')
524 CALL errmsg(' '// &
525 ' grib1 index1 grib2')
526 CALL errmsg(' or:')
527 CALL errmsg(' '// &
528 ' -x grib1 grib2')
529
530END SUBROUTINE eusage
531
562SUBROUTINE cpgb(LG1,LX1,LGB,LXB,LGM,LXM,LG2, &
563 IGI,KGDSI,IP,IPOPT,JPDS1,NUV,IUV, &
564 JPDSB,JB,JBK,LAB,AB,LAM,AM,LXX,LWG, &
565 IDS,IBS,NBS)
566 parameter(mbuf=256*1024)
567 CHARACTER CBUF1(MBUF),CBUFB(MBUF),CBUFM(MBUF)
568 INTEGER JPDS1(100),JPDSB(100),IUV(100)
569 INTEGER KGDSI(200)
570 INTEGER IPOPT(20)
571 INTEGER IDS(255),IBS(255),NBS(255)
572 INTEGER JPDS(200),JGDS(200),JENS(5)
573 INTEGER KPDS1(200),KGDS1(200),KENS1(5)
574 INTEGER KPDSB(200),KGDSB(200),KENSB(5)
575 INTEGER KPDSM(200),KGDSM(200),KENSM(5)
576 CHARACTER*80 CIN
577
578 ! READ GRIB HEADERS
579 IF(lxx.GT.0) CALL instrument(6,kall0,ttot0,tmin0,tmax0)
580 IF(jb.EQ.4) THEN
581 jgds=-1
582 jens=-1
583 krb=-1
584 kpdsb=0
585 kgdsb=0
586 CALL getgbemh(lgb,lxb,krb,jpdsb,jgds,jens, &
587 mbuf,cbufb,nlenb,nnumb,mnumb, &
588 kb,mb,krbx,kpdsb,kgdsb,kensb,iret)
589 IF(iret.EQ.0.AND.mb.LE.0) iret=255
590 IF(lxx.GT.0) THEN
591 IF(iret.EQ.99) THEN
592 print *,'copygb map field not found'
593 ELSEIF(iret.NE.0) THEN
594 print *,'copygb map field retrieval error code ',iret
595 ENDIF
596 ENDIF
597 ELSE
598 mb=1
599 iret=0
600 ENDIF
601 IF(iret.EQ.0) THEN
602 kr1=-1
603 IF(lwg.EQ.1) THEN
604 READ (*,*,iostat=iret) cin
605 IF(iret.EQ.0) THEN
606 ndel=scan(cin,":")
607 IF(ndel.GT.0) cin=cin(:ndel-1)
608 READ(cin,*) kr1
609 kr1=-kr1
610 ENDIF
611 ENDIF
612 IF(iret.EQ.0) THEN
613 jgds=-1
614 jens=-1
615 kpds1=0
616 kgds1=0
617 CALL getgbemh(lg1,lx1,kr1,jpds1,jgds,jens, &
618 mbuf,cbuf1,nlen1,nnum1,mnum1, &
619 k1,m1,kr1x,kpds1,kgds1,kens1,iret)
620 IF(iret.EQ.0.AND.m1.LE.0) iret=255
621 kr1=kr1x
622 IF(lxx.GT.0) THEN
623 IF(iret.EQ.99) THEN
624 print *,'copygb field not found'
625 ELSEIF(iret.NE.0) THEN
626 print *,'copygb header retrieval error code ',iret
627 ENDIF
628 ENDIF
629 ENDIF
630 ENDIF
631
632 ! LOOP UNTIL DONE
633 no=0
634 DO WHILE(iret.EQ.0)
635 IF(lam.EQ.5) THEN
636 jpds=-1
637 jpds(5:7)=kpds1(5:7)
638 jgds=-1
639 jens=-1
640 krm=-1
641 kpdsm=0
642 kgdsm=0
643 CALL getgbemh(lgm,lxm,krm,jpds,jgds,jens, &
644 mbuf,cbufm,nlenm,nnumm,mnumm, &
645 km,mm,krmx,kpdsm,kgdsm,kensm,iret)
646 IF(iret.EQ.0.AND.mm.LE.0) iret=255
647 IF(iret.NE.0) THEN
648 mm=0
649 kpdsm=0
650 kgdsm=0
651 iret=0
652 ENDIF
653 ENDIF
654 IF(igi.EQ.-1) THEN
655 igi=kpds1(3)
656 kgdsi=kgds1
657 mi=m1
658 ELSEIF(igi.EQ.-4.AND.jb.EQ.4) THEN
659 igi=kpdsb(3)
660 kgdsi=kgdsb
661 mi=mb
662 ELSEIF(igi.EQ.-5.AND.lam.EQ.5) THEN
663 igi=kpdsm(3)
664 kgdsi=kgdsm
665 mi=mm
666 ELSE
667 mi=lengds(kgdsi)
668 ENDIF
669 IF(lxx.GT.0) CALL instrument(1,kall1,ttot1,tmin1,tmax1)
670 IF(igi.GT.0.AND.igi.LE.255) THEN
671 mf=max(m1,mb,mm)
672 CALL cpgb1(lg1,lx1,m1,cbuf1,nlen1,nnum1,mnum1, &
673 mbuf,mf,mi, &
674 igi,kgdsi,ip,ipopt,jpds1,nuv,iuv, &
675 jpdsb,jb,jbk,lab,ab,lam,am, &
676 ids,ibs,nbs, &
677 lgb,lxb,mb,cbufb,nlenb,nnumb,mnumb, &
678 lgm,lxm,mm,cbufm,nlenm,nnumm,mnumm, &
679 lg2,lxx,kr1-1,no,iret1)
680 ENDIF
681 IF(lwg.EQ.1) THEN
682 READ (*,*,iostat=iret) cin
683 IF(iret.EQ.0) THEN
684 ndel=scan(cin,":")
685 IF(ndel.GT.0) cin=cin(:ndel-1)
686 READ(cin,*) kr1
687 kr1=kr1-1
688 ENDIF
689 ENDIF
690 IF(iret.EQ.0) THEN
691 jgds=-1
692 jens=-1
693 kpds1=0
694 kgds1=0
695 CALL getgbemh(lg1,lx1,kr1,jpds1,jgds,jens, &
696 mbuf,cbuf1,nlen1,nnum1,mnum1, &
697 k1,m1,kr1x,kpds1,kgds1,kens1,iret)
698 IF(iret.EQ.0.AND.m1.LE.0) iret=255
699 kr1=kr1x
700 IF(lxx.GT.0) THEN
701 IF(iret.NE.0.AND.iret.NE.99) THEN
702 print *,'copygb header retrieval error code ',iret
703 ENDIF
704 ENDIF
705 ENDIF
706 ENDDO
707
708 IF(lxx.GT.0) THEN
709 print *,'copygb wrote ',no,' total records'
710 CALL instrument(1,kall1,ttot1,tmin1,tmax1)
711 print *,'Instrumentation Report'
712 print '(F10.3," seconds spent searching headers")',ttot1
713 CALL instrument(-2,kall2,ttot2,tmin2,tmax2)
714 print '(F10.3," seconds spent reading and unpacking")',ttot2
715 CALL instrument(-3,kall3,ttot3,tmin3,tmax3)
716 print '(F10.3," seconds spent manipulating masks")',ttot3
717 CALL instrument(-4,kall4,ttot4,tmin4,tmax4)
718 print '(F10.3," seconds spent interpolating or copying")',ttot4
719 CALL instrument(-5,kall5,ttot5,tmin5,tmax5)
720 print '(F10.3," seconds spent merging")',ttot5
721 CALL instrument(-6,kall6,ttot6,tmin6,tmax6)
722 print '(F10.3," seconds spent packing and writing")',ttot6
723 ttott=ttot1+ttot2+ttot3+ttot4+ttot5+ttot6
724 print '(F10.3," total seconds spent in copygb")',ttott
725 ENDIF
726
727END SUBROUTINE cpgb
728
779SUBROUTINE cpgb1(LG1,LX1,M1,CBUF1,NLEN1,NNUM1,MNUM1, &
780 MBUF,MF,MI, &
781 IGI,KGDSI,IP,IPOPT,JPDS1,NUV,IUV, &
782 JPDSB,JB,JBK,LAB,AB,LAM,AM, &
783 IDS,IBS,NBS, &
784 LGB,LXB,MB,CBUFB,NLENB,NNUMB,MNUMB, &
785 LGM,LXM,MM,CBUFM,NLENM,NNUMM,MNUMM, &
786 LG2,LXX,KS1,NO,IRET)
787 CHARACTER CBUF1(MBUF),CBUFB(MBUF),CBUFM(MBUF)
788 INTEGER JPDS1(100),JPDSB(100),IUV(100)
789 INTEGER KGDSI(200)
790 INTEGER IPOPT(20)
791 INTEGER IDS(255),IBS(255),NBS(255)
792 INTEGER JPDS(200),JGDS(200),JENS(5)
793 INTEGER KPDS1(200),KGDS1(200),KENS1(5)
794 INTEGER KPDSB(200),KGDSB(200),KENSB(5)
795 INTEGER KPDSM(200),KGDSM(200),KENSM(5)
796 LOGICAL*1 LR(MF),L1I(MI),LBI(MI)
797 REAL FR(MF),F1I(MI),FBI(MI)
798 REAL GR(MF),G1I(MI),GBI(MI)
799
800 ! GET FIELD FROM FILE 1
801 jgds=-1
802 kpds1=0
803 kgds1=0
804 CALL getgbem(lg1,lx1,m1,ks1,jpds1,jgds,jens, &
805 mbuf,cbuf1,nlen1,nnum1,mnum1, &
806 k1,kr1,kpds1,kgds1,kens1,lr,fr,iret)
807 IF(iret.EQ.0) THEN
808 ib1=mod(kpds1(4)/64,2)
809 ids2=kpds1(22)
810 iv=0
811 krv=0
812 juv=1
813 DO WHILE(juv.LE.nuv.AND.kpds1(5).NE.iuv(juv).AND. &
814 kpds1(5).NE.iuv(juv)+1)
815 juv=juv+1
816 ENDDO
817 IF(juv.LE.nuv.AND.kpds1(5).EQ.iuv(juv)) THEN
818 iv=1
819 jpds=-1
820 jpds(1:24)=kpds1(1:24)
821 jpds(22)=-1
822 jpds(5)=kpds1(5)+1
823 jgds=kgds1
824 jens=kens1
825 CALL getgbem(lg1,lx1,m1,krv,jpds,jgds,jens, &
826 mbuf,cbuf1,nlen1,nnum1,mnum1, &
827 k1,krvx,kpds1,kgds1,kens1,lr,gr,iret)
828 krv=krvx
829 kpds1(5)=jpds(5)-1
830 kpds1(22)=max(ids2,kpds1(22))
831 ELSEIF(juv.LE.nuv.AND.kpds1(5).EQ.iuv(juv)+1) THEN
832 iret=-1
833 ENDIF
834 ENDIF
835 IF(lxx.GT.0) THEN
836 IF(iret.EQ.-1) THEN
837 print *,'copygb skipping 2nd vector component field'
838 ELSEIF(iret.NE.0) THEN
839 print *,'copygb data retrieval error code ',iret
840 ELSEIF(krv.EQ.0) THEN
841 print *,'copygb read scalar field from record ',kr1
842 print *,' ...KPDS(1:24)=',(kpds1(i),i=1,24)
843 ELSE
844 print *,'copygb read vector field from records ',kr1,krv
845 print *,' ...KPDS(1:24)=',(kpds1(i),i=1,24)
846 print *,' ...KPDS(1:24)=',(kpds1(i),i=1,4), &
847 kpds1(5)+1,(kpds1(i),i=6,24)
848 ENDIF
849 CALL instrument(2,kall2,ttot2,tmin2,tmax2)
850 ENDIF
851
852 ! INVOKE MAP MASK BEFORE INTERPOLATION
853 IF(iret.EQ.0.AND.jbk.EQ.1.AND.jb.EQ.1) THEN
854 DO i=1,k1
855 IF(lr(i)) THEN
856 IF((lab.EQ.1.AND.fr(i).LE.ab).OR. &
857 (lab.EQ.-1.AND.fr(i).GE.ab)) THEN
858 ib1=1
859 lr(i)=.false.
860 ENDIF
861 ENDIF
862 ENDDO
863 IF(lxx.GT.0) THEN
864 print *,' applied pre-interpolation map mask'
865 CALL instrument(3,kall3,ttot3,tmin3,tmax3)
866 ENDIF
867 ENDIF
868
869 ! INTERPOLATE FIELD
870 IF(iret.EQ.0) THEN
871 CALL intgrib(iv,ip,ipopt,kgds1,k1,ib1,lr,fr,gr,kgdsi,mi, &
872 ib1i,l1i,f1i,g1i,iret)
873 IF(lxx.GT.0) THEN
874 IF(iret.EQ.0) THEN
875 print *,' interpolated to grid ',igi
876 ELSEIF(iret.GT.0) THEN
877 print *,' interpolation error code ',iret
878 ENDIF
879 CALL instrument(4,kall4,ttot4,tmin4,tmax4)
880 ENDIF
881 IF(iret.EQ.-1) iret=0
882 ENDIF
883
884 ! GET MAP FIELD
885 IF(iret.EQ.0.AND.jb.EQ.4) THEN
886 krb=0
887 jgds=-1
888 jens=-1
889 CALL getgbem(lgb,lxb,mb,krb,jpdsb,jgds,jens, &
890 mbuf,cbufb,nlenb,nnumb,mnumb, &
891 kb,krbx,kpdsb,kgdsb,kensb,lr,fr,iret)
892 IF(lxx.GT.0) THEN
893 IF(iret.EQ.0) THEN
894 print *,' map field retrieved'
895 print *,' ...KPDS(1:24)=',(kpdsb(i),i=1,24)
896 ELSEIF(iret.EQ.99) THEN
897 print *,' map field not found'
898 ELSE
899 print *,' map field retrieval error code ',iret
900 ENDIF
901 ENDIF
902
903 ! INTERPOLATE MAP FIELD
904 IF(iret.EQ.0) THEN
905 ibb=mod(kpdsb(4)/64,2)
906 CALL intgrib(0,ip,ipopt,kgdsb,kb,ibb,lr,fr,gr,kgdsi,mi, &
907 ibbi,lbi,fbi,gbi,iret)
908 IF(lxx.GT.0) THEN
909 IF(iret.EQ.0) THEN
910 print *,' interpolated to grid ',igi
911 ELSEIF(iret.GT.0) THEN
912 print *,' interpolation error code ',iret
913 ENDIF
914 ENDIF
915 IF(iret.EQ.-1) iret=0
916 ENDIF
917 ENDIF
918
919 ! INVOKE MAP MASK
920 IF(iret.EQ.0) THEN
921 IF(jbk.EQ.0.AND.jb.EQ.1) THEN
922 DO i=1,mi
923 IF(l1i(i)) THEN
924 IF((lab.EQ.1.AND.f1i(i).LE.ab).OR. &
925 (lab.EQ.-1.AND.f1i(i).GE.ab)) THEN
926 ib1i=1
927 l1i(i)=.false.
928 ENDIF
929 ENDIF
930 ENDDO
931 IF(lxx.GT.0) THEN
932 print *,' applied post-interpolation map mask'
933 ENDIF
934 ELSEIF(jb.EQ.4) THEN
935 DO i=1,mi
936 IF(lbi(i)) THEN
937 IF((lab.EQ.1.AND.fbi(i).LE.ab).OR. &
938 (lab.EQ.-1.AND.fbi(i).GE.ab)) THEN
939 ib1i=1
940 l1i(i)=.false.
941 ENDIF
942 ELSE
943 ib1i=1
944 l1i(i)=.false.
945 ENDIF
946 ENDDO
947 IF(lxx.GT.0) THEN
948 print *,' applied fixed map mask'
949 ENDIF
950 ENDIF
951
952 ! MASK VALUES
953 IF(lam.EQ.1.AND.ib1i.EQ.1) THEN
954 ib1i=0
955 DO i=1,mi
956 IF(.NOT.l1i(i)) THEN
957 l1i(i)=.true.
958 f1i(i)=am
959 IF(krv.GT.0) g1i(i)=am
960 ENDIF
961 ENDDO
962 IF(lxx.GT.0) THEN
963 print *,' substituted mask fill value'
964 ENDIF
965 ENDIF
966 IF(lxx.GT.0) CALL instrument(3,kall3,ttot3,tmin3,tmax3)
967
968 ! MERGE FIELD
969 IF(lam.EQ.5.AND.ib1i.EQ.1) THEN
970 krm=0
971 jpds=-1
972 jpds(5:7)=kpds1(5:7)
973 jgds=-1
974 jens=-1
975 CALL getgbem(lgm,lxm,mm,krm,jpds,jgds,jens, &
976 mbuf,cbufm,nlenm,nnumm,mnumm, &
977 km,krmx,kpdsm,kgdsm,kensm,lr,fr,iret)
978 IF(iret.EQ.0.AND.krv.GT.0) THEN
979 jpds=-1
980 jpds(1:24)=kpdsm(1:24)
981 jpds(5)=kpdsm(5)+1
982 jgds=kgdsm
983 jens=kensm
984 CALL getgbem(lgm,lxm,mm,krm,jpds,jgds,jens, &
985 mbuf,cbufm,nlenm,nnumm,mnumm, &
986 km,krmx,kpdsm,kgdsm,kensm,lr,gr,iret)
987 kpdsm(5)=jpds(5)-1
988 ENDIF
989 IF(lxx.GT.0) THEN
990 IF(iret.EQ.0) THEN
991 print *,' merge field retrieved'
992 print *,' ...KPDS(1:24)=',(kpdsm(i),i=1,24)
993 IF(krv.GT.0) &
994 print *,' ...KPDS(1:24)=',(kpdsm(i),i=1,4), &
995 kpdsm(5)+1,(kpdsm(i),i=6,24)
996 ELSEIF(iret.EQ.99) THEN
997 print *,' merge field not found'
998 ELSE
999 print *,' merge field retrieval error code ',iret
1000 ENDIF
1001 ENDIF
1002 IF(iret.EQ.0) THEN
1003 ibm=mod(kpdsm(4)/64,2)
1004 CALL intgrib(iv,ip,ipopt,kgdsm,km,ibm,lr,fr,gr,kgdsi,mi, &
1005 ibbi,lbi,fbi,gbi,iret)
1006 IF(lxx.GT.0) THEN
1007 IF(iret.EQ.0) THEN
1008 print *,' interpolated to grid ',igi
1009 ELSEIF(iret.GT.0) THEN
1010 print *,' interpolation error code ',iret
1011 ENDIF
1012 ENDIF
1013 IF(iret.EQ.-1) iret=0
1014 ENDIF
1015 IF(iret.EQ.0) THEN
1016 DO i=1,mi
1017 IF(.NOT.l1i(i).AND.lbi(i)) THEN
1018 l1i(i)=.true.
1019 f1i(i)=fbi(i)
1020 IF(krv.GT.0) g1i(i)=gbi(i)
1021 ENDIF
1022 ENDDO
1023 IF(lxx.GT.0) THEN
1024 print *,' merged output field with merge field'
1025 ENDIF
1026 ENDIF
1027 iret=0
1028 ENDIF
1029 IF(lxx.GT.0) CALL instrument(5,kall5,ttot5,tmin5,tmax5)
1030 ENDIF
1031
1032 ! WRITE OUTPUT FIELD
1033 IF(iret.EQ.0) THEN
1034 kpds1(3)=igi
1035 kpds1(4)=128+64*ib1i
1036 k5=kpds1(5)
1037 ids1=kpds1(22)
1038 ibs1=0
1039 nbs1=0
1040 IF(k5.GT.0.AND.k5.LT.256) THEN
1041 IF(ids(k5).GE.-128.AND.ids(k5).LT.128) ids1=ids(k5)
1042 IF(ibs(k5).GE.-128.AND.ibs(k5).LT.128) ibs1=ibs(k5)
1043 IF(nbs(k5).GE.0.AND.nbs(k5).LT.256) nbs1=nbs(k5)
1044 ENDIF
1045 kpds1(22)=ids1
1046 CALL putgben(lg2,mi,kpds1,kgdsi,kens1,ibs1,nbs1,l1i,f1i,iret)
1047 IF(iret.EQ.0) no=no+1
1048 IF(iret.EQ.0.AND.krv.GT.0) THEN
1049 kpds1(5)=k5+1
1050 CALL putgben(lg2,mi,kpds1,kgdsi,kens1,ibs1,nbs1,l1i,g1i,iret)
1051 IF(iret.EQ.0) no=no+1
1052 kpds1(5)=k5
1053 ENDIF
1054 IF(lxx.GT.0) THEN
1055 IF(iret.NE.0) THEN
1056 print *,' packing error code ',iret
1057 ELSEIF(krv.EQ.0) THEN
1058 print *,' wrote scalar field to record ',no
1059 print *,' ...KPDS(1:24),IDS,IBS,NBS=', &
1060 (kpds1(i),i=1,24),ids1,ibs1,nbs1
1061 ELSE
1062 print *,' wrote vector field to records ',no-1,no
1063 print *,' ...KPDS(1:24)=',(kpds1(i),i=1,24)
1064 print *,' ...KPDS(1:24)=',(kpds1(i),i=1,4), &
1065 kpds1(5)+1,(kpds1(i),i=6,24)
1066 ENDIF
1067 CALL instrument(6,kall6,ttot6,tmin6,tmax6)
1068 ENDIF
1069 ENDIF
1070
1071END SUBROUTINE cpgb1
1072
1093SUBROUTINE intgrib(IV,IP,IPOPT,KGDS1,K1,IB1,L1,F1,G1,KGDS2,K2, &
1094 IB2,L2,F2,G2,IRET)
1095 INTEGER IPOPT(20)
1096 INTEGER KGDS1(200),KGDS2(200)
1097 LOGICAL*1 L1(K1),L2(K2)
1098 REAL F1(K1),F2(K2)
1099 REAL G1(K1),G2(K2)
1100 INTEGER KGDS1F(200),KGDS2F(200)
1101
1102 ! DETERMINE WHETHER INTERPOLATION IS NECESSARY
1103 IF(ip.EQ.4) THEN
1104 int=1
1105 ELSE
1106 int=0
1107 DO i=1,200
1108 int=max(int,abs(kgds1(i)-kgds2(i)))
1109 ENDDO
1110 int=min(int,1)
1111 ENDIF
1112
1113 ! COPY FIELD
1114 IF(int.EQ.0) THEN
1115 ib2=ib1
1116 DO i=1,k1
1117 l2(i)=l1(i)
1118 f2(i)=f1(i)
1119 IF(iv.NE.0) g2(i)=g1(i)
1120 ENDDO
1121 iret=-1
1122
1123 ! COMPUTE REGULARIZED GRIDS AND INTERPOLATE FIELD
1124 ELSE
1125 k1f=lengdsf(kgds1,kgds1f)
1126 IF(k1f.EQ.k1) k1f=1
1127 k2f=lengdsf(kgds2,kgds2f)
1128 IF(k2f.EQ.k2) k2f=1
1129 mrl=max(k2,k2f)
1130 IF(iv.EQ.0) THEN
1131 mro=1
1132 ELSE
1133 mro=mrl
1134 ENDIF
1135 IF(k1f.GT.0.AND.k2f.GT.0) THEN
1136 CALL intgrib1(k1f,kgds1f,k2f,kgds2f,mrl,mro, &
1137 iv,ip,ipopt,kgds1,k1,ib1,l1,f1,g1,kgds2,k2, &
1138 ib2,l2,f2,g2,iret)
1139 ELSE
1140 iret=101
1141 ENDIF
1142 ENDIF
1143
1144END SUBROUTINE intgrib
1145
1172SUBROUTINE intgrib1(K1F,KGDS1F,K2F,KGDS2F,MRL,MRO, &
1173 IV,IP,IPOPT,KGDS1,K1,IB1,L1,F1,G1,KGDS2,K2, &
1174 IB2,L2,F2,G2,IRET)
1175#ifdef USEIPMOD
1176 USE ip_mod
1177#endif
1178 INTEGER IPOPT(20)
1179 INTEGER KGDS1(200),KGDS2(200)
1180 LOGICAL*1 L1(K1),L2(K2)
1181 REAL F1(K1),F2(K2),G1(K1),G2(K2)
1182 INTEGER KGDS1F(200),KGDS2F(200)
1183 LOGICAL*1 L1F(K1F),L2F(K2F)
1184 REAL F1F(K1F),F2F(K2F),G1F(K1F),G2F(K2F)
1185 REAL RLAT(MRL),RLON(MRL),CROT(MRO),SROT(MRO)
1186
1187 ! REGLR TO REGLR SCALAR
1188 IF(k1f.EQ.1.AND.k2f.EQ.1.AND.iv.EQ.0) THEN
1189 CALL ipolates(ip,ipopt,kgds1,kgds2,k1,k2,1,ib1,l1,f1, &
1190 ki,rlat,rlon,ib2,l2,f2,iret)
1191
1192 ! IRREG TO REGLR SCALAR
1193 ELSEIF(k1f.NE.1.AND.k2f.EQ.1.AND.iv.EQ.0) THEN
1194 IF(ip.EQ.2) THEN
1195 CALL ipxwafs3(1,k1,k1f,1, &
1196 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1197 ELSE
1198 CALL ipxwafs2(1,k1,k1f,1, &
1199 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1200 ENDIF
1201 IF(iret.EQ.0) THEN
1202 CALL ipolates(ip,ipopt,kgds1f,kgds2,k1f,k2,1,ib1f,l1f,f1f, &
1203 ki,rlat,rlon,ib2,l2,f2,iret)
1204 ENDIF
1205
1206 ! REGLR TO IRREG SCALAR
1207 ELSEIF(k1f.EQ.1.AND.k2f.NE.1.AND.iv.EQ.0) THEN
1208 CALL ipolates(ip,ipopt,kgds1,kgds2f,k1,k2f,1,ib1,l1,f1, &
1209 ki,rlat,rlon,ib2f,l2f,f2f,iret)
1210 IF(iret.EQ.0) THEN
1211 IF(ip.EQ.2) THEN
1212 CALL ipxwafs3(-1,k2,k2f,1, &
1213 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1214 ELSE
1215 CALL ipxwafs2(-1,k2,k2f,1, &
1216 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1217 ENDIF
1218 ENDIF
1219
1220 ! IRREG TO IRREG SCALAR
1221 ELSEIF(k1f.NE.1.AND.k2f.NE.1.AND.iv.EQ.0) THEN
1222 IF(ip.EQ.2) THEN
1223 CALL ipxwafs3(1,k1,k1f,1, &
1224 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1225 ELSE
1226 CALL ipxwafs2(1,k1,k1f,1, &
1227 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1228 ENDIF
1229 IF(iret.EQ.0) THEN
1230 CALL ipolates(ip,ipopt,kgds1f,kgds2f,k1f,k2f,1,ib1f,l1f,f1f, &
1231 ki,rlat,rlon,ib2f,l2f,f2f,iret)
1232 IF(iret.EQ.0) THEN
1233 IF(ip.EQ.2) THEN
1234 CALL ipxwafs3(-1,k2,k2f,1, &
1235 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1236 ELSE
1237 CALL ipxwafs2(-1,k2,k2f,1, &
1238 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1239 ENDIF
1240 ENDIF
1241 ENDIF
1242
1243 ! REGLR TO REGLR VECTOR
1244 ELSEIF(k1f.EQ.1.AND.k2f.EQ.1.AND.iv.NE.0) THEN
1245 CALL ipolatev(ip,ipopt,kgds1,kgds2,k1,k2,1,ib1,l1,f1,g1, &
1246 ki,rlat,rlon,crot,srot,ib2,l2,f2,g2,iret)
1247 IF(iret.EQ.0.AND.ki.EQ.k2-1) THEN
1248 f2(k2)=0
1249 g2(k2)=0
1250 ENDIF
1251
1252 ! IRREG TO REGLR VECTOR
1253 ELSEIF(k1f.NE.1.AND.k2f.EQ.1.AND.iv.NE.0) THEN
1254 IF(ip.EQ.2) THEN
1255 CALL ipxwafs3(1,k1,k1f,1, &
1256 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1257 CALL ipxwafs3(1,k1,k1f,1, &
1258 kgds1,ib1,l1,g1,kgds1f,ib1f,l1f,g1f,iret)
1259 ELSE
1260 CALL ipxwafs2(1,k1,k1f,1, &
1261 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1262 CALL ipxwafs2(1,k1,k1f,1, &
1263 kgds1,ib1,l1,g1,kgds1f,ib1f,l1f,g1f,iret)
1264 ENDIF
1265 IF(iret.EQ.0) THEN
1266 CALL ipolatev(ip,ipopt,kgds1f,kgds2,k1f,k2,1, &
1267 ib1f,l1f,f1f,g1f, &
1268 ki,rlat,rlon,crot,srot,ib2,l2,f2,g2,iret)
1269 IF(iret.EQ.0.AND.ki.EQ.k2-1) THEN
1270 f2(k2)=0
1271 g2(k2)=0
1272 ENDIF
1273 ENDIF
1274
1275 ! REGLR TO IRREG VECTOR
1276 ELSEIF(k1f.EQ.1.AND.k2f.NE.1.AND.iv.NE.0) THEN
1277 CALL ipolatev(ip,ipopt,kgds1,kgds2f,k1,k2f,1,ib1,l1,f1,g1, &
1278 ki,rlat,rlon,crot,srot,ib2f,l2f,f2f,g2f,iret)
1279 IF(iret.EQ.0) THEN
1280 IF(ip.EQ.2) THEN
1281 CALL ipxwafs3(-1,k2,k2f,1, &
1282 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1283 CALL ipxwafs3(-1,k2,k2f,1, &
1284 kgds2,ib2,l2,g2,kgds2f,ib2f,l2f,g2f,iret)
1285 ELSE
1286 CALL ipxwafs2(-1,k2,k2f,1, &
1287 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1288 CALL ipxwafs2(-1,k2,k2f,1, &
1289 kgds2,ib2,l2,g2,kgds2f,ib2f,l2f,g2f,iret)
1290 ENDIF
1291 ENDIF
1292
1293 ! IRREG TO IRREG VECTOR
1294 ELSEIF(k1f.NE.1.AND.k2f.NE.1.AND.iv.NE.0) THEN
1295 IF(ip.EQ.2) THEN
1296 CALL ipxwafs3(1,k1,k1f,1, &
1297 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1298 CALL ipxwafs3(1,k1,k1f,1, &
1299 kgds1,ib1,l1,g1,kgds1f,ib1f,l1f,g1f,iret)
1300 ELSE
1301 CALL ipxwafs2(1,k1,k1f,1, &
1302 kgds1,ib1,l1,f1,kgds1f,ib1f,l1f,f1f,iret)
1303 CALL ipxwafs2(1,k1,k1f,1, &
1304 kgds1,ib1,l1,g1,kgds1f,ib1f,l1f,g1f,iret)
1305 ENDIF
1306 IF(iret.EQ.0) THEN
1307 CALL ipolatev(ip,ipopt,kgds1f,kgds2f,k1f,k2f,1, &
1308 ib1f,l1f,f1f,g1f, &
1309 ki,rlat,rlon,crot,srot,ib2f,l2f,f2f,g2f,iret)
1310 IF(iret.EQ.0) THEN
1311 IF(ip.EQ.2) THEN
1312 CALL ipxwafs3(-1,k2,k2f,1, &
1313 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1314 CALL ipxwafs3(-1,k2,k2f,1, &
1315 kgds2,ib2,l2,g2,kgds2f,ib2f,l2f,g2f,iret)
1316 ELSE
1317 CALL ipxwafs2(-1,k2,k2f,1, &
1318 kgds2,ib2,l2,f2,kgds2f,ib2f,l2f,f2f,iret)
1319 CALL ipxwafs2(-1,k2,k2f,1, &
1320 kgds2,ib2,l2,g2,kgds2f,ib2f,l2f,g2f,iret)
1321 ENDIF
1322 ENDIF
1323 ENDIF
1324 ENDIF
1325
1326END SUBROUTINE intgrib1
1327
1343FUNCTION lengdsf(KGDS,KGDSF)
1344 INTEGER kgds(200),kgdsf(200)
1345
1346 IF(kgds(1).EQ.201) THEN
1347 kgdsf=kgds
1348 lengdsf=kgds(7)*kgds(8)-kgds(8)/2
1349 ELSEIF(kgds(1).EQ.202) THEN
1350 kgdsf=kgds
1351 lengdsf=kgds(7)*kgds(8)
1352 ELSEIF(kgds(19).EQ.0.AND.kgds(20).NE.255) THEN
1353 CALL ipxwafs(1,1,1,0,kgds,dum,kgdsf,dumf,iret)
1354 IF(iret.EQ.0) THEN
1355 lengdsf=kgdsf(2)*kgdsf(3)
1356 ELSE
1357 lengdsf=0
1358 ENDIF
1359 ELSE
1360 kgdsf=kgds
1361 lengdsf=kgds(2)*kgds(3)
1362 ENDIF
1363
1364END FUNCTION lengdsf
intgrib
subroutine intgrib(iv, ip, ipopt, kgds1, k1, ib1, l1, f1, g1, kgds2, k2, ib2, l2, f2, g2, iret)
Interpolate field.
Definition copygb.F90:1095
cpgb
subroutine cpgb(lg1, lx1, lgb, lxb, lgm, lxm, lg2, igi, kgdsi, ip, ipopt, jpds1, nuv, iuv, jpdsb, jb, jbk, lab, ab, lam, am, lxx, lwg, ids, ibs, nbs)
Copy grib files.
Definition copygb.F90:566
eusage
subroutine eusage
Print proper usage to stderr.
Definition copygb.F90:514
cpgb1
subroutine cpgb1(lg1, lx1, m1, cbuf1, nlen1, nnum1, mnum1, mbuf, mf, mi, igi, kgdsi, ip, ipopt, jpds1, nuv, iuv, jpdsb, jb, jbk, lab, ab, lam, am, ids, ibs, nbs, lgb, lxb, mb, cbufb, nlenb, nnumb, mnumb, lgm, lxm, mm, cbufm, nlenm, nnumm, mnumm, lg2, lxx, ks1, no, iret)
Copy one grib field.
Definition copygb.F90:787
copygb
program copygb
The command copygb copies all or part of one GRIB file to another GRIB file, interpolating if necessa...
Definition copygb.F90:149
lengdsf
function lengdsf(kgds, kgdsf)
Return the length of a filled grid.
Definition copygb.F90:1344
intgrib1
subroutine intgrib1(k1f, kgds1f, k2f, kgds2f, mrl, mro, iv, ip, ipopt, kgds1, k1, ib1, l1, f1, g1, kgds2, k2, ib2, l2, f2, g2, iret)
Interpolate field.
Definition copygb.F90:1175