[Dart-dev] [3422] DART/trunk/ncep_obs: Most important file change is the prepbufr input.nml; it now matches

nancy at ucar.edu nancy at ucar.edu
Wed Jun 4 17:00:34 MDT 2008


An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20080604/4aefe9c7/attachment-0001.html
-------------- next part --------------
Modified: DART/trunk/ncep_obs/create_real_obs.nml
===================================================================
--- DART/trunk/ncep_obs/create_real_obs.nml	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/create_real_obs.nml	2008-06-04 23:00:33 UTC (rev 3422)
@@ -21,6 +21,6 @@
    daily_file = .true.,
    lon1   =   0.0,
    lon2   = 360.0,
-   lat1   = -89.0,
-   lat2   =  89.0  /
+   lat1   = -90.0,
+   lat2   =  90.0  /
 

Modified: DART/trunk/ncep_obs/prep_bufr/src/prepbufr.f
===================================================================
--- DART/trunk/ncep_obs/prep_bufr/src/prepbufr.f	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/prep_bufr/src/prepbufr.f	2008-06-04 23:00:33 UTC (rev 3422)
@@ -7,6 +7,19 @@
 c    For Aircraft T: No moistuerobs and all T are dry T
 c    For Surface obs, the T of pc=1 is already virtual T.
 c
+c    I tried to remove the code in the READPB() routine which selects
+c    obs based on the string name, since we have a namelist control for
+c    the numeric observation report type (which identifies specific
+c    satellites and data sources, and can be matched to the obs used
+c    in NCEP assimilations).  But when I tried to run that way, I got
+c    a read error from the original BUFR file.  My guess is that some
+c    of the records (SATBOG or SFCBOG in particular) have some different
+c    requirements for reading that I do not understand yet.
+c    Assuming the string name allows the obs to be read, then the
+c    record types that will be output are now set by namelist.
+c    See the prepdecode/docs directory for the key to all the bufr codes.
+c
+c
       REAL*8     R8BFMS
       PARAMETER ( R8BFMS = 10.0E10 )
 C                                      "Missing" value for BUFR data
@@ -48,11 +61,13 @@
 
       dimension tdata(8), udata(8), vdata(8), qdata(8), pdata(8)
       integer :: wtype, ptype, qtype, ttype
-c     what are the pc_x values?
+c    The pc values are the 'program codes' that tell you what processing
+c    was done on this observation.  As of now, these are unused, but could
+c    be used for selection or diagnosis.
       integer :: pc_t, pc_q, pc_u, pc_v, pc_p 
       integer :: tqm, pqm, qqm, uqm, vqm, qctype_use(max_otype)
       logical :: found, uotype, uqcflag, use_this_data_real, 
-     +            use_this_data_int
+     +           use_this_data_int, processed
       logical :: debug = .false.
 
 c    Namelist Parameters
@@ -60,10 +75,10 @@
 
       real :: otype_use(max_otype),    ! report types to use
      +        obs_window = 0.8,        ! observation time window (hours)
-     +        obs_window_cw = 1.5,     ! cloud wind observation time window (hours)
-     +        land_temp_error = 2.5,   ! assumed error for surface temp. observations (K)
-     +        land_wind_error = 3.5,   ! assumed error for surface wind observations (m/s)
-     +        land_moist_error = 0.2   ! assumed error for surface moist. observations (%)
+     +        obs_window_cw = 1.5,     ! cloud wind obs time window (hours)
+     +        land_temp_error = 2.5,   ! assumed err surface temp. obs (K)
+     +        land_wind_error = 3.5,   ! assumed err surface wind obs (m/s)
+     +        land_moist_error = 0.2   ! assumed err surface moist. obs (%)
 
       namelist /prep_bufr_nml/ obs_window,
      +                         obs_window_cw,
@@ -101,13 +116,13 @@
 
       inum_otype=0
       do i = 1, max_otype
-      if ( otype_use(i) .eq. MISSING ) exit
+        if ( otype_use(i) .eq. MISSING ) exit
         inum_otype = inum_otype + 1
       enddo
 
       inum_qctype=0
       do i = 1, max_qctype
-      if ( qctype_use(i) .eq. MISSING ) exit
+        if ( qctype_use(i) .eq. MISSING ) exit
         inum_qctype = inum_qctype + 1
       enddo
 
@@ -128,6 +143,8 @@
 
 10    CALL READPB  ( ibufr_unit, subset, idate, ierrpb )
  
