SUBROUTINE ANCLV6 C-H A clean version of anclv7tmp.f. All calls to subroutine NPPREC for looking up C-H the record number in the old format tape, and many relavent lines and C-H input parameters are removed. C-H C-H The lookup table for total ozone has an option to extended 6 wavelength C-H channels to 13 wavelength channels for the N16 TOMS wavelength experiment. C-H The table starts from CH12 to CH1 (or CH8), the last one (13 or 6) is for C-H CCR. In the normal case (6 wavelengths), the input table is in the 1b C-H header or in an external ancillary file. In the optional case of C-H 13 wavelengths, three external ancillary files in the old format are C-H combined together. Here is the default mapping of 3 files to the 13 C-H wavelength table: (CCR 13) C-H channel number - 12 11 10 9 8 7 6 5 4 3 2 1 13 C-H table index - 1 2 3 4 5 6 7 8 9 10 11 12 13 C-H file 1 index - 1 2 3 4 5 C-H file 2 index - 1 2 3 C-H file 3 index - 2 3 4 5 6 C-H It also needs a text file named by ancilfilewv0 to define effective alphas and C-H bedas for 13 wavelengths, which has a format as the following example: C-H 3086.6201 3125.8701 3175.9099 3223.6399 3312.9700 3604.2300 3799.7700 C-H 3058.9500 3125.8701 3175.9099 3312.2500 3398.9800 3786.2000 C-H 2.9577 1.6312 0.8630 0.4680 0.1361 0.0000 0.0000 C-H 4.2732 1.6312 0.8630 0.1394 0.0246 0.0000 C-H 1.0752 1.0183 0.9513 0.8925 0.7944 0.5563 0.4456 C-H 1.1177 1.0183 0.9513 0.7951 0.7125 0.4524 C-H The mapping can also be assigned using namelist variables: C-H InsAnclx1(3) and InsAnclx2(3) in FILENAMES group. For example, C-H InsAnclx1=1,4,5 to insert columns 1-4 of the extra ancillary file 1 into C-H the table starting at column 5. C-H InsAnclx2=2,6,9 to insert columns 2-6 of the extra ancillary file 2 into C-H the table starting at column 9. c-h c-h Add a 2nd set of tables for N19 to switch Channel-12 wavelength from 340 nm to 343 nm. c-h This will allow the code to process the two different wavelength settings in the same c-h day cotinuously. To run this switching, change the nml file with the following c-h IOPTS(18)=T c-h xancilfile1='ancln19n.seq', c-h ancilfilewv0='auxn19n.dat', c-h xancilfile2='' c-h The switching subroutine is in chnglam.f, which is called by lamchk. The Day-1 calcons c-h subroutines, which are also modified to load parameters for proper wavelength, are called c-h in lamchk. c-h ----- April 2013 include "anclv6.comments" include "contrl.inc" include "params.inc" include "table.inc" include "tablex.inc" include "mult.inc" include "multx.inc" include "stpro2.inc" include "prsure.inc" include "pr2n.inc" include "pr92.inc" include "optm.inc" include "ui1b.inc" include "uiancl.inc" include "fdbdir.inc" include "opshin.inc" include "fnames.inc" C ANCLRY VERSION 1.0 CW BEGUN 06/25/85 COMPLETED 08/30/85 CW C ANCLRY VERSION 1.1 CW BEGUN 10/23/85 COMPLETED 10/23/85 CW C ANCLRY VERSION 2.0 CW BEGUN 8/20/91 COMPLETED 8/20/91 CW C ANCLV6 VERSION 6.0 BR BEGUN 5/12/93 COMPLETED 5/24/93 BR C INTEGER*4 DATA(179,40),ianclx1(3),ianclx2(3),i2xancf INTEGER*4 REC1B(180) INTEGER*4 POSD1B BYTE B_REC1B(720) CHARACTER*2 N07,N09 C DATA PRTVAL/1.220703E-4/,TW/2.00E0/,SV/7.00E0/,LUANN7/31/ DATA N07/'07'/,N09/'09'/ data ianclx1/1,3,6/,ianclx2/2,6,9/ EQUIVALENCE (B_REC1B(1),REC1B(1)) C write(6,2222) 2222 format(1x,'Entering subroutine ANCLV6') C C C CHECK FOR NIMBUS-7 ANCILLARY DATA C IF (IOPTS(11)) THEN LUANC = LUANN7 ELSE LUANC = LUFDB ENDIF C-H The use of external ancillary file is controlled by filename in C-H open statement. In cases of both N7 and SBUV/2, the same format C-H is used in the ancillary file. When IOPTS(11) is set, the file C-H name is default to ancln07.seq. Thus, IOPTS(15) must be set for C-H all other instruments. All logical unit numbers are 31. if(iopts(15)) luanc = LUXANCL C POSD1B = 2 C C READ SPECTRAL INFORMATION RECORD FROM 1B C 5 continue c-lkh Read 1b and byte swap for linux c-lkh read (luanc,iostat=ios,end=900,err=900) B_REC1B call rdswap(luanc,B_REC1B,id_rec,*900) C IF (REC1B(1).NE.465) GO TO 5 C C LOAD SPECTRAL INFORMATION INTO COMMON /PARAMS/ C CALL FNMOVE (WLEN0(1),13*4,REC1B(2)) CALL FNMOVE (ALFA0(1),13*4,REC1B(15)) CALL FNMOVE (BETA(1),13*4,REC1B(28)) c c-h If given only ONE extra ancilfile, then, it is not for the N16 TOMS wavelength scan mode. c-h This is used to get the extra ancilfile for the N19 SBUV/2 wavelength change (340nm -> 343 nm) i2xancf=index(xancilfile2,' ') if(index(xancilfile1,' ').ne.0 .and. index(ancilfilewv0,' ').ne.0 1 .and. index(xancilfile2,' ').eq. 0)then lamswtch=.TRUE. else lamswtch=.FALSE. endif if(IOPTS(18) .and. IOPTS(15)) then OPEN (UNIT=LUXANCL2,FILE=ancilfilewv0, + STATUS='OLD') read (UNIT=LUXANCL2, *) wlen0,alfa0,beta close (LUXANCL2) endif write(6,6666) wlen0,alfa0,beta 6666 format(3((1x,7f10.4/1x,6f10.4/)/)) c c read ozone absortion, temp. coeff, beta for single scattered calculation c also read out-of-band-response correction coeficients c-h Add optional filename for different instrument open(18,file=auxlfile) do i=1,12 read(18,1400) x1,x2,x3,x4,x5,x6 alfac0(i)=x2 calfa10(i)=x3 calfa20(i)=x4 betac0(i)=x5 oobrcr(i)=x6 enddo 1400 format(1x,f10.2,3e13.5,f9.5,f10.6) close(18) c-h if(lamswtch) then open(18,file=ancilfilewv0) do i=1,12 read(18,1400) x1,x2,x3,x4,x5,x6 alfac1(i)=x2 calfa11(i)=x3 calfa21(i)=x4 betac1(i)=x5 oobrcr1(i)=x6 enddo close(18) endif C C LOCATE AND READ MULTIPLE SCATTERING TABLES C K = 1 10 continue c-lkh read (luanc,iostat=ios,end=900,err=900) B_REC1B call rdswap(luanc,B_REC1B,id_rec,*900) IF (REC1B(1).NE.475) GO TO 900 CALL FNMOVE(DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.41) GO TO 10 C C LOAD MULTIPLE SCATTERING TABLES INTO /MULT/ C CALL FNMOVE (QLOG(1,1,1,1),7130*4,DATA(1,1)) C C READ TOTAL OZONE TABLES C K = 1 30 continue c-lkh read (luanc,iostat=ios,end=900,err=900) B_REC1B call rdswap(luanc,B_REC1B,id_rec,*900) IF (REC1B(1).NE.485) GO TO 900 CALL FNMOVE (DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.34) GO TO 30 C C LOAD OZONE TABLES INTO /TABLE/ C CALL FNMOVE (XLOGI0X(1,1,1,1),5796*4,DATA(1,1)) C-H Move the table from TABLEX to TABLE CALL CATTBL(1,6,1) c-h if(lamswtch) then OPEN (UNIT=LUXANCL2,FILE=xancilfile1,FORM='UNFORMATTED' + ,STATUS='OLD') c-h To get all infor for N19 changing wavelength 205 continue call rdswap(LUXANCL2,B_REC1B,id_rec,*900) IF (REC1B(1).NE.465) GO TO 205 CALL FNMOVE (WLEN0x(1),13*4,REC1B(2)) CALL FNMOVE (ALFA0x(1),13*4,REC1B(15)) CALL FNMOVE (BETAx(1),13*4,REC1B(28)) K = 1 210 continue call rdswap(LUXANCL2,B_REC1B,id_rec,*900) IF (REC1B(1).NE.475) GO TO 900 CALL FNMOVE(DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.41) GO TO 210 CALL FNMOVE (QLOGx(1,1,1,1),7130*4,DATA(1,1)) K = 1 231 continue call rdswap(LUXANCL2,B_REC1B,id_rec,*900) IF (REC1B(1).NE.485 .and. K .eq. 1) GO TO 231 CALL FNMOVE (DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.34) GO TO 231 close(LUXANCL2) CALL FNMOVE (XLOGI0X(1,1,1,1),5796*4,DATA(1,1)) write(6,6665) xancilfile1 write(6,6666) wlen0x,alfa0x,betax 6665 format(1x,'Loaded ',a120) endif C-H To read extra external ancillary files and combine tables for the N16 TOMS C-H wavelength experiment if(IOPTS(18) .and. IOPTS(15)) then if((InsAnclx1(1) .ne. 0) .and. (InsAnclx2(1) .ne. 0))then do i00=1,3 ianclx1(i00)=InsAnclx1(i00) ianclx2(i00)=InsAnclx2(i00) end do endif OPEN (UNIT=LUXANCL2,FILE=xancilfile1,FORM='UNFORMATTED' + ,STATUS='OLD') K = 1 31 continue c-lkh read (LUXANCL2,iostat=ios,end=900,err=900) B_REC1B call rdswap(LUXANCL2,B_REC1B,id_rec,*900) IF (REC1B(1).NE.485 .and. K .eq. 1) GO TO 31 CALL FNMOVE (DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.34) GO TO 31 close(LUXANCL2) CALL FNMOVE (XLOGI0X(1,1,1,1),5796*4,DATA(1,1)) c-H write (6,1122) c-H1122 format (1x,'CHKTBL1 first time') c-H call chktbl1 CALL CATTBL(ianclx1(1),ianclx1(2),ianclx1(3)) OPEN (UNIT=LUXANCL2,FILE=xancilfile2,FORM='UNFORMATTED' + ,STATUS='OLD') K = 1 32 continue c-lkh read (LUXANCL2,iostat=ios,end=900,err=900) B_REC1B call rdswap(LUXANCL2,B_REC1B,id_rec,*900) IF (REC1B(1).NE.485 .and. K .eq. 1) GO TO 32 CALL FNMOVE (DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K.LT.34) GO TO 32 close(LUXANCL2) CALL FNMOVE (XLOGI0X(1,1,1,1),5796*4,DATA(1,1)) c-H write (6,1123) c-H1123 format (1x,'CHKTBL1 second time') c-H call chktbl1 CALL CATTBL(ianclx2(1),ianclx2(2),ianclx2(3)) c-H call chktbl2 c-H call chktbl3 endif C C READ A PRIORI PROFILE INFORMATION C K = 1 50 continue c-lkh read (luanc,iostat=ios,end=900,err=900) B_REC1B call rdswap(luanc,B_REC1B,id_rec,*900) IF (REC1B(1).NE.495) GO TO 900 CALL FNMOVE (DATA(1,K),179*4,REC1B(2)) K = K + 1 IF (K .LT. 5) GO TO 50 C C LOAD A PRIORI PROFILE INFORMATION INTO /STPRO2/ C CALL FNMOVE (PROFN(1,1),650*4,DATA(1,1)) c c use northern climatology everywhere c do 60 iprf=1,23 do 55 ilev=1,11 profs(ilev,iprf) = profn(ilev,iprf) 55 continue 60 continue C c WRITE(4,70) PROFN, PROFS 70 FORMAT(/,20X,' NORTHERN A PRIORI PROFILE', 1 /,23(1P,11E12.3,/), 2 /,20X,' SOUTHERN A PRIORI PROFILE', 3 /,23(1P,11E12.3,/),0P) c WRITE (4,80) COV c WRITE (6,80) COV 80 FORMAT(/,20X,' COVARIANCE MATRIX ',/,12(12(1X,F9.4)/)) C C COMPUTE PLYRLG FOR 19 STANDARD PRESSURE LEVELS C DO 200 I=1,19 PLYRLG(I)=ALOG(PLYR(I)/1013.25) 200 CONTINUE C C COMPUTE VALUES FOR 92 STANDARD PRESSURE LEVELS C DPLOG=ALOG(TW)/SV PRQ(1)=PRTVAL DPRQ(1)=PRTVAL PRQLG(1)=ALOG(PRTVAL) DO 300 I=2,92 PRQLG(I)=PRQLG(I-1)+DPLOG PRQ(I)=EXP(PRQLG(I)) DPRQ(I)=PRQ(I)-PRQ(I-1) 300 CONTINUE C C COMPUTE VALUES FOR 12 STANDARD PRESSURE LEVELS, USING RESULTS C FOR 92 STANDARD PRESSURE LEVELS C DO 330 I=1,11 J=7*I+1 PRT(I)=PRQ(J) PRTLG(I)=PRQLG(J) 330 CONTINUE PRT(12)=1.00E0 PRTLG(12)=ALOG(PRT(12)) C C EVALUATE CONSTRAINT PROFILE COVARIANCE MATRIX C DO 800 I=1,12 DO 800 J=1,12 SXCTR(I,J)=COV(I,J) 800 CONTINUE C if(iopts(15)) rewind(luanc) C RETURN 900 WRITE (6,999) 999 FORMAT(//,' ***-ERROR-(ANCLV6)-*** - ERROR IN READING ANCILLARY', 1 ' DATA',/) RETURN C 910 WRITE (6,919) 919 FORMAT(//,' ***-ERROR-(ANCLV6)-*** - RECORD IDS DID NOT MATCH', 1 ' OR BAD ANCILLARY DATA.') RETURN C END