c==== c==== This file contains the following subroutines, which are used together c==== to manage the loading of the instrument data common block. c==== c==== ld_instdata -- driver for loading instrument data c==== finstfile -- determine the name of the appropriate instrument data file c==== ld_instset -- load the actual instrument data file into common. c==== c==== Instrument data common block /instdata/ defined in file instdata.cmn . SUBROUTINE ld_instdata(sat_2lc, yyyydoy, instdir, success) IMPLICIT NONE CHARACTER*(*) sat_2lc, yyyydoy, instdir LOGICAL success INCLUDE 'instdata.cmn' CHARACTER*80 instfile CHARACTER*2 sc1, sc2 INTEGER*1 sc1i(2), sc2i(2) EQUIVALENCE(sc1,sc1i), (sc2,sc2i) c--Convert satellite codes to all uppercase, so they can be compared. sc1= sat_2lc(1:2) sc2= i_2lc IF((97.LE.sc1i(1)).AND.(sc1i(1).LE.122))sc1i(1)=sc1i(1)-32 IF((97.LE.sc1i(2)).AND.(sc1i(2).LE.122))sc1i(2)=sc1i(2)-32 IF((97.LE.sc2i(1)).AND.(sc2i(1).LE.122))sc2i(1)=sc2i(1)-32 IF((97.LE.sc2i(2)).AND.(sc2i(2).LE.122))sc2i(2)=sc2i(2)-32 c--Check if (a) we're on a different satellite, or (b) nothing's been c loaded yet IF(sc1 .NE. sc2) THEN d write(6,*)'sc1: ', sc1,' sc2:', sc2, ' sat_2lc: ',sat_2lc, d & ' yyyydoy: ',yyyydoy CALL finstfile(sat_2lc, yyyydoy, instdir, instfile, success) IF (.NOT.success) RETURN d write(6,*)'inst. file is ',instfile CALL ld_instset(instdir, instfile, success) RETURN ENDIF c--Check if our date is still in the range of the data set that's in common. success= .TRUE. IF((i_validfrom .LE. yyyydoy(1:7)) .AND. & (yyyydoy(1:7) .LE. i_validto) ) RETURN c--We get here if we have to reload the data from a different file. CALL finstfile(sat_2lc, yyyydoy, instdir, instfile, success) IF (.NOT.success) RETURN instfile= instfile CALL ld_instset(instdir, instfile, success) RETURN END SUBROUTINE finstfile(sat_2lc, yyyydoy, instdir, instfile, & success) IMPLICIT NONE CHARACTER*(*) sat_2lc, yyyydoy, instdir, instfile LOGICAL success INTEGER*4 lun, instdir_l, str_text_len CHARACTER*2 s2lc, s2lcf INTEGER*1 s2lci(2) EQUIVALENCE(s2lc,s2lci) CHARACTER*80 fname CHARACTER*7 vf, vt CALL get_lun(lun) instdir_l= str_text_len(instdir) d write(6,*) instdir, instdir_l OPEN(UNIT=lun, & FILE=instdir(1:instdir_l)//'/'//'inst.index', & FORM='formatted',STATUS='old', & ERR=901) c-- Convert any lower-case characters in 2-letter code to upper-case s2lc= sat_2lc(1:2) IF((97.LE.s2lci(1)).AND.(s2lci(1).LE.122))s2lci(1)=s2lci(1)-32 IF((97.LE.s2lci(2)).AND.(s2lci(2).LE.122))s2lci(2)=s2lci(2)-32 c-- Find the right record in the file 100 READ(lun,2,END=902,ERR=903) s2lcf, vf, vt, fname IF( (s2lc .NE. s2lcf) .OR. & (yyyydoy .LT. vf) .OR. & (yyyydoy .GT. vt) ) GOTO 100 instfile= fname success= .TRUE. GOTO 200 200 CONTINUE CLOSE(lun) CALL unget_lun(lun) RETURN 901 WRITE(6,*) '!!! Subroutine finstfile could not open the index'// & ' file, inst.index' STOP 902 success= .FALSE. GOTO 200 903 WRITE(6,*) '!!! Read error while reading the file, inst.index' STOP 2 FORMAT(A2,2X,A7,1X,A7,1X,A) END SUBROUTINE ld_instset (instdir, instfile, success) IMPLICIT NONE CHARACTER*(*) instdir, instfile LOGICAL success INCLUDE 'instdata.cmn' INTEGER*4 lun, i, j, k, instdir_l, str_text_len CHARACTER*4 dum CALL get_lun(lun) instdir_l= str_text_len(instdir) OPEN(UNIT=lun, & FILE=instdir(1:instdir_l)//'/'//instfile, & FORM='FORMATTED', & STATUS='OLD', & ERR=901, & READONLY) READ(lun,1,ERR=902,END=903) i_satname READ(lun,1,ERR=902,END=903) i_satnote READ(lun,2,ERR=902,END=903) i_2lc, i_3lc READ(lun,3,ERR=902,END=903) i_validfrom, i_validto READ(lun,*,ERR=902,END=903) i_nscans READ(lun,*,ERR=902,END=903) i_meanalt READ(lun,*,ERR=902,END=903) i_inclin READ(lun,1,ERR=902,END=903) i_useleg READ(lun,*,ERR=902,END=903) (i_nomwvl(j),j=1,6) READ(lun,*,ERR=902,END=903) (i_wvl(j), j=1,6) READ(lun,*,ERR=902,END=903) (i_o3abs(j),j=1,6) READ(lun,*,ERR=902,END=903) (i_so2abs(j),j=1,6) READ(lun,*,ERR=902,END=903) (i_ramcor(j,1),j=1,6) READ(lun,*,ERR=902,END=903) (i_ramcor(j,2),j=1,6) READ(lun,1,ERR=902,END=903) dum READ(lun,4,ERR=902,END=903) (i_fov(j),j=1,37) READ(lun,1,ERR=902,END=903) dum READ(lun,4,ERR=902,END=903) (i_dlat(j),j=1,37) READ(lun,1,ERR=902,END=903) dum READ(lun,4,ERR=902,END=903) (i_dlon(j),j=1,37) READ(lun,1,ERR=902,END=903) dum READ(lun,4,ERR=902,END=903) (i_satza(j),j=1,37) READ(lun,1,ERR=902,END=903) dum READ(lun,5,ERR=902,END=903) (((i_fovcorn(i,j,k),i=1,2),j=1,4), & k=1,37) CLOSE(lun) CALL unget_lun(lun) success= .TRUE. RETURN 901 CONTINUE WRITE(6,*)'Could not open the instrument data file' success= .FALSE. RETURN 902 CONTINUE WRITE(6,*)'Error reading the instrument data file' success= .FALSE. RETURN 903 CONTINUE WRITE(6,*)'Unexpected end of file while reading instrument '// & 'data file' success= .FALSE. RETURN 1 FORMAT(A) 2 FORMAT(A2,1X,A3) 3 FORMAT(A7,1X,A7) 4 FORMAT(7(5(F10)/),2F10) 5 FORMAT(4(1X,F6.1,3X,F6.1,3X)) END