+      if ( debug ) print *, 'next obs type: ', subset(1:6)
+
       idate00 = idate/100
       hour01 = idate - idate00*100
       if( hour01 .eq. 0.0 ) hour01 = 24
@@ -176,13 +193,28 @@
       END DO
 
 c    check the observation time, skip if outside obs. window
+c    THE ONLY DIFFERENCE BETWEEN THE 03Z VERSION AND THE ORIGINAL
+c    IS THE TEST FOR hour01 .gt. obs_win (03Z file) vs 
+c    abs(time0) .gt. obs_win (plain version) in 4 (four) PLACES BELOW.
 c----------------------------------------------------------------------
-
-      IF ( ( .not. found ) .and. ( ierrpb .eq. 0 ) )  GO TO 10
+      IF ( ( .not. found ) .and. ( ierrpb .eq. 0 ) )  THEN
+        if ( debug ) print*, 'record found w/no label match, val was: ',
+     &            subset(1:6)
+        GO TO 10
+      ENDIF
       IF ( subset(1:6).eq.'SATWND' ) then
-        IF ( abs(time0) .gt. obs_window_cw ) GO TO 10
+        IF ( abs(time0) .gt. obs_window_cw ) then
+          if (debug) print*, 'satwnd outside time window, diff was: ',
+     &              abs(time0)
+          GO TO 10
+        ENDIF 
       ELSE
-        IF ( abs(time0) .gt. obs_window ) GO TO 10
+        IF ( abs(time0) .gt. obs_window ) THEN 
+         if ( debug ) print*, 
+     &              'non-satwind outside time window, diff was: ',
+     &              abs(time0)
+          GO TO 10
+        ENDIF
       END IF
 
 c    place the location data in the appropriate array
@@ -238,9 +270,12 @@
 
 c    check to see if this observation type is desired 
       if ( .NOT. USE_THIS_DATA_REAL(real(hdr(6)),otype_use,inum_otype) 
-     &         ) GO TO 10
+     &         ) then
+        if ( debug ) print *, 'this obs type not in use-list, num was: ', hdr(6)
+        GO TO 10
+      endif
 
-      DO 200 lv = 1, nlev  !  loop over all levels in the report
+      DO lv = 1, nlev  !  loop over all levels in the report
 
 c    find out the event before virtural T and Q check step (pc=8.0)
 c----------------------------------------------------------------------
@@ -287,8 +322,11 @@
             IF  ( outstg (mm:mm) .eq. '*' ) outstg (mm:mm) = ' '
           END DO
 
+          if (debug) write(iuno, '(A)') trim(outstg)
         END DO
 
