New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8667 for branches/2017/dev_r8657_UKMO_OBSoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90 – NEMO

Ignore:
Timestamp:
2017-10-30T10:28:45+01:00 (6 years ago)
Author:
timgraham
Message:

Update of OBS code from local v3.6 branch to head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8657_UKMO_OBSoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r6140 r8667  
    88   !!   obs_wri_prof   : Write profile observations in feedback format 
    99   !!   obs_wri_surf   : Write surface observations in feedback format 
    10    !!   obs_wri_stats : Print basic statistics on the data being written out 
     10   !!   obs_wri_stats  : Print basic statistics on the data being written out 
    1111   !!---------------------------------------------------------------------- 
    1212 
     
    8383      TYPE(obfbdata) :: fbdata 
    8484      CHARACTER(LEN=40) :: clfname 
    85       CHARACTER(LEN=6) :: clfiletype 
     85      CHARACTER(LEN=10) :: clfiletype 
    8686      INTEGER :: ilevel 
    8787      INTEGER :: jvar 
     
    196196         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    197197         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    198          IF ( profdata%nqc(jo) > 10 ) THEN 
    199             fbdata%ioqc(jo)    = 4 
     198         IF ( profdata%nqc(jo) > 255 ) THEN 
     199            fbdata%ioqc(jo)    = IBSET(profdata%nqc(jo),2) 
    200200            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    201             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
     201            fbdata%ioqcf(2,jo) = profdata%nqc(jo) 
    202202         ELSE 
    203203            fbdata%ioqc(jo)    = profdata%nqc(jo) 
     
    236236               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    237237               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    238                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    239                   fbdata%ivlqc(ik,jo,jvar) = 4 
     238               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 
     239                  fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2) 
    240240                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    241                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
     241                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000 0000 1111 1111') 
    242242               ELSE 
    243243                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
     
    320320      TYPE(obfbdata) :: fbdata 
    321321      CHARACTER(LEN=40) :: clfname         ! netCDF filename 
    322       CHARACTER(LEN=6) :: clfiletype 
     322      CHARACTER(LEN=10) :: clfiletype 
    323323      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
    324324      INTEGER :: jo 
     
    395395         END DO 
    396396 
    397       CASE('ICECON') 
     397      CASE('ICECONC') 
    398398 
    399399         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     
    418418         END DO 
    419419 
     420      CASE('SSS') 
     421 
     422         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     423            &                 1 + iadd, iext, .TRUE. ) 
     424 
     425         clfiletype = 'sssfb' 
     426         fbdata%cname(1)      = surfdata%cvars(1) 
     427         fbdata%coblong(1)    = 'Sea surface salinity' 
     428         fbdata%cobunit(1)    = 'psu' 
     429         DO je = 1, iext 
     430            fbdata%cextname(je) = pext%cdname(je) 
     431            fbdata%cextlong(je) = pext%cdlong(je,1) 
     432            fbdata%cextunit(je) = pext%cdunit(je,1) 
     433         END DO 
     434         fbdata%caddlong(1,1) = 'Model interpolated SSS' 
     435         fbdata%caddunit(1,1) = 'psu' 
     436         fbdata%cgrid(1)      = 'T' 
     437         DO ja = 1, iadd 
     438            fbdata%caddname(1+ja) = padd%cdname(ja) 
     439            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     440            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     441         END DO 
     442 
     443      CASE DEFAULT 
     444 
     445         CALL ctl_stop( 'Unknown observation type '//TRIM(surfdata%cvars(1))//' in obs_wri_surf' ) 
     446 
    420447      END SELECT 
    421448 
     
    439466         fbdata%ivqc(jo,:)    = 0 
    440467         fbdata%ivqcf(:,jo,:) = 0 
    441          IF ( surfdata%nqc(jo) > 10 ) THEN 
     468         IF ( surfdata%nqc(jo) > 255 ) THEN 
    442469            fbdata%ioqc(jo)    = 4 
    443470            fbdata%ioqcf(1,jo) = 0 
    444             fbdata%ioqcf(2,jo) = surfdata%nqc(jo) - 10 
     471            fbdata%ioqcf(2,jo) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    445472         ELSE 
    446473            fbdata%ioqc(jo)    = surfdata%nqc(jo) 
     
    474501         fbdata%idqc(1,jo)     = 0 
    475502         fbdata%idqcf(:,1,jo)  = 0 
    476          IF ( surfdata%nqc(jo) > 10 ) THEN 
     503         IF ( surfdata%nqc(jo) > 255 ) THEN 
    477504            fbdata%ivqc(jo,1)       = 4 
    478505            fbdata%ivlqc(1,jo,1)    = 4 
    479506            fbdata%ivlqcf(1,1,jo,1) = 0 
    480             fbdata%ivlqcf(2,1,jo,1) = surfdata%nqc(jo) - 10 
     507            fbdata%ivlqcf(2,1,jo,1) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    481508         ELSE 
    482509            fbdata%ivqc(jo,1)       = surfdata%nqc(jo) 
Note: See TracChangeset for help on using the changeset viewer.