var/da/da_biascorr_airmass/da_bias_sele.f90

   1   PROGRAM da_bias_sele
   2
   3   USE RAD_BIAS, only : bias, print_bias, da_read_biasprep, &
   4      da_write_biasprep
   5
   6 ! PURPOSE.
   7 ! --------
   8 !   BIASSELE - TO PERFORM BASIC DATA SELETION FOR BIAS CORRECTION PROGRAMS.
   9 !
  10
  11   IMPLICIT NONE
  12
  13   TYPE(BIAS)   :: tovs
  14
  15   INTEGER :: ntotal, ngood,nreject(5)
  16
  17 ! definition of defaut namelist values
  18 !--------------------------------------
  19   INTEGER :: platform_id, satellite_id, sensor_id
  20   INTEGER :: isurf,nscan,ierr
  21
  22   NAMELIST /INPUTS/ platform_id, satellite_id, sensor_id, &
  23                     nscan,isurf            ! ISURF=1 : sea only
  24                                            ! ISURF=2 : land + sea
  25                                            ! ISURF=3 : land only
  26
  27 !  1. read and print namelist
  28
  29   READ(5,INPUTS,END=100)
  30   100  CONTINUE
  31   WRITE(6,INPUTS)
  32
  33   OPEN(UNIT=10,FORM='unformatted')                  ! Open input file
  34   OPEN(UNIT=11,FORM='unformatted')                  ! Open output file
  35
  36   READ(UNIT=10,END=990)  tovs%nchan, tovs%npred    ! Read in data
  37   REWIND(UNIT=10)
  38
  39   allocate(tovs%tb(tovs%nchan))
  40   allocate(tovs%omb(tovs%nchan))
  41   allocate(tovs%bias(tovs%nchan))
  42   allocate(tovs%qc_flag(tovs%nchan))
  43   allocate(tovs%cloud_flag(tovs%nchan))
  44   allocate(tovs%pred(tovs%npred))
  45
  46   ntotal  = 0
  47   ngood   = 0
  48   nreject = 0
  49
  50 readloop:&
  51   DO
  52
  53     call da_read_biasprep(tovs,10,ierr)
  54     if (ierr == 0) then      ! not end
  55          continue
  56     elseif (ierr == 1) then  ! end
  57          exit
  58     else                     ! error
  59          stop 'read error in da_bias_sele'
  60     endif
  61
  62     ntotal = ntotal + 1
  63     IF ( mod(ntotal,500) == 0 ) THEN
  64       CALL PRINT_BIAS(tovs)
  65     ENDIF
  66
  67 ! QC for whole pixel point
  68 !-----------------------------
  69 !  2.1  wrong satellite test
  70 !-----------------------------
  71     IF (tovs%platform_id /= platform_id .or.  &
  72         tovs%satellite_id /= satellite_id .or. &
  73         tovs%sensor_id /= sensor_id ) THEN
  74       nreject(1) = nreject(1) + 1
  75       CYCLE readloop
  76     ENDIF
  77
  78 !--------------------------------------------------------
  79 !  2.2 wrong scan position
  80 !--------------------------------------------------------
  81      IF ( tovs%scanpos<1 .or. tovs%scanpos>nscan ) THEN
  82        nreject(2) = nreject(2) + 1
  83        CYCLE readloop
  84      ENDIF
  85
  86 !---------------------------------
  87 ! 2.3 land,sea,height test
  88 !---------------------------------
  89       IF ( ((tovs%landmask == 0) .AND. &     ! over land
  90            ((isurf == 1) .OR. (tovs%elevation > 2000.0))) .OR. & ! reject land (ISURF=1, only sea) or above 2km
  91            ((tovs%landmask == 1) .AND. (isurf == 3)) ) THEN      ! reject sea  (ISURF=3, only land)
  92         nreject(3) = nreject(3) + 1
  93         CYCLE readloop
  94       ENDIF
  95
  96 !------------------------
  97 ! 2.4 cloud/rain check
  98 !------------------------
  99       IF ( any (tovs%cloud_flag /= 1) )  THEN
 100         nreject(4) = nreject(4) + 1
 101         CYCLE readloop
 102       ENDIF
 103
 104 !-----------------------------------------------
 105 ! 2.5 surf_flag check (reject mixture surface)
 106 !-----------------------------------------------
 107       IF ( (tovs%surf_flag >= 4) )  THEN
 108         nreject(5) = nreject(5) + 1
 109         CYCLE readloop
 110       ENDIF
 111
 112     ngood = ngood + 1                      !! total obs number
 113
 114     call da_write_biasprep(tovs,11)
 115
 116   ENDDO readloop
 117
 118   990 continue
 119
 120   CLOSE(UNIT=10)
 121   CLOSE(UNIT=11)
 122
 123    deallocate(tovs%tb)
 124    deallocate(tovs%omb)
 125    deallocate(tovs%bias)
 126    deallocate(tovs%qc_flag)
 127    deallocate(tovs%cloud_flag)
 128    deallocate(tovs%pred)
 129
 130    write(6,'(a,i10)') ' INPUT NUMBER OF OBS :', ntotal
 131    write(6,'(a,i10)') 'OUTPUT NUMBER OF OBS :', ngood
 132    write(6,'(a)')     'Rejected OBS by Cheching '
 133    write(6,'(a)')     'SENSOR_ID SCANPOS  SURFACE/HEIGHT  CLOUD/RAIN  SURF_FLAG'
 134    write(6,'(5i10)')  nreject
 135
 136   END PROGRAM da_bias_sele