+        processed = .false. 
+
 c    set up the temperature observation data, use the j2t event or 1 if T
 c----------------------------------------------------------------------
         if(subset(1:6).eq.'ADPUPA' .or. subset(1:6).eq.'ADPSFC' .or.
@@ -380,7 +418,11 @@
 c    i feel ok setting it to something that will fit in an I2 field.
             if (pc_t > 99) pc_t = 99
             write(lunobs, 800) tdata, ttype, tqm, subset(1:6), pc_t
+            processed = .true.
 
+          else
+            if ( debug ) print *, 'skip temp, toe,tob,tqm,pqm = ',
+     &           toe, tob, tqm, pqm
           endif
         endif
 
@@ -403,9 +445,12 @@
 
             if (pc_t > 99) pc_t = 99
             write(lunobs, 800) tdata, ttype, tqm, subset(1:6), pc_t
+            processed = .true.
 
-          endif
-   
+           else
+             if ( debug ) print *, 'skip temp; tob,tqm,pqm = ',
+     &        tob, tqm, pqm
+           endif
         endif
 
 c    write out moisture observation from ADPUPA
@@ -426,7 +471,7 @@
             if ( debug ) print*, 'es= ', es, tob-273.16, qoe
 
             if( .not. use_this_data_int(tqm,qctype_use,inum_qctype))then
-              print*, 'upa bad = ', qoe  ! the T obs cannot be used for qoe
+              if ( debug ) print*, 'upa bad = ', qoe  ! the T obs cannot be used for qoe
               qoe = 1.0e10
             endif
 
@@ -437,10 +482,14 @@
             if (qoe .lt. 9.9) then  ! skip large qoe obs.
               if (pc_q > 99) pc_q = 99
               write(lunobs, 800) qdata, qtype, qqm, subset(1:6), pc_q
+              processed = .true.
+            else
+               if ( debug ) print *, 'skip moist, qoe,qob,qqm,pqm = ',
+     &          qoe, qpb, qqm, pqm
             endif
 
           endif
-
+  
         endif
 
 c    write out moisture observation from SFCSHP ADPSFC
@@ -457,7 +506,8 @@
             qoe  = max(0.1, qoe * qsat * 1000.0) ! to g/kg, set min value
 
            if( .not. use_this_data_int(tqm,qctype_use,inum_qctype)) then
-             print*, 'surface bad = ', qoe  ! the T obs cannot be used for qoe
+             if ( debug ) print*, 'surface bad = ', qoe  
+c             ! the T obs cannot be used for qoe
              qoe = 1.0e10
            endif
 
@@ -471,8 +521,12 @@
            if(qoe .lt. 9.9) then   ! skip large qoe obs
              if (pc_q > 99) pc_q = 99
              write(lunobs, 800) qdata, qtype, qqm, subset(1:6), pc_q
+             processed = .true.
            endif
 
+          else
+               if ( debug ) print *, 'skip moist, qob,qqm,pqm = ',
+     &          qob, qqm, pqm
           endif
       
         endif
@@ -495,7 +549,11 @@
 
             if (pc_p > 99) pc_p = 99
             write(lunobs, 800) pdata, ptype, pqm, subset(1:6), pc_p
-
+            processed = .true.
+    
+           else
+             if ( debug ) print *, 'skip press, poe,pob,pqm,z,s = ',
+     &          poe, pob, pqm, zob, stat_elev
           endif
 
         endif
@@ -524,7 +582,11 @@
             if (pc_v > 99) pc_v = 99
             write(lunobs, 800) udata, wtype, uqm, subset(1:6), pc_u
             write(lunobs, 800) vdata, wtype, vqm, subset(1:6), pc_v
+            processed = .true.
 
+          else
+             if ( debug ) print *, 'skip wind, uoe,uob,uqm,pqm = ',
+     &          uoe, uob, uqm, pqm
           endif
   
         endif
@@ -554,13 +616,24 @@
             if (pc_v > 99) pc_v = 99
             write(lunobs, 800) udata, wtype, uqm, subset(1:6), pc_u
             write(lunobs, 800) vdata, wtype, vqm, subset(1:6), pc_v
+            processed = .true.
 
+          else
+             if ( debug ) print *, 'skip wind, uob,uqm,pqm = ',
+     &          uob, uqm, pqm
           endif
 
         endif
 
-200   continue
+c----------------------------------------------------------------------
+       if (.not. processed) then
+         if (debug)print*, 'bot of loop w/o processing, obs was: ',
+     &              subset(1:6), ' lv =', lv
+       endif
 
+      enddo 
+200    continue
+
       IF ( ierrpb .eq. 0 )  GO TO 10
 
 800   format(f4.2,2f9.4,e12.5,f7.2,f7.2,f9.0,f7.3,i4,i2,1x,a6,i2)
@@ -632,9 +705,9 @@
         SAVE            match, subst2, idate2
 C-----------------------------------------------------------------------
 
-cliu
+Cnsc
  1000   continue
-cliu
+Cnsc
 
         iret = 0
 C
@@ -655,14 +728,15 @@
      &    subset .ne. 'SATWND' .and. subset .ne. 'AIRCFT' .and. 
      &    subset .ne. 'ADPSFC' .and. subset .ne. 'SFCSHP') go to 1000
 cliu
+
         ELSE
             subset = subst2
             idate = idate2
         END IF
