subroutine start (error) c c*********************************************************************** c c start march,1978 c c modified 7/83 inplement title & counter description for c one line file processing summary(using unit 8 & unit 20) c modified to read south & north latitude tables. both c tables have the same equator zone data. c c c purpose c performs job initialization tasks. c c method c generates job titling and printed echo of input. c reads basic radiance tables. c computes and stores quantities used in c lagrange interpolation. c c calling sequence c call start c c variable c name type i/o description c ---- ---- --- ----------- c arguments c error l*4 o error flag c c internal c jobtim(28) c*1 o time of job run e.g. ' mon aug 30,1978 ' c c subroutines called c ztimex,rfnams,rdcons,cnstnts c c calling routine driver c c modifications c c*********************************************************************** c implicit none integer*4 nfiles, i, lentrm, j, jmax, l, k, lunit real*4 xdenom c character*1 jobtim(28) character*80 card logical*4 error c common /env/ system c real*4 logi0n, z1i0n, z2i0n, sbn, ti0n, li0rn, z1i0rn, z2i0rn, 1 ti0rn, sbrn real*4 logi0s, z1i0s, z2i0s, sbs, ti0s, li0rs, z1i0rs, z2i0rs, 1 ti0rs, sbrs character*6 system character*3 satlit character*60 fname,un6nam,fl_nam character*60 tabfn(5),rptfn,pmffn,ozsfn,acffn,consfn, 1 orbcfn,cmplr,detail common /flnams/ fname(13) equivalence (fname(1),tabfn(1)),(fname(4),rptfn), 1 (fname(5),pmffn),(fname(6),ozsfn),(fname(7),acffn), 2 (fname(8),consfn),(fname(9),orbcfn), 3 (fname(10),cmplr),(fname(12),detail) real eday1,etime1,eday2,etime2,elatlo,elathi common/eclips/eday1,etime1,eday2,etime2,elatlo,elathi character progid*12, progdt*11, ver*4, env*16 common /pgminf/ progid, progdt, ver, env include 'pterp.com' include 'contrl.com' include 'contcv.com' include 'satnams.h' data satlit/' '/ c c** store program information for ozone file header and processing report. c ver='8.00' progdt='Sep 10 2001' progid='v8sbuv.f ' env='unix' c c**** find date and time for start of run c c call ztimex (jobtim) c jobtim(20)=':' c jobtim(23)=':' c c**** read in system id. read in file names. if system is not mvs, or c**** a report file name is specified, then open files for formatted c**** output units (to be concatenated at end of job). c read(5,1000) system, satlit satnam = satlit call rfnams (error,nfiles) if (error) go to 900 c c**** rewind and read past system id and file names (already read in). c rewind 5 do 300 i=1,nfiles+1 read (5,'()') 300 continue c c**** read in processing control parameters c read(5,*,end=900) lprint print*,'start, lprint',lprint read(5,*,end=900) iopts print*,'start, iopts',iopts read(5,*,end=900) xlatlo,xlathi,xlonlo,xlonhi read(5,*,end=50) starti,eday1,etime1,eday2,etime2,elatlo,elathi c 50 continue if (system.ne.'mvs' .or. rptfn.ne.' ') then un6nam= rptfn if (un6nam.eq.' ') un6nam='t'//jobtim(18)//jobtim(19)// 1 jobtim(21)//jobtim(22)//jobtim(24)//jobtim(25)//'.un6' c open (6, file=un6nam,form='formatted',status='unknown') print*,'opening unit 8' open (8, form='formatted',status='scratch') print*,'opening unit 9' open (9, form='formatted',status='scratch') print*,'opening unit 19' open (19,form='formatted',status='scratch') print*,'opening unit 20' open (20,form='formatted',status='scratch') print*,'opening unit 21' open (21,form='formatted',status='scratch') end if c c**** create job titling information and input card echo printing c i=4 if (ver(4:4).eq.' ') i = 3 if (satlit.ne.' ') then write (6,2000) ver(1:i), progdt, ' '//satlit else write (6,2000) ver(1:i), progdt, ' ' end if write(6,2100) jobtim write(6,2200) rewind 5 100 read (5,1000,end=200) card lentrm=80 150 if (card(lentrm:lentrm) .eq. ' ' .and. lentrm .gt. 0) then lentrm= lentrm - 1 goto 150 end if write(6,2300) card(1:lentrm) go to 100 200 continue c c**** read in basic tables, sensitivity tables, and apriori ozone and temp c call rdsbtbl c c**** debug for subroutine start c ccccc write(6,2400) xzlog,xlog,densol,denscn c c**** open data files. for direct access files, record length assigned to c**** keyword "recl" is given in longwords unless system is ibm/mvs, in which c**** case it is given in bytes. to handle this, recl is expressed as longwords c**** multiplied by lunit, which is set to 1 for non-mvs systems, or 4 for mvs. c lunit = 4 c if (index(system,'mvs').gt.0) lunit = 4 c if (cmplr(1:3).eq.'f90') lunit = 4 c c use this code for compiling in f77 "readonly" c c fl_nam=pmffn c if (fl_nam.ne.' ') open (11,file=fl_nam,form='unformatted', c 1 access='sequential',status='old',err=800) c fl_nam=ozsfn c if (fl_nam.ne.' ') open (13,file=fl_nam,form='unformatted', c 1 access='sequential',status='unknown',err=800) c fl_nam=detail c if (fl_nam.ne.' ') open (15,file=fl_nam,form='unformatted', c 1 access='sequential',status='unknown',err=800) c fl_nam=acffn c if (fl_nam.ne.' ') open (14,file=fl_nam,form='unformatted', c 1 access='direct',recl=8*lunit,status='old',err=800) c fl_nam=consfn c if (fl_nam.ne.' ') open ( 4,file=fl_nam,form='formatted', c 1 access='sequential',status='old',err=800) c fl_nam=orbcfn c if (fl_nam.ne.' ') open (30,file=fl_nam,form='unformatted', c 1 access='direct',recl=90*lunit,status='unknown',err=800) c c use this code for f90 compiling "action='read'" c fl_nam=pmffn print*,'opening unit 11' if (fl_nam.ne.' ') open (11,file=fl_nam,form='unformatted', 1 access='sequential',status='old',err=800,action='read') fl_nam=ozsfn print*,'opening unit 13' if (fl_nam.ne.' ') open (13,file=fl_nam,form='unformatted', 1 access='sequential',status='unknown',err=800) fl_nam=detail print*,'opening unit 15' if (fl_nam.ne.' ') open (15,file=fl_nam,form='unformatted', 1 access='sequential',status='unknown',err=800) fl_nam=acffn print*,'opening unit 14' if (fl_nam.ne.' ') open (14,file=fl_nam,form='unformatted', 1 access='direct',recl=8*lunit,status='old',err=800, 2 action='read') fl_nam=consfn print*,'opening unit 4' if (fl_nam.ne.' ') open ( 4,file=fl_nam,form='formatted', 1 access='sequential',status='old',err=800,action='read') fl_nam=orbcfn print*,'opening unit 30' if (fl_nam.ne.' ') open (30,file=fl_nam,form='unformatted', 1 access='direct',recl=90*lunit,status='unknown',err=800) c c**** read in calibration constants c call rdcons (error) c c**** calculate ancillary quantities for the total ozone and profile retrieval c call cnstnts c c**** title and counter description for one line processing summary c write(8,2500) write(8,2600) write(20,2700) write(20,2800) write(9,3000) return 800 write (6,8000) fl_nam 900 error=.true. return 1000 format (a,1x,a) 2000 format (' **** sbuv profile ozone processing ', 1 'program, version ',a,', ',a,' ****'//a/) 2100 format (' ','date and time for job run: ',28a1) 2200 format (' ','a listing of the input cards for this job ', 1 'run follows: '/) 2300 format(1x,a) c 2400 format(/' debug for subroutine start',/, 1 1x,'xzlog= ',10f8.5,/,1x,'xlog = ',6f8.5,/, 2 1x,'densol= ',/,7(1x,4f8.5,1x,/), 3 1x,'denscn= ',/,3(1x,4f8.5,1x,/),//) c 2500 format(//31x,'processing summary'/31x,18('-')/// 1 36x,'coverage'/,36x,'--------'//) 2600 format(18x,'start',25x,'end',14x,'equator x''ing'/ 1 5x,2(3x,25('-')) ,4x,13('-')/ 2 ' orbit year day gmt lat lon ', 3 'year day gmt lat lon lect lon'/1x,78('-')) 2700 format(//31x,'error flag counts'/31x,17('-')// 1 ' 331 nm triplet'/ 2 ' residue residue',7x, 3 6x,'residue'/ 4 ' sza > 84 too too ',6x, 5 'so2 exceeds'/ 6 ' orbit alg good degrees large large',6x, 7 'present limit'/ 8 16x,'(0)',8x,'(1)',7x,'(2)',7x,'(3)',7x,'(4)',7x,'(5)') 2800 format(1x,78('-')) 2900 format(//' ****** toms daily acf',a,' ******') 3000 format(//28x,'level-2 sscans written'/ 1 28x,'(counts and % of total)'/ 2 28x,'-----------------------'// 3 23x,' high error out of range'/ 4 ' orbit total ', 5 'good sza flag>1 sza>88 pmt cnts<1'/ 6 ' -----',5x,68('-')) 8000 format(/' *** error occurred while attempting'/ 1 6x,'to open file ',a60/6x,'from subroutine "start".'/ 2 6x,'possible causes:'/ 3 6x,'1) file or directory does not exist'/ 4 6x,'2) file is locked out by another job'/) end