program add_akl_head C 03/11 program to add a header to a CEDAR DB .asc file, changing the C begin/end times to be correct for the file C 06/11 Add parts of ~bozo/is/src/chr2is.f to make .cbf files at same time C~ ~bozo/is/src/cbfopn.f C~ ~bozo/is/src/ch2a16.f C~ ~bozo/is/src/erexit.f NOT NEEDED C~ ~bozo/is/src/gbytes.fortran (REPLACE WITH .f ending!) C~ ~bozo/is/src/gftyp.f NOT Needed C~ ~bozo/is/src/lennb.f C~ ~bozo/is/src/paklr.f C~ ~bozo/is/src/rdchr.f C~ ~bozo/is/src/swap4.f C~ ~bozo/is/src/vbkopn.f C~ ~bozo/is/src/detab.f ADDED! C pgf77 -o add_akl_head.exe add_akl_head.f gbytes.f ~bozo/is/src/cbfopn.f ~bozo/is/src/ch2a16.f C ~bozo/is/src/lennb.f ~bozo/is/src/paklr.f ~bozo/is/src/rdchr.f ~bozo/is/src/swap4.f ~bozo/is/src/vbkopn.f C ~bozo/is/src/detab.f C C using characters instead of number tripled the size of the file! C pgf77 -o add_akl_head.exe add_akl_head.f character*80 char80 character*18 char18 character*56 char56 character*3 charnam character*1 charu,chartyp character*9 charmoyr character*13 charkyd c For counts file character*18 rdfile c For [K] file c character*16 rdfile C For Tn file c character*14 rdfile character*14 wrfile,cbffile dimension iprol(16),itimbe(8),jcodval(10),mcodval(4) C Miscellaneous declarations C MSGUN = Fortran unit no. for diagnostic output C MXLS = Max length of string (no. characters) PARAMETER (MSGUN=0, MXLS=200) INTEGER ACCESS CHARACTER TEXT*(MXLS) C Declarations for vbkopn (vbkrd, vbkcls, vbkwr) and rdchr C IOCKS = Checksum validation flag: 0 (off) or 1 (on) C IUNR = Fortran unit for read C IUNW = Fortran unit for write (should not be stdout, 6) C LMWD = Number of bits in a computer word (size of type INTEGER) C LWK = Length of work array needed by VBKOPN C LWKR = Extra large work array C MXBBK = Maximum no. bytes in a block C MXBBKR = Extra large MXBBK C MXLBK = Maximum packed block size (number of words length LMWD) C MXLBKR = Extra large MXLBK C MXNVAL = Maximum no. of values in a record or unpacked record size C MXNVLR = Extra large MXNVAL C MXLPR = Maximum packed record size (number of words length LMWD) C MXLPRR = Extra large MXLPR C The 'extra large' versions are reading and the regular version writing; C the read larger buffer avoids diagnostics which warn when exactly at C the design maximum (which could be a result of limiting an exceedence). PARAMETER (IOCKS = 1, C + IUNR = 10, C + IUNW = 11, + LMWD = 32, + MXBBK = 24000, + MXBBKR = 25000, + MXLBK = MXBBK *8/LMWD, + MXLBKR = MXBBKR*8/LMWD, + LWK = 13 + MXLBK + 20+2*512*64/LMWD, + LWKR = 13 + MXLBKR + 20+2*512*64/LMWD, + MXNVAL = MXLBK *LMWD/16 - 2, + MXNVLR = MXLBKR*LMWD/16 - 2, + MXLPR = (MXNVAL*16 + LMWD-1)/LMWD, + MXLPRR = (MXNVLR*16 + LMWD-1)/LMWD) DIMENSION LRP(MXLPRR), IWKR(LWKR), IWKW(LWK), + LRU(MXNVLR) CHARACTER RDNM*(MXLS), WRNM*(MXLS) ifnm = 8 itxt = 9 ird = 10 iwr = 55 iwr = 40 icb = 70 ipr = 99 C Tn files nf = 8 c open (itxt,file='aklt_head.txt',status='old') c open (ifnm,file='aklt_files.txt',status='old') jpar = 10 mpar = 4 C [K] files c open (itxt,file='aklk_head.txt',status='old') c open (ifnm,file='aklk_files.txt',status='old') c nf = 13 c nf = 5 C Skip over nskp files (file conversion problem in aklk_20051dn.asc, 050410k.asc)?? c nskp = 5 nskp = 4 c do 400 n=1,nskp c read (ifnm,"(a16)") rdfile 400 continue c nf = nf - nskp c jpar = 9 c mpar = 4 C photon count files c ipr = 2 c ipr = 7 c open (ipr,file='c_akl_07022_prologues') open (itxt,file='aklc_head.txt',status='old') open (ifnm,file='list_akl_c',status='old') nf = 25 c nf = 24 C Had to revise 17/149 of same day (start after UT0, then before next day UT24) nf = 1 C Skip over nskp files nskp = 146 do 500 n=1,nskp read (ifnm,"(a3,a1,a1,a9)") charnam,chartyp,charu,charmoyr 500 continue c open (ird,file='akl_c_K2003352.asc',status='old') c open (iwr,file='c_akl_03352.asc') c open (ipr,file='c_akl_03352_prologues') c open (ird,file='akl_c_2006_030_149.asc',status='old') c open (iwr,file='c_akl_06_030_149.asc') c open (ipr,file='c_akl_06_030_149_prologues') c open (ird,file='akl_c_K2009348.asc',status='old') c open (iwr,file='c_akl_09348.asc') c open (ipr,file='c_akl_09348_prologues') rewind ird jpar = 9 mpar = 3 do 3000 mf=1,nf ird = ird + 1 iwr = iwr + 1 icb = icb + 1 if (mpar .eq. 3 .and. ipr .ne. 7) then C Counts nightly files read (ifnm,"(a18)") rdfile chartyp = 'c' endif if (mpar .eq. 4 .and. jpar .eq. 9) then C [K] files read (ifnm,"(a16)") rdfile chartyp = 'k' endif if (mpar .eq. 4 .and. jpar .eq. 10) then C Tn yearly files read (ifnm,"(a14)") rdfile chartyp = 't' endif open (ird,file=rdfile,status='old') rewind ird nrecrd = 0 nlin = 0 1000 continue c write (6,"(1x,'Read nrecrd =',i6)") nrecrd C Read Prologue read (ird,"(16i6)",end=2000) iprol nrecrd = nrecrd + 1 if (ipr .eq. 7) then rec3 = nrecrd/3. write (ipr,"(i5,f7.1,16i6)") nrecrd,rec3,iprol endif C get begin/end times if (nrecrd .eq. 1) then C Define wrfile in CDB fashion (except is t.asc for Tn, k.asc for [K], and c.asc for counts) iy2 = iprol(5)/100 iyrbe = iprol(5)-iy2*100 write (wrfile,"('akl',i2.2,i4.4,a1,'.asc')") iyrbe, | iprol(6),chartyp write (cbffile,"('akl',i2.2,i4.4,a1,'.cbf')") iyrbe, | iprol(6),chartyp write (6,"(1x,'rd,wrfile ='1x,a14,1x,a14)") rdfile,wrfile open (iwr,file=wrfile) itimbe(1) = iprol(5) itimbe(2) = iprol(6) itimbe(3) = iprol(7) itimbe(4) = iprol(8) endif itimbe(5) = iprol(9) itimbe(6) = iprol(10) itimbe(7) = iprol(11) itimbe(8) = iprol(12) do 1100 n=2,iprol(1) read (ird,"(a80)") char80 1100 continue nlin = nlin + iprol(1) go to 1000 2000 continue rewind ird write (6,"(1x,'nrecrd nlin =',2i8)") nrecrd,nlin rewind itxt C Read header read (itxt,"(16i6)") iprol C Set begin/end times in iprol from data do 2050 i=5,12 iprol(i) = itimbe(i-4) 2050 continue C Write out to new file write (iwr,"(16i6)") iprol do 2100 n=2,7 read (itxt,"(a80)") char80 write (iwr,"(a80)") char80 2100 continue C Revise the begin/end times in the header text do 2150 n=8,15 read (itxt,"(a18,i6,a56)") char18,num,char56 num = itimbe(n-7) write (iwr,"(a18,i6,a56)") char18,num,char56 2150 continue do 2200 n=16,iprol(1) read (itxt,"(a80)") char80 write (iwr,"(a80)") char80 2200 continue C Now add the regular data BUT NOT AS CHAR (which triples the size of the file!) rewind ird do 2500 n=1,nrecrd read (ird,"(16i6)") iprol write (iwr,"(16i6)") iprol C Read jpar 1-d codes and parameters do 2250 j=1,2 read (ird,"(20i6)") (jcodval(j1),j1=1,jpar) write (iwr,"(20i6)") (jcodval(j1),j1=1,jpar) 2250 continue C Read mpar 2-d codes and parameters do 2300 m=1,iprol(16)+1 read (ird,"(20i6)") (mcodval(j1),j1=1,mpar) write (iwr,"(20i6)") (mcodval(j1),j1=1,mpar) 2300 continue 2500 continue C Make .cbf file using parts of ~bozo/is/src/chr2is.f C 7/10: THIS MAKES BAD .crb files! Use asc2crb.sh instead!! rewind iwr IUNR = iwr IUNW = icb RDNM = wrfile WRNM = cbffile CALL VBKOPN (IUNW,WRNM,MSGUN,LMWD,2,IWKW,LWK,MXLBK,IOCKS) NRW = 0 ! no. records written LRDN = LENNB(RDNM) IF (ACCESS (RDNM,' r') .NE. 0) THEN WRITE (MSGUN,9100) RDNM(:LRDN) GO TO 3000 ENDIF MODCNV = 0 MXNMSG = 10 ! warning diagnostics limit CALL RDCHRI (LMWD,MODCNV,MSGUN,MXNMSG,MXNVLR) C Read and write a record loop NRR = 0 ! no. recs read from current file NSEOF = 0 100 continue CALL RDCHR (IUNR,LRU,ISTR) IF (ISTR .EQ. 0) THEN LLR = LRU(1) CALL PAKLR (MSGUN,LRU,LRP) ELSE ISTR = 3 ENDIF IF (ISTR .EQ. 0) THEN NRR = NRR + 1 NRW = NRW + 1 CALL VBKWR (IUNW,IWKW,LRP,LLR,ISTW) GO TO 100 ENDIF C At end of data on current read file CLOSE (IUNR) WRITE (MSGUN,9210) NRR,RDNM(:LRDN) CALL VBKCLS (IUNW,IWKW) WRITE (MSGUN,9220) IWKW(11),IWKW(12),NRW,cbffile CC CALL EXIT (0) 9100 FORMAT ('CHR2IS skipping file "',A,'"; not readable') 9210 FORMAT ('CHR2IS read ',I8,' recs from "',A,'"') 9220 FORMAT ('CHR2IS wrote',3I8,' (files,blks,recs) for "',A,'"') 3000 continue stop end