-C*
-C*      Read the HDR and EVNS data for the subset that is currently
-C*      being pointed to.
-C*
+C
+C      Read the HDR and EVNS data for the subset that is currently
+C      being pointed to.
+C
         CALL UFBINT  ( lunit, hdr, MXR8PM, 1, jret, head )
         DO ii = 1, MXR8VT
           CALL UFBEVN ( lunit, evns ( 1, 1, 1, ii ), MXR8PM, MXR8LV,
@@ -672,21 +746,22 @@
 C      Now, advance the subset pointer to the following subset and
 C      read its HDR data.
 C
-cliu
+Cnsc
  2000   continue
-cliu
+Cnsc
         CALL READNS  ( lunit, subst2, idate2, jret )
         IF  ( jret .ne. 0 )  THEN
             iret = 1
             RETURN
         END IF
-
+C
 cliu   select data type
        if(subst2.ne. 'ADPUPA' .and. subst2.ne. 'AIRCAR' .and. 
      &    subst2.ne. 'SATWND' .and. subst2.ne. 'AIRCFT' .and.
      &    subst2.ne. 'ADPSFC' .and. subst2.ne. 'SFCSHP') go to 2000
 c        ! careful about 2000
 cliu
+
         CALL UFBINT  ( lunit, hdr2, MXR8PM, 1, jret, head )
 C 
 C      Check whether these two subsets have identical SID, YOB, XOB,

Modified: DART/trunk/ncep_obs/prep_bufr/src/prepbufr_03Z.f
===================================================================
--- DART/trunk/ncep_obs/prep_bufr/src/prepbufr_03Z.f	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/prep_bufr/src/prepbufr_03Z.f	2008-06-04 23:00:33 UTC (rev 3422)
@@ -7,6 +7,19 @@
 c    For Aircraft T: No moistuerobs and all T are dry T
 c    For Surface obs, the T of pc=1 is already virtual T.
 c
+c    I tried to remove the code in the READPB() routine which selects
+c    obs based on the string name, since we have a namelist control for
+c    the numeric observation report type (which identifies specific
+c    satellites and data sources, and can be matched to the obs used
+c    in NCEP assimilations).  But when I tried to run that way, I got
+c    a read error from the original BUFR file.  My guess is that some
+c    of the records (SATBOG or SFCBOG in particular) have some different
+c    requirements for reading that I do not understand yet.
+c    Assuming the string name allows the obs to be read, then the
+c    record types that will be output are now set by namelist.
+c    See the prepdecode/docs directory for the key to all the bufr codes.
+c
+c
       REAL*8     R8BFMS
       PARAMETER ( R8BFMS = 10.0E10 )
 C                                      "Missing" value for BUFR data
@@ -48,10 +61,13 @@
 
       dimension tdata(8), udata(8), vdata(8), qdata(8), pdata(8)
       integer :: wtype, ptype, qtype, ttype
-      integer :: pc_t, pc_q, pc_u, pc_v, pc_p
+c    The pc values are the 'program codes' that tell you what processing
+c    was done on this observation.  As of now, these are unused, but could
+c    be used for selection or diagnosis.
+      integer :: pc_t, pc_q, pc_u, pc_v, pc_p 
       integer :: tqm, pqm, qqm, uqm, vqm, qctype_use(max_otype)
       logical :: found, uotype, uqcflag, use_this_data_real, 
-     +            use_this_data_int
+     +           use_this_data_int, processed
       logical :: debug = .false.
 
 c    Namelist Parameters
@@ -59,10 +75,10 @@
 
       real :: otype_use(max_otype),    ! report types to use
      +        obs_window = 0.8,        ! observation time window (hours)
-     +        obs_window_cw = 1.5,     ! cloud wind observation time window (hours)
-     +        land_temp_error = 2.5,   ! assumed error for surface temp. observations (K)
-     +        land_wind_error = 3.5,   ! assumed error for surface wind observations (m/s)
-     +        land_moist_error = 0.2   ! assumed error for surface moist. observations (%)
+     +        obs_window_cw = 1.5,     ! cloud wind obs time window (hours)
+     +        land_temp_error = 2.5,   ! assumed err surface temp. obs (K)
+     +        land_wind_error = 3.5,   ! assumed err surface wind obs (m/s)
+     +        land_moist_error = 0.2   ! assumed err surface moist. obs (%)
 
       namelist /prep_bufr_nml/ obs_window,
      +                         obs_window_cw,
@@ -100,13 +116,13 @@
 
       inum_otype=0
       do i = 1, max_otype
-      if ( otype_use(i) .eq. MISSING ) exit
+        if ( otype_use(i) .eq. MISSING ) exit
         inum_otype = inum_otype + 1
       enddo
 
       inum_qctype=0
       do i = 1, max_qctype
-      if ( qctype_use(i) .eq. MISSING ) exit
+        if ( qctype_use(i) .eq. MISSING ) exit
         inum_qctype = inum_qctype + 1
       enddo
 
@@ -127,6 +143,8 @@
 
 10    CALL READPB  ( ibufr_unit, subset, idate, ierrpb )
  
+      if ( debug ) print *, 'next obs type: ', subset(1:6)
+
       idate00 = idate/100
       hour01 = idate - idate00*100
       if( hour01 .eq. 0.0 ) hour01 = 24
@@ -175,13 +193,28 @@
       END DO
 
 c    check the observation time, skip if outside obs. window
+c    THE ONLY DIFFERENCE BETWEEN THE 03Z VERSION AND THE ORIGINAL
+c    IS THE TEST FOR hour01 .gt. obs_win (03Z file) vs 
+c    abs(time0) .gt. obs_win (plain version) in 4 (four) PLACES BELOW.
 c----------------------------------------------------------------------
-
-      IF ( ( .not. found ) .and. ( ierrpb .eq. 0 ) )  GO TO 10
+      IF ( ( .not. found ) .and. ( ierrpb .eq. 0 ) )  THEN
+        if ( debug ) print*, 'record found w/no label match, val was: ',
+     &            subset(1:6)
+        GO TO 10
+      ENDIF
       IF ( subset(1:6).eq.'SATWND' ) then
-        IF ( hour01 .gt. obs_window_cw ) GO TO 10
+        IF ( hour01 .gt. obs_window_cw ) then
+          if (debug) print*, 'satwnd outside time window, diff was: ',
+     &              hour01
+          GO TO 10
+        ENDIF 
       ELSE
-        IF ( hour01 .gt. obs_window ) GO TO 10
+        IF ( hour01 .gt. obs_window ) THEN 
+         if ( debug ) print*, 
+     &              'non-satwind outside time window, diff was: ',
+     &              hour01
+          GO TO 10
+        ENDIF
       END IF
 
 c    place the location data in the appropriate array
@@ -237,9 +270,12 @@
 
 c    check to see if this observation type is desired 
       if ( .NOT. USE_THIS_DATA_REAL(real(hdr(6)),otype_use,inum_otype) 
-     &         ) GO TO 10
+     &         ) then
+        if ( debug ) print *, 'this obs type not in use-list, num was: ', hdr(6)
+        GO TO 10
+      endif
 
