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 9308 for branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90 – NEMO

Ignore:
Timestamp:
2018-02-06T11:30:42+01:00 (6 years ago)
Author:
kingr
Message:

Merging changes required to read and write instrument error from/to fdbk file (e.g., SST_STD).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90

    r7992 r9308  
    9797      INTEGER :: ios 
    9898      INTEGER :: ioserrcount 
     99      INTEGER :: iextr 
    99100      INTEGER, PARAMETER :: jpsurfmaxtype = 1024 
    100101      INTEGER, DIMENSION(knumfiles) :: irefdate 
     
    108109         & iindx,    & 
    109110         & ifileidx, & 
    110          & isurfidx 
     111         & isurfidx, & 
     112         & iadd_std 
    111113      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    112114         & zphi, & 
     
    122124 
    123125      ! Local initialization 
    124       iobs = 0 
    125  
     126      iobs  = 0 
     127      iextr = kextr 
    126128      !----------------------------------------------------------------------- 
    127129      ! Count the number of files needed and allocate the obfbdata type 
     
    131133 
    132134      ALLOCATE( inpfiles(inobf) ) 
     135      ALLOCATE( iadd_std(inobf) ) 
    133136 
    134137      surf_files : DO jj = 1, inobf 
     
    195198                  ENDIF 
    196199               END DO 
     200            ENDIF 
     201 
     202            iadd_std(jj) = -1 
     203            IF ( inpfiles(jj)%nadd > 0 ) THEN 
     204               DO ji = 1, inpfiles(jj)%nadd 
     205                  IF ( TRIM( inpfiles(jj)%caddname(ji) ) == 'STD' ) THEN 
     206                     iextr = kextr + 1 
     207                     iadd_std(jj) = ji 
     208                  ENDIF 
     209               END DO 
     210            ENDIF 
     211 
     212            IF(lwp) THEN 
     213               IF ( iadd_std(jj) /= -1 ) THEN 
     214                  WRITE(numout,*) ' STD variable available in input file so passing it through the obs oper' 
     215                  WRITE(numout,*) 
     216               ENDIF 
    197217            ENDIF 
    198218 
     
    339359         &               iindx   ) 
    340360 
    341       CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj ) 
     361      CALL obs_surf_alloc( surfdata, iobs, kvars, iextr, kstp, jpi, jpj ) 
    342362 
    343363      ! Read obs/positions, QC, all variable and assign to surfdata 
     
    345365      iobs = 0 
    346366      surfdata%cvars(:)  = clvars(:) 
     367      IF ( ldmod .AND. ( TRIM( surfdata%cvars(1) ) == 'SLA' ) ) THEN 
     368         surfdata%cext(1) = 'SSH' 
     369         surfdata%cext(2) = 'MDT' 
     370      ENDIF 
     371      IF ( iextr > kextr ) surfdata%cext(iextr) = 'STD' 
    347372 
    348373      ityp   (:) = 0 
     
    426451               surfdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 
    427452 
    428  
    429453               ! Model and MDT is set to fbrmdi unless read from file 
    430454               IF ( ldmod ) THEN 
     
    437461                  surfdata%rmod(iobs,1) = fbrmdi 
    438462                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 
     463               ENDIF 
     464 
     465               ! STD (obs error standard deviation) read from file and passed through obs operator 
     466               IF ( iadd_std(jj) /= -1 ) THEN 
     467                  surfdata%rext(iobs,iextr) = inpfiles(jj)%padd(1,ji,iadd_std(jj),1) 
    439468               ENDIF 
    440469            ENDIF 
     
    488517      END DO 
    489518      DEALLOCATE( inpfiles ) 
     519      DEALLOCATE( iadd_std ) 
    490520 
    491521   END SUBROUTINE obs_rea_surf 
Note: See TracChangeset for help on using the changeset viewer.