| Data and Documentation | Chronology and News | Program Status | Publications | Related Data and Resources | Contact Points |
ICOADS Web information page (Wednesday, 04-Jun-2014 19:34:43 UTC):
Software demo: {rwimma1}
Fortran program+shell {rwimma1}, together with units conversion routines in Fortran library {lmrlib} and IMMA documentation R2.5-imma_short.pdf, can be adapted to translate between formats and output IMMA1 data. For example icoads-immt5Ximma1.f90 translates IMMT5 to IMMA1; other pre-{rwimma1}, e.g. {rdimma0}-based, examples can be found in the translation directories.
Below is an annotated excerpt of the main program of {rwimma1}, i.e. specifically omitting the detailed comments at the top of the program, and omitting the code below the main program marked as "code beyond this point should not require any modification." The program, and its Unix scripting, has been modified to translate a single line of artificial input data (listed below the Main program). New code lines (in lower case), as well as explanatory comments, are shown in red. In addition some upper case (original) lines of code have been uncommented or commented, so as to activate/deactivate selected standard program features (e.g. printing the output data, optionally including IMMA header lines).
!
! PRINT PROGRAM HEADER
!! WRITE(STDOUT,*)PROGID
! DO NOT PRINT CORE HEADER OR CORE
! CALL PRNSKP(YR,SH)
! DO NOT PRINT ATTACHMENT HEADER OR ATTACHMENT
! choose attachments to skip
CALL PRNSKP(ATTI1,ATTI5-1)
CALL PRNSKP(ATTI5,ATTI6-1)
CALL PRNSKP(ATTI6,ATTI7-1)
CALL PRNSKP(ATTI7,ATTI8-1)
CALL PRNSKP(ATTI8,ATTI9-1)
CALL PRNSKP(ATTI9,ATTI96-1)
CALL PRNSKP(ATTI96,ATTI97-1)
CALL PRNSKP(ATTI97,ATTI98-1)
CALL PRNSKP(ATTI98,ATTI99-1)
! CALL PRNSKP(ATTI99,SUPD)
!
! PRINT REPORT HEADER
! eventually comment print header call
CALL PRNHDR(STDOUT,ILEN,ABBR,YR,SUPD)
! PRINT CORE HEADER
! CALL PRNHDR(STDOUT,ILEN,ABBR,YR,SH)
! PRINT ATTACHMENT HEADER
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI1,ATTI5-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI5,ATTI6-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI6,ATTI7-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI7,ATTI8-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI8,ATTI9-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI9,ATTI96-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI96,ATTI97-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI97,ATTI98-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI98,ATTI99-1)
! CALL PRNHDR(STDOUT,ILEN,ABBR,ATTI99,SUPD)
! INITIALIZE NUMBER OF REPORTS READ
NREC=0
!
! READ REPORT
100 CONTINUE
! populate character array with elements from input
READ(*,'(A)',END=900)ctrue(supd)
! INCREMENT NUMBER OF REPORTS READ
NREC=NREC+1
ctrue(dy)(:16)=ctrue(supd)(1:2)
ctrue(mo)(:16)=ctrue(supd)(3:4)
ctrue(yr)(:16)=ctrue(supd)(5:8)
ctrue(hr)(:16)=ctrue(supd)(9:10)
ctrue(lat)(:16)=ctrue(supd)(11:15)
ctrue(lon)(:16)=ctrue(supd)(16:21)
ctrue(slp)(2:16)=ctrue(supd)(22:24)
ctrue(n)(:16)=ctrue(supd)(26:26)//ctrue(supd)(25:25)
ctrue(sst)(:16)=ctrue(supd)(27:31)
ctrue(w)(:16)=ctrue(supd)(32:34)
ctrue(d)(:16)=ctrue(supd)(35:38)
ctrue(ww)(:16)=ctrue(supd)(39:40)
ctrue(atti1)(:16)=' 1'
ctrue(attl1)(:16)='65'
ctrue(atti5)(:16)=' 5'
ctrue(attl5)(:16)='94'
ctrue(atti6)(:16)=' 6'
ctrue(attl6)(:16)='68'
ctrue(atti7)(:16)=' 7'
ctrue(attl7)(:16)='58'
ctrue(atti8)(:16)=' 8'
ctrue(attl8)(:16)='2U'
ctrue(atti9)(:16)=' 9'
ctrue(attl9)(:16)='32'
ctrue(atti99)(:16)='99'
ctrue(attl99)(:16)=' 0'
write(rpt,110)(ctrue(i),i=1,atti96-1) &
&,(ctrue(i),i=atti99,supd-1),trim(ctrue(supd))
110 format(a4,2a2,a4,a5,a6,a2,5a1,2a2,a9,a2,a1,a3,a1,a3,a1,2a2,a1,a5 &
&,a1,a3,a1,a4,a1,a4,a1,a4,a2,a4,7a1,8a2,a1,a3,a2,2a3,2a2,5a1,a2 &
&,33a1,a2,a1,3a2,7a1,3a2,a1,a2,7a1,a3,24a1,2a3,2a2,3a3,8a1,a4,2a1 &
&,a7,2a2,a4,a6,a1,a5,5a4,2a3,a5,a1,2a4,6a2,a1,4a2,2a3,2a2,a1,a2,2a3 &
&,a2,4a3,2a5,3a2,a5,a4,a5,5a4,a5,a4,a5,a4,a3,3a4,a3,3a4,a2,a4,a10 &
&,2a2,a1,a2,3a1,2a2,a1,2a3,3a1,2a4 &
&,2a2,a1,a)
!
! CONVERT CHARACTERS TO FLOATING POINT VALUES
CALL GETRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR &
&,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
!
! millimeters Hg to millibars
if (ftrue(slp).ne.fmiss) ftrue(slp)=fxmmmb(ftrue(slp))
!
! tenths (of sky covered) to oktas (of sky covered)
if (ctrue(n)(2:2).ne.' ') then
if (ctrue(n)(:2).eq.'01') then
ftrue(n)=10.
else
ftrue(n)=fmiss
endif
endif
if (ftrue(n).ne.fmiss) ftrue(n)=ixt1ok(nint(ftrue(n)))
!
! Kelvins to Celsius
if (ftrue(sst).ne.fmiss) ftrue(sst)=fxtktc(ftrue(sst))
!
! knots to m/s
if (ftrue(w).ne.fmiss) ftrue(w)=fxktms(ftrue(w)*10.)
!
! 32-point direction abbreviation into code and degrees
select case (ctrue(d)(:4))
case (' ')
case ('CALM','C')
ftrue(d)=361.
case ('VAR','V','BAF','B')
ftrue(d)=362.
case default
ftrue(d)=ix32dd(ctrue(d),itrue(d),nint(fmiss))
end select
!
! CONVERT LONGITUDE TO DEGREES EAST
CALL EAST(ITRUE(LON),FTRUE(LON),FERR)
! EXAMPLE OF PARAMETER/INPUT COMPONENT/FIELD NUMBER FUNCTIONS
! IF (GETPN(GETICN(SST),GETFN(SST)).NE.SST) STOP 'INITICN'
! SET CREATION DAY NUMBER
! FIVAD(CDNI,NIVAD+1)=GETCDN(31,12,2013)
! GET UNIQUE REPORT ID
! CALL GETUID(CTRUE(UID))
! SET EXTREME FLOATING POINT VALUES TO ERROR VALUE
CALL MINMAX(CTRUE,ITRUE,FTRUE,FMISS,FERR &
&,ILEN,FMIN1,FMAX1,FMIN2,FMAX2,FUNITS,ITYPE,NUM)
!
! local date into UTC
if (ftrue(hr).ne.fmiss) then
ftrue(hr)=fmiss
if (ftrue(yr).ne.fmiss .and. ftrue(mo).ne.fmiss &
& .and. ftrue(dy).ne.fmiss) then
itrue(dy)=ixdtnd(itrue(dy),itrue(mo),itrue(yr))
if (ftrue(lon).ne.fmiss .and. itrue(dy).ne.-1) then
call rxltut(itrue(hr),itrue(dy),itrue(lon) &
& ,itrue(hr),itrue(dy))
call rxnddt(itrue(dy)*1 &
& ,itrue(dy),itrue(mo),itrue(yr))
if (itrue(dy).ne.-1) then
ftrue(yr)=itrue(yr)
ftrue(mo)=itrue(mo)
ftrue(dy)=itrue(dy)
ftrue(hr)=itrue(hr)*funits(hr)
endif
endif
endif
endif
!
! indicators for non-missing elements
! if (ftrue(hr).ne.fmiss) ftrue(ti)=
! if (ftrue(lat).ne.fmiss .or. ftrue(lon).ne.fmiss) ftrue(li)=
! if (ftrue(id).ne.fmiss) ftrue(ii)=
! if (ftrue(d).ne.fmiss) ftrue(di)=
! if (ftrue(w).ne.fmiss) ftrue(wi)=
if (ftrue(vv).eq.fmiss) ftrue(vi)=fmiss
! if (ftrue(at).ne.fmiss .or. ftrue(wbt).ne.fmiss .or. &
! & ftrue(dpt).ne.fmiss .or. ftrue(sst).ne.fmiss) ftrue(it)=
if (ftrue(wbt).eq.fmiss) ftrue(wbti)=fmiss
if (ftrue(dpt).eq.fmiss) ftrue(dpti)=fmiss
! if (ftrue(sst).ne.fmiss) ftrue(si)=
if (ftrue(h).eq.fmiss) ftrue(hi)=fmiss
! if (ftrue(wp).ne.fmiss) ftrue(wx)=1.
! if (ftrue(sp).ne.fmiss) ftrue(sx)=1.
! if (ftrue(rh).ne.fmiss) ftrue(rhi)=
!
! SAVE SUMMARY INFORMATION
CALL SAVSUM(CTRUE,FTRUE,FMISS,FERR &
&,ILEN,ABBR,NUM)
!
! CONVERT FLOATING POINT VALUES TO CHARACTERS
CALL PUTRPT(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR &
&,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM)
! WRITE REPORT
! write variable length reports or print fixed length (below)
WRITE(STDOUT,'(A)')TRIM(RPT)
! CONVERT SUBSIDIARY FLOATING POINT VALUES TO CHARACTERS
! CALL PUTSUB(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR &
! &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM,ATTI7,ATTI8-1)
! CALL PUTSUB(RPT,CTRUE,ITRUE,FTRUE,FMISS,FERR &
! &,ILEN,ABBR,FMIN1,FUNITS,ITYPE,RPTID,NUM,ATTI96,ATTI98-1)
! WRITE SUBSIDIARY REPORT
! IF (RPT.NE.' ') WRITE(STDOUT,'(A)')TRIM(RPT)
!
! PRINT REPORT
!! CALL PRNRPT(STDOUT,ILEN,CTRUE,YR,SUPD)
! PRINT CORE
! CALL PRNRPT(STDOUT,ILEN,CTRUE,YR,SH)
! PRINT ATTACHMENT
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI1,ATTI5-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI5,ATTI6-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI6,ATTI7-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI7,ATTI8-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI8,ATTI9-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI9,ATTI96-1)
! DO J=1,NIVAD
! IF (GETPN(IIVAD(ICNI,J),IIVAD(FNI,J)).EQ.SST) CONTINUE
! CALL PRNRPT(STDOUT,ILEN(ATTI96),CIVAD(:,J),1,ATTI97-ATTI96)
! ENDDO
! DO J=1,NERROR
! ILEN(ERRD)=ILEN(GETPN(IERROR(ICNE,J),IERROR(FNE,J)))
! CALL PRNRPT(STDOUT,ILEN(ATTI97),CERROR(:,J),1,ATTI98-ATTI97)
! ENDDO
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI98,ATTI99-1)
! CALL PRNRPT(STDOUT,ILEN,CTRUE,ATTI99,SUPD)
!
! STOP AFTER SEVERAL REPORTS HAVE BEEN READ
! IF (NREC.GE.50) STOP 'REMOVE STOP TO READ ALL REPORTS'
call INIT(CTRUE,ITRUE,FTRUE,FMISS,ILEN,NUM)
GOTO 100
!
! END OF FILE
900 CONTINUE
!! WRITE(STDOUT,*)'REPORTS ',NREC
!
! PRINT SUMMARY INFORMATION TO UNIT
CALL PRNSUM(UNIT,PROGID,ABBR,NUM)
END
# first download lmrlib rwimma1Demo then
tail -4 lmrlib rwimma1Demo
==> lmrlib <==
end
EOR
rm lmrlib.o
gfortran -c lmrlib.f
==> rwimma1Demo <==
# ddmmyyyyhh lat lonslp n sstspd dirww
echo '3112201319 -75007601027315100NEXN--' | ./a.out
# eventually comment cat
cat fort.10
chmod a+x lmrlib rwimma1Demo
./lmrlib
./rwimma1Demo
A W D A AAS
L L T N S P B WP D S T TTU
Y M D H A O ITTLDV I I I CD W V V WW L PI AT BT P S S NCH CC W W W S S S T TTP
R O Y R T N MCIISS D I D 1I DI WI V W1 PA PT TI TI T I TNHLIHMH D P H D P H I LED
2014 1 1 0 28500 11 34 514 10133 08 99 0 3112201319 -75007601027315100NEXN--
RWIMMA1.01A
SUMMARY OF FIELDS
FIELD # EXTANT # MISSING # ERRONEOUS % EXTANT % MISSING % ERRONEOUS
YR 1 0 0 100 0 0
MO 1 0 0 100 0 0
DY 1 0 0 100 0 0
HR 1 0 0 100 0 0
LON 1 0 0 100 0 0
D 1 0 0 100 0 0
W 1 0 0 100 0 0
WW 0 1 1 0 100 100
SLP 1 0 0 100 0 0
SST 1 0 0 100 0 0
N 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
ATTI 1 0 0 100 0 0
ATTL 1 0 0 100 0 0
SUPD 1 0 0 100 0 0
SUMMARY OF ERRORS
FIELD ERROR FREQUENCY
WW -- 1
[Documentation and Software][Links to additional]
U.S. National Oceanic and Atmospheric Administration hosts the icoads website privacy disclaimer
Document maintained by icoads@noaa.gov
Updated: Jun 4, 2014 19:34:43 UTC
http://icoads.noaa.gov/rwimma1.html