-      DO 200 lv = 1, nlev  !  loop over all levels in the report
+      DO lv = 1, nlev  !  loop over all levels in the report
 
 c    find out the event before virtural T and Q check step (pc=8.0)
 c----------------------------------------------------------------------
@@ -286,8 +322,11 @@
             IF  ( outstg (mm:mm) .eq. '*' ) outstg (mm:mm) = ' '
           END DO
 
+          if (debug) write(iuno, '(A)') trim(outstg)
         END DO
 
+        processed = .false. 
+
 c    set up the temperature observation data, use the j2t event or 1 if T
 c----------------------------------------------------------------------
         if(subset(1:6).eq.'ADPUPA' .or. subset(1:6).eq.'ADPSFC' .or.
@@ -374,10 +413,16 @@
             tdata(4) = ppb
             tdata(5) = tob
 
-c    see comment in prepbufr.f
+c    in some old files this appears to be out of range
+c    and it seems to be unused in converting to an obs_seq so
+c    i feel ok setting it to something that will fit in an I2 field.
             if (pc_t > 99) pc_t = 99
             write(lunobs, 800) tdata, ttype, tqm, subset(1:6), pc_t
+            processed = .true.
 
+          else
+            if ( debug ) print *, 'skip temp, toe,tob,tqm,pqm = ',
+     &           toe, tob, tqm, pqm
           endif
         endif
 
@@ -400,9 +445,12 @@
 
             if (pc_t > 99) pc_t = 99
             write(lunobs, 800) tdata, ttype, tqm, subset(1:6), pc_t
+            processed = .true.
 
-          endif
-   
+           else
+             if ( debug ) print *, 'skip temp; tob,tqm,pqm = ',
+     &        tob, tqm, pqm
+           endif
         endif
 
 c    write out moisture observation from ADPUPA
@@ -423,7 +471,7 @@
             if ( debug ) print*, 'es= ', es, tob-273.16, qoe
 
             if( .not. use_this_data_int(tqm,qctype_use,inum_qctype))then
-              print*, 'upa bad = ', qoe  ! the T obs cannot be used for qoe
+              if ( debug ) print*, 'upa bad = ', qoe  ! the T obs cannot be used for qoe
               qoe = 1.0e10
             endif
 
@@ -434,10 +482,14 @@
             if (qoe .lt. 9.9) then  ! skip large qoe obs.
               if (pc_q > 99) pc_q = 99
               write(lunobs, 800) qdata, qtype, qqm, subset(1:6), pc_q
+              processed = .true.
+            else
+               if ( debug ) print *, 'skip moist, qoe,qob,qqm,pqm = ',
+     &          qoe, qpb, qqm, pqm
             endif
 
           endif
-
+  
         endif
 
 c    write out moisture observation from SFCSHP ADPSFC
@@ -454,7 +506,8 @@
             qoe  = max(0.1, qoe * qsat * 1000.0) ! to g/kg, set min value
 
            if( .not. use_this_data_int(tqm,qctype_use,inum_qctype)) then
-             print*, 'surface bad = ', qoe  ! the T obs cannot be used for qoe
+             if ( debug ) print*, 'surface bad = ', qoe  
+c             ! the T obs cannot be used for qoe
              qoe = 1.0e10
            endif
 
@@ -468,8 +521,12 @@
            if(qoe .lt. 9.9) then   ! skip large qoe obs
              if (pc_q > 99) pc_q = 99
              write(lunobs, 800) qdata, qtype, qqm, subset(1:6), pc_q
+             processed = .true.
            endif
 
+          else
+               if ( debug ) print *, 'skip moist, qob,qqm,pqm = ',
+     &          qob, qqm, pqm
           endif
       
         endif
@@ -492,7 +549,11 @@
 
             if (pc_p > 99) pc_p = 99
             write(lunobs, 800) pdata, ptype, pqm, subset(1:6), pc_p
-
+            processed = .true.
+    
+           else
+             if ( debug ) print *, 'skip press, poe,pob,pqm,z,s = ',
+     &          poe, pob, pqm, zob, stat_elev
           endif
 
         endif
@@ -521,7 +582,11 @@
             if (pc_v > 99) pc_v = 99
             write(lunobs, 800) udata, wtype, uqm, subset(1:6), pc_u
             write(lunobs, 800) vdata, wtype, vqm, subset(1:6), pc_v
+            processed = .true.
 
+          else
+             if ( debug ) print *, 'skip wind, uoe,uob,uqm,pqm = ',
+     &          uoe, uob, uqm, pqm
           endif
   
         endif
@@ -551,13 +616,24 @@
             if (pc_v > 99) pc_v = 99
             write(lunobs, 800) udata, wtype, uqm, subset(1:6), pc_u
             write(lunobs, 800) vdata, wtype, vqm, subset(1:6), pc_v
+            processed = .true.
 
+          else
+             if ( debug ) print *, 'skip wind, uob,uqm,pqm = ',
+     &          uob, uqm, pqm
           endif
 
         endif
 
-200   continue
+c----------------------------------------------------------------------
+       if (.not. processed) then
+         if (debug)print*, 'bot of loop w/o processing, obs was: ',
+     &              subset(1:6), ' lv =', lv
+       endif
 
+      enddo 
+200    continue
+
       IF ( ierrpb .eq. 0 )  GO TO 10
 
 800   format(f4.2,2f9.4,e12.5,f7.2,f7.2,f9.0,f7.3,i4,i2,1x,a6,i2)
@@ -629,9 +705,9 @@
         SAVE            match, subst2, idate2
 C-----------------------------------------------------------------------
 
-cliu
+Cnsc
  1000   continue
-cliu
+Cnsc
 
         iret = 0
 C
@@ -652,14 +728,15 @@
      &    subset .ne. 'SATWND' .and. subset .ne. 'AIRCFT' .and. 
      &    subset .ne. 'ADPSFC' .and. subset .ne. 'SFCSHP') go to 1000
 cliu
+
         ELSE
             subset = subst2
             idate = idate2
         END IF
-C*
-C*      Read the HDR and EVNS data for the subset that is currently
-C*      being pointed to.
-C*
+C
+C      Read the HDR and EVNS data for the subset that is currently
+C      being pointed to.
+C
         CALL UFBINT  ( lunit, hdr, MXR8PM, 1, jret, head )
         DO ii = 1, MXR8VT
           CALL UFBEVN ( lunit, evns ( 1, 1, 1, ii ), MXR8PM, MXR8LV,
@@ -669,21 +746,22 @@
 C      Now, advance the subset pointer to the following subset and
 C      read its HDR data.
 C
-cliu
+Cnsc
  2000   continue
-cliu
+Cnsc
         CALL READNS  ( lunit, subst2, idate2, jret )
         IF  ( jret .ne. 0 )  THEN
             iret = 1
             RETURN
         END IF
-
+C
 cliu   select data type
        if(subst2.ne. 'ADPUPA' .and. subst2.ne. 'AIRCAR' .and. 
      &    subst2.ne. 'SATWND' .and. subst2.ne. 'AIRCFT' .and.
      &    subst2.ne. 'ADPSFC' .and. subst2.ne. 'SFCSHP') go to 2000
 c        ! careful about 2000
 cliu
+
         CALL UFBINT  ( lunit, hdr2, MXR8PM, 1, jret, head )
 C 
 C      Check whether these two subsets have identical SID, YOB, XOB,

Modified: DART/trunk/ncep_obs/prep_bufr/work/input.nml
===================================================================
--- DART/trunk/ncep_obs/prep_bufr/work/input.nml	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/prep_bufr/work/input.nml	2008-06-04 23:00:33 UTC (rev 3422)
@@ -1,8 +1,14 @@
 &prep_bufr_nml 
  obs_window     = 24.0,
- obs_window_cw  = 24.0,
- qctype_use     = 1, 2, 3, 4  /
+ obs_window_cw  = 24.0, 
+ otype_use      = 120.0, 130.0, 131.0, 132.0, 133.0, 180.0,
+                  181.0, 182.0, 220.0, 221.0, 230.0, 231.0,
+                  232.0, 233.0, 242.0, 243.0, 245.0, 246.0,
+                  252.0, 253.0, 255.0, 280.0, 281.0, 282.0,
+ qctype_use = 1,2,3,4,9,15
+ /
 
+
 ! the above are suggested settings.  the full set of
 ! namelist items (and defaults) are here:
 

Modified: DART/trunk/ncep_obs/prep_bufr/work/prepbufr.csh
===================================================================
--- DART/trunk/ncep_obs/prep_bufr/work/prepbufr.csh	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/prep_bufr/work/prepbufr.csh	2008-06-04 23:00:33 UTC (rev 3422)
@@ -25,9 +25,9 @@
 #BSUB -o prepbufr.out
 #BSUB -e prepbufr.err
 #BSUB -J prepbufr
-#BSUB -q share
-#BSUB -W 2:00
-#BSUB -P NNNNNNNN
+#BSUB -q regular
+#BSUB -W 1:00
+#BSUB -P XXXXXXXX
 #BSUB -n 1
 
 
@@ -41,39 +41,55 @@
 #--------------------------------------------------------------
 # USER SET PARAMETERS
 
-# set echo
+# if daily is 'yes', 4 6-hour files will be processed and a single, 1-day
+# output file will be created.  if daily is set to anything else, then
+# each 6-hour input file will be converted to a single 6-hour output file.
 
-# Convert from big-endian BUFR files to little-endian for Intel chip systems.
-# ('yes' or whatever)
 set    daily = yes
+
+# if convert is 'yes', then the big-endian BUFR files will be converted
+# to little-endian files before processing. this is needed if you are running
+# on a machine that uses Intel chips (e.g. linux clusters, altix, pcs, etc).
+# it is not needed for ibm power system.  any value other than 'yes' will
+# skip the convert step.
+
 set  convert = no 
-set     year = 1988
-set    month = 12
+
+# starting year, month, day, and ending day.  this script does not allow
+# you to do more than a single month at a time, but does handle the last
+# day of the month, leap day in feb, and the last day of the year correctly.
+# this version of the conversion tool takes up to 3 hours of observations
+# from the day *following* the end day, so you must have at least the 6Z
+# file from one day beyond the last day for this to finish ok.
+
+set year     = 1989
+set month    = 1
 set beginday = 1
-#
-# end day (up to and including the last day of the month.  
-#  Leap year Februaries are OK.
-#  Remember that the prepqm###### file for hour 0 of the first day of the next
-#  month is necessary for endday = last day of a month.)
-#
-set endday = 31
+set endday   = 7
 
-# Location of BUFR files (named prepqmYYYYMMDDHH)
-# are assumed to be in subdirectories named YYYYMM of the path listed here.
-# Those subdirectory names will be constructed below.
-set BUFR_dir = ../data/
-set get_year = $year
+# directory where the BUFR files are located.  the script assumes the
+# files will be located in subdirectories by month, with the names following
+# the pattern YYYYMM, and then inside the subdirectories, the files are
+# named by the pattern 'prepqmYYYYMMDDHH'.  for example, if the dir below
+# is the default ../data, then the 6Z file for jan 1st, 1989 would be:
+#  ../data/198901/prepqm1989010106
+# if the prepqm files do *not* follow this pattern, you may have to edit
+# the BUFR_file and BUFR_out variables below inside the loop of the script.
+# year is 4 digits; month, day, hour are 1 or 2 digits.  yy, mm, dd, hh are
+# all truncated or padded to be exactly 2 digits.
 
+set BUFR_dir = ../data
+
 # END USER SET PARAMETERS
 #--------------------------------------------------------------
 
 set days_in_mo = (31 28 31 30 31 30 31 31 30 31 30 31)
-# leap years - year 2000 makes this matter that you do the centuries right
+# leap years: year 2000 requires that you do even the centuries right
 if (($year %   4) == 0) @ days_in_mo[2] = $days_in_mo[2] + 1
 if (($year % 100) == 0) @ days_in_mo[2] = $days_in_mo[2] - 1
 if (($year % 400) == 0) @ days_in_mo[2] = $days_in_mo[2] + 1
 
-rm -f prepqm.out *.err *.out
+rm -f prepqm.out 
 
 # Loop over days
 
@@ -91,7 +107,6 @@
    set h = 0
    set next_day = not
    while ($h < 30)
-      echo ' '
       @ h  = $h + 6
       @ hh = $h % 24
       @ dd = $day + ($h / 24)
@@ -109,11 +124,11 @@
             @ mm++
             if ($mm > 12) then
                if ($mm > 12 && $hh == 0) then
-                 @ get_year ++
+                 @ year ++
                endif
                # next year
                set mm = 1
-               @ yy = $get_year % 100
+               @ yy = $year % 100
             endif
          endif
       endif
@@ -125,28 +140,29 @@
       if ($hh < 10) set hh = 0$hh
 
       # link(big endian) or make(little endian) input file 'prepqm' 
-      # for prepbufr.x
-      set BUFR_loc = ${BUFR_dir}/${get_year}${mm}
-      if (! -e ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh}) then
-         echo "MISSING FILE ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh} and aborting"
+      # for prepbufr.x.  if the pattern for the prepqm files is different,
+      # fix the BUFR_file below to match.
+      set BUFR_file = ${BUFR_dir}/${year}${mm}/prepqm${yy}${mm}${dd}${hh}
+      set BUFR_out  = ${BUFR_dir}/${year}${mm}/temp_obs.${year}${mm}${dd}
+      if (! -e ${BUFR_file}) then
+         echo "MISSING FILE ${BUFR_file} and aborting"
          exit
       endif
 
       if ($convert == 'yes') then
-         echo "copying bigendian to ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh}"
-         cp ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh} prepqm.bigendian
-         ls -l prepqm.bigendian
+         echo "converting ${BUFR_file} to littleendian prepqm.in"
+         cp -f ${BUFR_file} prepqm.bigendian
          ../exe/grabbufr.x prepqm.bigendian prepqm.littleendian
          mv prepqm.littleendian prepqm.in
          rm prepqm.bigendian
       else
-         echo "linking prepqm.in to ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh}"
-         ln -f ${BUFR_loc}/prepqm${yy}${mm}${dd}${hh} prepqm.in
+         echo "linking ${BUFR_file} to prepqm.in"
+         ln -f ${BUFR_file} prepqm.in
       endif
 
       if ($h == 30) then
-         # scavenge a few stragglers from 6Z of the next day 
-         # using a special prepbufr program
+         # get any obs between 0Z and 3Z from the 6Z file of the next day 
+         # using a slightly modified prepbufr program
          ../exe/prepbufr_03Z.x
       else
          ../exe/prepbufr.x
@@ -156,7 +172,8 @@
          cat prepqm.out >>! temp_obs
          rm prepqm.out
       else
-         mv -v prepqm.out ${BUFR_dir}/${year}${mm}/temp_obs.${year}${mm}${dd}${hh}
+         echo "moving output to ${BUFR_out}${hh}"
+         mv -v prepqm.out ${BUFR_out}${hh}
       endif
    end
 
@@ -166,8 +183,9 @@
 
       set mm = $month
       if ($mm < 10) set mm = 0$mm
-   
-      mv -v temp_obs   ${BUFR_dir}/${year}${mm}/temp_obs.${year}${mm}${dd}
+
+      echo "moving output to ${BUFR_out}"
+      mv -v temp_obs ${BUFR_out}
    endif
 
    @ day++

Modified: DART/trunk/ncep_obs/work/path_names_create_real_obs
===================================================================
--- DART/trunk/ncep_obs/work/path_names_create_real_obs	2008-06-03 22:38:15 UTC (rev 3421)
+++ DART/trunk/ncep_obs/work/path_names_create_real_obs	2008-06-04 23:00:33 UTC (rev 3422)
@@ -2,11 +2,10 @@
 ncep_obs/real_obs_mod.f90
 obs_sequence/obs_sequence_mod.f90
 obs_kind/obs_kind_mod.f90
-obs_def/obs_def_gps_mod.f90
-obs_def/obs_def_altimeter_mod.f90
 obs_def/obs_def_mod.f90
 assim_model/assim_model_mod.f90
-models/cam/model_mod.f90
+models/template/model_mod.f90
+cov_cutoff/cov_cutoff_mod.f90
 common/types_mod.f90
 location/threed_sphere/location_mod.f90
 random_seq/random_seq_mod.f90


More information about the Dart-dev mailing list