Changeset 6855


Ignore:
Timestamp:
2016-08-08T14:55:55+02:00 (5 years ago)
Author:
dford
Message:

Initial implementation of observation operator for SPM.

Location:
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
4 edited
4 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6854 r6855  
    3131   USE obs_read_vel             ! Reading and allocation of velocity component observations 
    3232   USE obs_read_logchl          ! Reading and allocation of logchl observations 
     33   USE obs_read_spm             ! Reading and allocation of spm observations 
    3334   USE obs_prep                 ! Preparation of obs. (grid search etc). 
    3435   USE obs_oper                 ! Observation operators 
     
    4344   USE obs_seaice               ! Sea Ice data storage 
    4445   USE obs_logchl               ! logchl data storage 
     46   USE obs_spm                  ! spm data storage 
    4547   USE obs_types                ! Definitions for observation types 
    4648   USE mpp_map                  ! MPP mapping 
     
    8688   LOGICAL, PUBLIC :: ln_logchl      !: Logical switch for log10(chlorophyll) 
    8789   LOGICAL, PUBLIC :: ln_logchlfb    !: Logical switch for logchl from feedback files 
     90   LOGICAL, PUBLIC :: ln_spm         !: Logical switch for spm 
     91   LOGICAL, PUBLIC :: ln_spmfb       !: Logical switch for spm from feedback files 
    8892   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
    8993   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
     
    171175      CHARACTER(len=128) :: logchlfiles(MaxNumFiles) 
    172176      CHARACTER(len=128) :: logchlfbfiles(MaxNumFiles) 
     177      CHARACTER(len=128) :: spmfiles(MaxNumFiles) 
     178      CHARACTER(len=128) :: spmfbfiles(MaxNumFiles) 
    173179      CHARACTER(LEN=128) :: reysstname 
    174180      CHARACTER(LEN=12)  :: reysstfmt 
     
    197203         &            ln_logchl, ln_logchlfb,                         & 
    198204         &            logchlfiles, logchlfbfiles,                     & 
     205         &            ln_spm, ln_spmfb,                               & 
     206         &            spmfiles, spmfbfiles,                           & 
    199207         &            ln_profb_enatim, ln_ignmis, ln_cl4,             & 
    200208         &            ln_sstbias, sstbias_files 
     
    220228      INTEGER :: jnumlogchl 
    221229      INTEGER :: jnumlogchlfb 
     230      INTEGER :: jnumspm 
     231      INTEGER :: jnumspmfb 
    222232      INTEGER :: ji 
    223233      INTEGER :: jset 
     
    231241      ln_logchl   = .FALSE. 
    232242      ln_logchlfb = .FALSE. 
     243      ln_spm      = .FALSE. 
     244      ln_spmfb    = .FALSE. 
    233245       
    234246      !Initalise all values in namelist arrays 
     
    253265      logchlfiles(:) = '' 
    254266      logchlfbfiles(:) = '' 
     267      spmfiles(:) = '' 
     268      spmfbfiles(:) = '' 
    255269      sstbias_files(:) = '' 
    256270      endailyavtypes(:) = -1 
     
    361375         WHERE (logchlfbfiles(:) /= '') lmask(:) = .TRUE. 
    362376         jnumlogchlfb = COUNT(lmask) 
     377      ENDIF 
     378      IF (ln_spm) THEN 
     379         lmask(:) = .FALSE. 
     380         WHERE (spmfiles(:) /= '') lmask(:) = .TRUE. 
     381         jnumspm = COUNT(lmask) 
     382      ENDIF 
     383      IF (ln_spmfb) THEN 
     384         lmask(:) = .FALSE. 
     385         WHERE (spmfbfiles(:) /= '') lmask(:) = .TRUE. 
     386         jnumspmfb = COUNT(lmask) 
    363387      ENDIF 
    364388       
     
    394418         WRITE(numout,*) '             Logical switch for logchl observations          ln_logchl = ', ln_logchl 
    395419         WRITE(numout,*) '             Logical switch for feedback logchl data       ln_logchlfb = ', ln_logchlfb 
     420         WRITE(numout,*) '             Logical switch for spm observations                ln_spm = ', ln_spm 
     421         WRITE(numout,*) '             Logical switch for feedback spm data             ln_spmfb = ', ln_spmfb 
    396422         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global 
    397423         WRITE(numout,*) & 
     
    502528               WRITE(numout,'(1X,2A)') '        Feedback logchl input observation file name  logchlfbfiles = ', & 
    503529                  TRIM(logchlfbfiles(ji)) 
     530            END DO 
     531         ENDIF 
     532         IF (ln_spm) THEN 
     533            DO ji = 1, jnumspm 
     534               WRITE(numout,'(1X,2A)') '             spm input observation file name              spmfiles = ', & 
     535                  TRIM(spmfiles(ji)) 
     536            END DO 
     537         ENDIF 
     538         IF (ln_spmfb) THEN 
     539            DO ji = 1, jnumspmfb 
     540               WRITE(numout,'(1X,2A)') '             Feedback spm input observation file name   spmfbfiles = ', & 
     541                  TRIM(spmfbfiles(ji)) 
    504542            END DO 
    505543         ENDIF 
     
    538576         & ( .NOT. ln_vel3d ).AND.                                         & 
    539577         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 
    540          & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ) ) THEN 
     578         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ).AND. & 
     579         & ( .NOT. ln_spm ) ) THEN 
    541580         IF(lwp) WRITE(numout,cform_war) 
    542581         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 
    543582            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 
    544             &                    ' ln_logchl are all set to .FALSE.' 
     583            &                    ' ln_logchl, ln_spm are all set to .FALSE.' 
    545584         nwarn = nwarn + 1 
    546585      ENDIF 
     
    10951134  
    10961135      ENDIF 
     1136 
     1137      !  - spm 
     1138       
     1139      IF ( ln_spm ) THEN 
     1140 
     1141         ! Set the number of variables for spm to 1 
     1142         nspmvars = 1 
     1143 
     1144         ! Set the number of extra variables for spm to 0 
     1145         nspmextr = 0 
     1146          
     1147         IF ( ln_spmfb ) THEN 
     1148            nspmsets = jnumspmfb 
     1149         ELSE 
     1150            nspmsets = 1 
     1151         ENDIF 
     1152 
     1153         ALLOCATE(spmdata(nspmsets)) 
     1154         ALLOCATE(spmdatqc(nspmsets)) 
     1155         spmdata(:)%nsurf=0 
     1156         spmdatqc(:)%nsurf=0 
     1157 
     1158         nspmsets = 0 
     1159 
     1160         IF ( ln_spmfb ) THEN             ! Feedback file format 
     1161 
     1162            DO jset = 1, jnumspmfb 
     1163             
     1164               nspmsets = nspmsets + 1 
     1165 
     1166               CALL obs_rea_spm( 0, spmdata(nspmsets), 1, & 
     1167                  &                 spmfbfiles(jset:jset), & 
     1168                  &                 nspmvars, nspmextr, nitend-nit000+2, & 
     1169                  &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
     1170 
     1171               CALL obs_pre_spm( spmdata(nspmsets), spmdatqc(nspmsets), & 
     1172                  &                 ln_spm, ln_nea ) 
     1173             
     1174            ENDDO 
     1175 
     1176         ELSE                              ! Original file format 
     1177 
     1178            nspmsets = nspmsets + 1 
     1179 
     1180            CALL obs_rea_spm( 1, spmdata(nspmsets), jnumspm, & 
     1181               &                 spmfiles(1:jnumspm), & 
     1182               &                 nspmvars, nspmextr, nitend-nit000+2, & 
     1183               &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
     1184 
     1185            CALL obs_pre_spm( spmdata(nspmsets), spmdatqc(nspmsets), & 
     1186               &                 ln_spm, ln_nea ) 
     1187 
     1188         ENDIF 
     1189  
     1190      ENDIF 
    10971191      
    10981192   END SUBROUTINE dia_obs_init 
     
    11131207      !!               - Velocity component (U,V) profiles 
    11141208      !!               - Sea surface log10(chlorophyll) 
     1209      !!               - Sea surface spm 
    11151210      !! 
    11161211      !! ** Action  :  
     
    11611256      !USE ???                           ! ERSEM chlorophyll 
    11621257#endif 
     1258#if defined key_spm 
     1259      USE par_spm, ONLY: &              ! ERSEM/SPM sediments 
     1260         & jp_spm 
     1261#endif 
    11631262      IMPLICIT NONE 
    11641263 
     
    11731272      INTEGER :: jveloset               ! velocity profile data loop variable 
    11741273      INTEGER :: jlogchlset             ! logchl data set loop variable 
     1274      INTEGER :: jspmset                ! spm data set loop variable 
    11751275      INTEGER :: jvar                   ! Variable number     
    11761276#if ! defined key_lim2 && ! defined key_lim3 
     
    11821282      REAL(wp), DIMENSION(jpi,jpj) :: & 
    11831283         maskchl                        ! array for special chlorophyll mask 
     1284      REAL(wp), DIMENSION(jpi,jpj) :: & 
     1285         spm                            ! array for spm 
     1286      INTEGER :: jn                     ! loop index 
    11841287      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    11851288  
     
    13241427      ENDIF  
    13251428 
     1429      IF ( ln_spm ) THEN 
     1430#if defined key_spm 
     1431         spm(:,:) = 0.0 
     1432         DO jn = 1, jp_spm 
     1433            spm(:,:) = spm(:,:) + trn(:,:,1,jn)   ! sum SPM sizes 
     1434         END DO 
     1435#else 
     1436         CALL ctl_stop( ' Trying to run spm observation operator', & 
     1437            &           ' but no spm model appears to have been defined' ) 
     1438#endif 
     1439 
     1440         DO jspmset = 1, nspmsets 
     1441             CALL obs_spm_opt( spmdatqc(jspmset),                & 
     1442               &               kstp, jpi, jpj, nit000, spm(:,:), & 
     1443               &               tmask(:,:,1), n2dint ) 
     1444         END DO          
     1445      ENDIF 
     1446 
    13261447#if ! defined key_lim2 && ! defined key_lim3 
    13271448      CALL wrk_dealloc(jpi,jpj,frld)  
     
    13571478      INTEGER :: jseaiceset               ! Sea Ice data set loop variable 
    13581479      INTEGER :: jlogchlset               ! logchl data set loop variable 
     1480      INTEGER :: jspmset                  ! spm data set loop variable 
    13591481      INTEGER :: jset 
    13601482      INTEGER :: jfbini 
     
    16281750            WRITE(cdtmp,'(A,I2.2)')'logchlfb_',jlogchlset 
    16291751            CALL obs_wri_logchl( cdtmp, logchldata(jlogchlset) ) 
     1752 
     1753         END DO 
     1754 
     1755      ENDIF 
     1756 
     1757      !  - spm 
     1758      IF ( ln_spm ) THEN 
     1759 
     1760         ! Copy data from spmdatqc to spmdata structures 
     1761         DO jspmset = 1, nspmsets 
     1762 
     1763            CALL obs_surf_decompress( spmdatqc(jspmset), & 
     1764                 &                    spmdata(jspmset), .TRUE., numout ) 
     1765 
     1766         END DO 
     1767 
     1768         ! Write the spm data 
     1769         DO jspmset = 1, nspmsets 
     1770       
     1771            WRITE(cdtmp,'(A,I2.2)')'spmfb_',jspmset 
     1772            CALL obs_wri_spm( cdtmp, spmdata(jspmset) ) 
    16301773 
    16311774         END DO 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r6854 r6855  
    2424   !!                    components of velocity from observations. 
    2525   !!   obs_logchl_opt : Compute the model counterpart of log10(chlorophyll) 
     26   !!                    observations 
     27   !!   obs_spm_opt :    Compute the model counterpart of spm 
    2628   !!                    observations 
    2729   !!---------------------------------------------------------------------- 
     
    6668      &   obs_seaice_opt, & 
    6769      &   obs_vel_opt, &  ! Compute the model counterpart of velocity profile data 
    68       &   obs_logchl_opt  ! Compute the model counterpart of logchl data 
     70      &   obs_logchl_opt, & ! Compute the model counterpart of logchl data 
     71      &   obs_spm_opt     ! Compute the model counterpart of spm data 
    6972 
    7073   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types 
     
    22152218   END SUBROUTINE obs_logchl_opt 
    22162219 
     2220   SUBROUTINE obs_spm_opt( spmdatqc, kt, kpi, kpj, kit000, & 
     2221      &                    pspmn, pspmmask, k2dint ) 
     2222 
     2223      !!----------------------------------------------------------------------- 
     2224      !! 
     2225      !!                     ***  ROUTINE obs_spm_opt  *** 
     2226      !! 
     2227      !! ** Purpose : Compute the model counterpart of spm 
     2228      !!              data by interpolating from the model grid to the  
     2229      !!              observation point. 
     2230      !! 
     2231      !! ** Method  : Linearly interpolate to each observation point using  
     2232      !!              the model values at the corners of the surrounding grid box. 
     2233      !! 
     2234      !!    The now model spm is first computed at the obs (lon, lat) point. 
     2235      !! 
     2236      !!    Several horizontal interpolation schemes are available: 
     2237      !!        - distance-weighted (great circle) (k2dint = 0) 
     2238      !!        - distance-weighted (small angle)  (k2dint = 1) 
     2239      !!        - bilinear (geographical grid)     (k2dint = 2) 
     2240      !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
     2241      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
     2242      !! 
     2243      !! 
     2244      !! ** Action  : 
     2245      !! 
     2246      !! History : 
     2247      !!       
     2248      !!----------------------------------------------------------------------- 
     2249 
     2250      !! * Modules used 
     2251      USE obs_surf_def  ! Definition of storage space for surface observations 
     2252 
     2253      IMPLICIT NONE 
     2254 
     2255      !! * Arguments 
     2256      TYPE(obs_surf), INTENT(INOUT) :: spmdatqc     ! Subset of surface data not failing screening 
     2257      INTEGER, INTENT(IN) :: kt       ! Time step 
     2258      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters 
     2259      INTEGER, INTENT(IN) :: kpj 
     2260      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
     2261                                      !   (kit000-1 = restart time) 
     2262      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
     2263      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     2264         & pspmn,  &    ! Model spm field 
     2265         & pspmmask     ! Land-sea mask 
     2266          
     2267      !! * Local declarations 
     2268      INTEGER :: ji 
     2269      INTEGER :: jj 
     2270      INTEGER :: jobs 
     2271      INTEGER :: inrc 
     2272      INTEGER :: ispm 
     2273      INTEGER :: iobs 
     2274        
     2275      REAL(KIND=wp) :: zlam 
     2276      REAL(KIND=wp) :: zphi 
     2277      REAL(KIND=wp) :: zext(1), zobsmask(1) 
     2278      REAL(kind=wp), DIMENSION(2,2,1) :: & 
     2279         & zweig 
     2280      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     2281         & zmask, & 
     2282         & zspml, & 
     2283         & zglam, & 
     2284         & zgphi 
     2285      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     2286         & igrdi, & 
     2287         & igrdj 
     2288 
     2289      !------------------------------------------------------------------------ 
     2290      ! Local initialization  
     2291      !------------------------------------------------------------------------ 
     2292      ! ... Record and data counters 
     2293      inrc = kt - kit000 + 2 
     2294      ispm = spmdatqc%nsstp(inrc) 
     2295 
     2296      ! Get the data for interpolation 
     2297       
     2298      ALLOCATE( & 
     2299         & igrdi(2,2,ispm), & 
     2300         & igrdj(2,2,ispm), & 
     2301         & zglam(2,2,ispm), & 
     2302         & zgphi(2,2,ispm), & 
     2303         & zmask(2,2,ispm), & 
     2304         & zspml(2,2,ispm)  & 
     2305         & ) 
     2306       
     2307      DO jobs = spmdatqc%nsurfup + 1, spmdatqc%nsurfup + ispm 
     2308         iobs = jobs - spmdatqc%nsurfup 
     2309         igrdi(1,1,iobs) = spmdatqc%mi(jobs)-1 
     2310         igrdj(1,1,iobs) = spmdatqc%mj(jobs)-1 
     2311         igrdi(1,2,iobs) = spmdatqc%mi(jobs)-1 
     2312         igrdj(1,2,iobs) = spmdatqc%mj(jobs) 
     2313         igrdi(2,1,iobs) = spmdatqc%mi(jobs) 
     2314         igrdj(2,1,iobs) = spmdatqc%mj(jobs)-1 
     2315         igrdi(2,2,iobs) = spmdatqc%mi(jobs) 
     2316         igrdj(2,2,iobs) = spmdatqc%mj(jobs) 
     2317      END DO 
     2318       
     2319      CALL obs_int_comm_2d( 2, 2, ispm, & 
     2320         &                  igrdi, igrdj, glamt, zglam ) 
     2321      CALL obs_int_comm_2d( 2, 2, ispm, & 
     2322         &                  igrdi, igrdj, gphit, zgphi ) 
     2323      CALL obs_int_comm_2d( 2, 2, ispm, & 
     2324         &                  igrdi, igrdj, pspmmask, zmask ) 
     2325      CALL obs_int_comm_2d( 2, 2, ispm, & 
     2326         &                  igrdi, igrdj, pspmn, zspml ) 
     2327       
     2328      DO jobs = spmdatqc%nsurfup + 1, spmdatqc%nsurfup + ispm 
     2329          
     2330         iobs = jobs - spmdatqc%nsurfup 
     2331          
     2332         IF ( kt /= spmdatqc%mstp(jobs) ) THEN 
     2333             
     2334            IF(lwp) THEN 
     2335               WRITE(numout,*) 
     2336               WRITE(numout,*) ' E R R O R : Observation',              & 
     2337                  &            ' time step is not consistent with the', & 
     2338                  &            ' model time step' 
     2339               WRITE(numout,*) ' =========' 
     2340               WRITE(numout,*) 
     2341               WRITE(numout,*) ' Record  = ', jobs,                & 
     2342                  &            ' kt      = ', kt,                  & 
     2343                  &            ' mstp    = ', spmdatqc%mstp(jobs), & 
     2344                  &            ' ntyp    = ', spmdatqc%ntyp(jobs) 
     2345            ENDIF 
     2346            CALL ctl_stop( 'obs_spm_opt', 'Inconsistent time' ) 
     2347             
     2348         ENDIF 
     2349          
     2350         zlam = spmdatqc%rlam(jobs) 
     2351         zphi = spmdatqc%rphi(jobs) 
     2352          
     2353         ! Get weights to interpolate the model spm to the observation point 
     2354         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     2355            &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     2356            &                   zmask(:,:,iobs), zweig, zobsmask ) 
     2357          
     2358         ! ... Interpolate the model spm to the observation point 
     2359         CALL obs_int_h2d( 1, 1,      & 
     2360            &              zweig, zspml(:,:,iobs),  zext ) 
     2361          
     2362         spmdatqc%rmod(jobs,1) = zext(1) 
     2363          
     2364      END DO 
     2365       
     2366      ! Deallocate the data for interpolation 
     2367      DEALLOCATE( & 
     2368         & igrdi,    & 
     2369         & igrdj,    & 
     2370         & zglam,    & 
     2371         & zgphi,    & 
     2372         & zmask,    & 
     2373         & zspml  & 
     2374         & ) 
     2375       
     2376      spmdatqc%nsurfup = spmdatqc%nsurfup + ispm 
     2377 
     2378   END SUBROUTINE obs_spm_opt 
     2379 
    22172380END MODULE obs_oper 
    22182381 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r6854 r6855  
    1313   !!   obs_pre_vel  : First level check and screening of velocity obs. 
    1414   !!   obs_pre_logchl : First level check and screening of logchl obs. 
     15   !!   obs_pre_spm  : First level check and screening of spm obs. 
    1516   !!   obs_scr      : Basic screening of the observations 
    1617   !!   obs_coo_tim  : Compute number of time steps to the observation time 
     
    4344      & obs_pre_vel, &     ! First level check and screening of velocity profiles 
    4445      & obs_pre_logchl, & ! First level check and screening of logchl data 
     46      & obs_pre_spm, &    ! First level check and screening of spm data 
    4547      & calc_month_len     ! Calculate the number of days in the months of a year   
    4648 
     
    13711373   END SUBROUTINE obs_pre_logchl 
    13721374 
     1375   SUBROUTINE obs_pre_spm( spmdata, spmdatqc, ld_spm, ld_nea ) 
     1376      !!---------------------------------------------------------------------- 
     1377      !!                    ***  ROUTINE obs_pre_spm  *** 
     1378      !! 
     1379      !! ** Purpose : First level check and screening of spm observations 
     1380      !! 
     1381      !! ** Method  : First level check and screening of spm observations 
     1382      !! 
     1383      !! ** Action  :  
     1384      !! 
     1385      !! References : 
     1386      !!    
     1387      !! History : 
     1388      !!---------------------------------------------------------------------- 
     1389      !! * Modules used 
     1390      USE domstp              ! Domain: set the time-step 
     1391      USE par_oce             ! Ocean parameters 
     1392      USE dom_oce, ONLY : &   ! Geographical information 
     1393         & glamt,   & 
     1394         & gphit,   & 
     1395         & tmask 
     1396      !! * Arguments 
     1397      TYPE(obs_surf), INTENT(INOUT) :: spmdata     ! Full set of spm data 
     1398      TYPE(obs_surf), INTENT(INOUT) :: spmdatqc    ! Subset of spm data not failing screening 
     1399      LOGICAL :: ld_spm     ! Switch for spm data 
     1400      LOGICAL :: ld_nea        ! Switch for rejecting observation near land 
     1401      !! * Local declarations 
     1402      INTEGER :: iyea0         ! Initial date 
     1403      INTEGER :: imon0         !  - (year, month, day, hour, minute) 
     1404      INTEGER :: iday0     
     1405      INTEGER :: ihou0     
     1406      INTEGER :: imin0 
     1407      INTEGER :: icycle       ! Current assimilation cycle 
     1408                              ! Counters for observations that 
     1409      INTEGER :: iotdobs      !  - outside time domain 
     1410      INTEGER :: iosdsobs     !  - outside space domain 
     1411      INTEGER :: ilansobs     !  - within a model land cell 
     1412      INTEGER :: inlasobs     !  - close to land 
     1413      INTEGER :: igrdobs      !  - fail the grid search 
     1414                              ! Global counters for observations that 
     1415      INTEGER :: iotdobsmpp   !  - outside time domain 
     1416      INTEGER :: iosdsobsmpp  !  - outside space domain 
     1417      INTEGER :: ilansobsmpp  !  - within a model land cell 
     1418      INTEGER :: inlasobsmpp  !  - close to land 
     1419      INTEGER :: igrdobsmpp   !  - fail the grid search 
     1420      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
     1421         & llvalid            ! data selection 
     1422      INTEGER :: jobs         ! Obs. loop variable 
     1423      INTEGER :: jstp         ! Time loop variable 
     1424      INTEGER :: inrc         ! Time index variable 
     1425 
     1426      IF (lwp) WRITE(numout,*)'obs_pre_spm : Preparing the spm observations...' 
     1427 
     1428      ! Initial date initialization (year, month, day, hour, minute) 
     1429      iyea0 =   ndate0 / 10000 
     1430      imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
     1431      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
     1432      ihou0 = 0 
     1433      imin0 = 0 
     1434 
     1435      icycle = no     ! Assimilation cycle 
     1436 
     1437      ! Diagnostics counters for various failures. 
     1438 
     1439      iotdobs  = 0 
     1440      igrdobs  = 0 
     1441      iosdsobs = 0 
     1442      ilansobs = 0 
     1443      inlasobs = 0 
     1444 
     1445      ! ----------------------------------------------------------------------- 
     1446      ! Find time coordinate for spm data 
     1447      ! ----------------------------------------------------------------------- 
     1448 
     1449      CALL obs_coo_tim( icycle, & 
     1450         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
     1451         &              spmdata%nsurf,   spmdata%nyea, spmdata%nmon, & 
     1452         &              spmdata%nday,    spmdata%nhou, spmdata%nmin, & 
     1453         &              spmdata%nqc,     spmdata%mstp, iotdobs        ) 
     1454      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
     1455      ! ----------------------------------------------------------------------- 
     1456      ! Check for spm data failing the grid search 
     1457      ! ----------------------------------------------------------------------- 
     1458 
     1459      CALL obs_coo_grd( spmdata%nsurf,   spmdata%mi, spmdata%mj, & 
     1460         &              spmdata%nqc,     igrdobs                         ) 
     1461      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
     1462 
     1463      ! ----------------------------------------------------------------------- 
     1464      ! Check for land points.  
     1465      ! ----------------------------------------------------------------------- 
     1466 
     1467      CALL obs_coo_spc_2d( spmdata%nsurf,                 & 
     1468         &                 jpi,             jpj,             & 
     1469         &                 spmdata%mi,   spmdata%mj,   &  
     1470         &                 spmdata%rlam, spmdata%rphi, & 
     1471         &                 glamt,           gphit,           & 
     1472         &                 tmask(:,:,1),    spmdata%nqc,  & 
     1473         &                 iosdsobs,        ilansobs,        & 
     1474         &                 inlasobs,        ld_nea           )  
     1475          
     1476      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
     1477      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
     1478      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     1479 
     1480      ! ----------------------------------------------------------------------- 
     1481      ! Copy useful data from the spmdata data structure to 
     1482      ! the spmdatqc data structure  
     1483      ! ----------------------------------------------------------------------- 
     1484 
     1485      ! Allocate the selection arrays 
     1486 
     1487      ALLOCATE( llvalid(spmdata%nsurf) ) 
     1488       
     1489      ! We want all data which has qc flags <= 0 
     1490 
     1491      llvalid(:)  = ( spmdata%nqc(:)  <= 10 ) 
     1492 
     1493      ! The actual copying 
     1494 
     1495      CALL obs_surf_compress( spmdata,     spmdatqc,       .TRUE.,  numout, & 
     1496         &                    lvalid=llvalid ) 
     1497 
     1498      ! Dellocate the selection arrays 
     1499      DEALLOCATE( llvalid ) 
     1500 
     1501      ! ----------------------------------------------------------------------- 
     1502      ! Print information about what observations are left after qc 
     1503      ! ----------------------------------------------------------------------- 
     1504 
     1505      ! Update the total observation counter array 
     1506       
     1507      IF(lwp) THEN 
     1508         WRITE(numout,*) 
     1509         WRITE(numout,*) 'obs_pre_spm :' 
     1510         WRITE(numout,*) '~~~~~~~~~~~' 
     1511         WRITE(numout,*) 
     1512         WRITE(numout,*) ' spm data outside time domain                  = ', & 
     1513            &            iotdobsmpp 
     1514         WRITE(numout,*) ' Remaining spm data that failed grid search    = ', & 
     1515            &            igrdobsmpp 
     1516         WRITE(numout,*) ' Remaining spm data outside space domain       = ', & 
     1517            &            iosdsobsmpp 
     1518         WRITE(numout,*) ' Remaining spm data at land points             = ', & 
     1519            &            ilansobsmpp 
     1520         IF (ld_nea) THEN 
     1521            WRITE(numout,*) ' Remaining spm data near land points (removed) = ', & 
     1522               &            inlasobsmpp 
     1523         ELSE 
     1524            WRITE(numout,*) ' Remaining spm data near land points (kept)    = ', & 
     1525               &            inlasobsmpp 
     1526         ENDIF 
     1527         WRITE(numout,*) ' spm data accepted                             = ', & 
     1528            &            spmdatqc%nsurfmpp 
     1529 
     1530         WRITE(numout,*) 
     1531         WRITE(numout,*) ' Number of observations per time step :' 
     1532         WRITE(numout,*) 
     1533         WRITE(numout,1997) 
     1534         WRITE(numout,1998) 
     1535      ENDIF 
     1536       
     1537      DO jobs = 1, spmdatqc%nsurf 
     1538         inrc = spmdatqc%mstp(jobs) + 2 - nit000 
     1539         spmdatqc%nsstp(inrc)  = spmdatqc%nsstp(inrc) + 1 
     1540      END DO 
     1541       
     1542      CALL obs_mpp_sum_integers( spmdatqc%nsstp, spmdatqc%nsstpmpp, & 
     1543         &                       nitend - nit000 + 2 ) 
     1544 
     1545      IF ( lwp ) THEN 
     1546         DO jstp = nit000 - 1, nitend 
     1547            inrc = jstp - nit000 + 2 
     1548            WRITE(numout,1999) jstp, spmdatqc%nsstpmpp(inrc) 
     1549         END DO 
     1550      ENDIF 
     1551 
     15521997  FORMAT(10X,'Time step',5X,'spm data') 
     15531998  FORMAT(10X,'---------',5X,'------------') 
     15541999  FORMAT(10X,I9,5X,I17) 
     1555       
     1556   END SUBROUTINE obs_pre_spm 
     1557 
    13731558   SUBROUTINE obs_coo_tim( kcycle, & 
    13741559      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     & 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_spm.F90

    r6854 r6855  
    1 MODULE obs_read_logchl 
     1MODULE obs_read_spm 
    22   !!====================================================================== 
    3    !!                       ***  MODULE obs_read_logchl  *** 
    4    !! Observation diagnostics: Read the along track logchl data from 
    5    !!                          GHRSST or any logchl data from feedback files 
     3   !!                       ***  MODULE obs_read_spm  *** 
     4   !! Observation diagnostics: Read the along track spm data from 
     5   !!                          GHRSST or any spm data from feedback files 
    66   !!====================================================================== 
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   obs_rea_logchl : Driver for reading logchl data from the feedback 
     9   !!   obs_rea_spm : Driver for reading spm data from the feedback 
    1010   !!---------------------------------------------------------------------- 
    1111 
     
    2121   USE obs_surf_def             ! Surface observation definitions 
    2222   USE obs_types                ! Observation type definitions 
    23    USE obs_logchl_io            ! I/O for logchl files 
     23   USE obs_spm_io            ! I/O for spm files 
    2424   USE iom                      ! I/O 
    2525   USE netcdf                   ! NetCDF library 
     
    3030   PRIVATE 
    3131 
    32    PUBLIC obs_rea_logchl      ! Read the logchl observations from the point data 
     32   PUBLIC obs_rea_spm      ! Read the spm observations from the point data 
    3333    
    3434   !!---------------------------------------------------------------------- 
     
    4040CONTAINS 
    4141 
    42    SUBROUTINE obs_rea_logchl( kformat, & 
    43       &                    logchldata, knumfiles, cfilenames, & 
     42   SUBROUTINE obs_rea_spm( kformat, & 
     43      &                    spmdata, knumfiles, cfilenames, & 
    4444      &                    kvars, kextr, kstp, ddobsini, ddobsend, & 
    4545      &                    ldignmis, ldmod ) 
    4646      !!--------------------------------------------------------------------- 
    4747      !! 
    48       !!                   *** ROUTINE obs_rea_logchl *** 
    49       !! 
    50       !! ** Purpose : Read from file the logchl data 
     48      !!                   *** ROUTINE obs_rea_spm *** 
     49      !! 
     50      !! ** Purpose : Read from file the spm data 
    5151      !! 
    5252      !! ** Method  : Depending on kformat either old or new style 
     
    6666      !                    ! 1: Old-style feedback 
    6767      TYPE(obs_surf), INTENT(INOUT) :: & 
    68          & logchldata     ! logchl data to be read 
     68         & spmdata     ! spm data to be read 
    6969      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in 
    7070      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 
    71       INTEGER, INTENT(IN) :: kvars    ! Number of variables in logchldata 
    72       INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in logchldata 
     71      INTEGER, INTENT(IN) :: kvars    ! Number of variables in spmdata 
     72      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in spmdata 
    7373      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index 
    7474      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     
    7878          
    7979      !! * Local declarations 
    80       CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_logchl' 
     80      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_spm' 
    8181      INTEGER :: ji 
    8282      INTEGER :: jj 
     
    9595         & irefdate 
    9696      INTEGER :: iobsmpp 
    97       INTEGER, PARAMETER :: ilogchlmaxtype = 1024 
    98       INTEGER, DIMENSION(0:ilogchlmaxtype) :: & 
     97      INTEGER, PARAMETER :: ispmmaxtype = 1024 
     98      INTEGER, DIMENSION(0:ispmmaxtype) :: & 
    9999         & ityp, & 
    100100         & itypmpp 
     
    105105         & iindx,    & 
    106106         & ifileidx, & 
    107          & ilogchlidx 
     107         & ispmidx 
    108108      INTEGER :: itype 
    109109      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     
    143143      ALLOCATE( inpfiles(inobf) ) 
    144144 
    145       logchl_files : DO jj = 1, inobf 
     145      spm_files : DO jj = 1, inobf 
    146146           
    147147         !--------------------------------------------------------------------- 
     
    150150         IF(lwp) THEN 
    151151            WRITE(numout,*) 
    152             WRITE(numout,*) ' obs_rea_logchl : Reading from file = ', & 
     152            WRITE(numout,*) ' obs_rea_spm : Reading from file = ', & 
    153153               & TRIM( TRIM( cfilenames(jj) ) ) 
    154154            WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     
    200200               ENDIF 
    201201            ELSEIF ( kformat == 1) THEN 
    202                CALL read_logchl( TRIM( cfilenames(jj) ), inpfiles(jj), & 
     202               CALL read_spm( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    203203               &                 numout, lwp, .TRUE. ) 
    204204            ELSE 
     
    291291         ENDIF 
    292292 
    293       END DO logchl_files 
     293      END DO spm_files 
    294294 
    295295      !----------------------------------------------------------------------- 
     
    311311 
    312312      ALLOCATE( iindx(iobstot), ifileidx(iobstot), & 
    313          &      ilogchlidx(iobstot), zdat(iobstot) ) 
     313         &      ispmidx(iobstot), zdat(iobstot) ) 
    314314      jk = 0 
    315315      DO jj = 1, inobf 
     
    319319               jk = jk + 1 
    320320               ifileidx(jk) = jj 
    321                ilogchlidx(jk) = ji 
     321               ispmidx(jk) = ji 
    322322               zdat(jk)     = inpfiles(jj)%ptim(ji) 
    323323            ENDIF 
     
    328328         &               iindx   ) 
    329329       
    330       CALL obs_surf_alloc( logchldata, iobs, &  
     330      CALL obs_surf_alloc( spmdata, iobs, &  
    331331                           kvars, kextr, kstp, jpi, jpj ) 
    332332       
    333       ! * Read obs/positions, QC, all variable and assign to logchldata 
     333      ! * Read obs/positions, QC, all variable and assign to spmdata 
    334334  
    335335      iobs = 0 
     
    343343          
    344344         jj = ifileidx(iindx(jk)) 
    345          ji = ilogchlidx(iindx(jk)) 
     345         ji = ispmidx(iindx(jk)) 
    346346         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    347347            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
     
    370370 
    371371 
    372                ! logchl time coordinates 
    373                logchldata%nyea(iobs) = iyea 
    374                logchldata%nmon(iobs) = imon 
    375                logchldata%nday(iobs) = iday 
    376                logchldata%nhou(iobs) = ihou 
    377                logchldata%nmin(iobs) = imin 
     372               ! spm time coordinates 
     373               spmdata%nyea(iobs) = iyea 
     374               spmdata%nmon(iobs) = imon 
     375               spmdata%nday(iobs) = iday 
     376               spmdata%nhou(iobs) = ihou 
     377               spmdata%nmin(iobs) = imin 
    378378                
    379                ! logchl space coordinates 
    380                logchldata%rlam(iobs) = inpfiles(jj)%plam(ji) 
    381                logchldata%rphi(iobs) = inpfiles(jj)%pphi(ji) 
     379               ! spm space coordinates 
     380               spmdata%rlam(iobs) = inpfiles(jj)%plam(ji) 
     381               spmdata%rphi(iobs) = inpfiles(jj)%pphi(ji) 
    382382 
    383383               ! Coordinate search parameters 
    384                logchldata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1) 
    385                logchldata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
     384               spmdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1) 
     385               spmdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
    386386                
    387387               ! Instrument type 
     
    392392                  itype = 0 
    393393               ENDIF 
    394                logchldata%ntyp(iobs) = itype 
    395                IF ( itype < ilogchlmaxtype + 1 ) THEN 
     394               spmdata%ntyp(iobs) = itype 
     395               IF ( itype < ispmmaxtype + 1 ) THEN 
    396396                  ityp(itype+1) = ityp(itype+1) + 1 
    397397               ELSE 
    398                   IF(lwp)WRITE(numout,*)'WARNING:Increase ilogchlmaxtype in ',& 
     398                  IF(lwp)WRITE(numout,*)'WARNING:Increase ispmmaxtype in ',& 
    399399                     &                  cpname 
    400400               ENDIF 
    401401 
    402402               ! Bookkeeping data to match observations 
    403                logchldata%nsidx(iobs) = iobs 
    404                logchldata%nsfil(iobs) = iindx(jk) 
     403               spmdata%nsidx(iobs) = iobs 
     404               spmdata%nsfil(iobs) = iindx(jk) 
    405405 
    406406               ! QC flags 
    407                logchldata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 
     407               spmdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 
    408408 
    409409               ! Observed value 
    410                logchldata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 
     410               spmdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 
    411411 
    412412 
    413413               ! Model and MDT is set to fbrmdi unless read from file 
    414414               IF ( ldmod ) THEN 
    415                   logchldata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 
     415                  spmdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 
    416416               ELSE 
    417                   logchldata%rmod(iobs,1) = fbrmdi 
     417                  spmdata%rmod(iobs,1) = fbrmdi 
    418418               ENDIF 
    419419            ENDIF 
     
    434434 
    435435         WRITE(numout,*) 
    436          WRITE(numout,'(1X,A)')'logchl data types' 
     436         WRITE(numout,'(1X,A)')'spm data types' 
    437437         WRITE(numout,'(1X,A)')'-----------------' 
    438438         DO jj = 1,8 
     
    450450      ! Deallocate temporary data 
    451451      !----------------------------------------------------------------------- 
    452       DEALLOCATE( ifileidx, ilogchlidx, zdat ) 
     452      DEALLOCATE( ifileidx, ispmidx, zdat ) 
    453453 
    454454      !----------------------------------------------------------------------- 
     
    460460      DEALLOCATE( inpfiles ) 
    461461 
    462    END SUBROUTINE obs_rea_logchl 
    463  
    464 END MODULE obs_read_logchl 
    465  
     462   END SUBROUTINE obs_rea_spm 
     463 
     464END MODULE obs_read_spm 
     465 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_spm.F90

    r6854 r6855  
    1 MODULE obs_logchl 
     1MODULE obs_spm 
    22   !!===================================================================== 
    3    !!                       ***  MODULE  obs_logchl  *** 
    4    !! Observation diagnostics: Storage space for logchl observations 
     3   !!                       ***  MODULE  obs_spm  *** 
     4   !! Observation diagnostics: Storage space for spm observations 
    55   !!                          arrays and additional flags etc. 
    66   !!===================================================================== 
     
    2222   PRIVATE 
    2323 
    24    PUBLIC nlogchlvars, nlogchlextr, nlogchlsets, logchldata, logchldatqc 
     24   PUBLIC nspmvars, nspmextr, nspmsets, spmdata, spmdatqc 
    2525 
    2626   !! * Shared Module variables 
    27    INTEGER :: nlogchlvars                               ! Number of logchldata variables 
    28    INTEGER :: nlogchlextr                               ! Number of logchldata extra  
    29                                                         ! variables 
    30    INTEGER :: nlogchlsets                               ! Number of logchldata sets 
    31    TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldata  ! Initial logchl data 
    32    TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldatqc ! Sea ice data after quality control 
     27   INTEGER :: nspmvars                               ! Number of spmdata variables 
     28   INTEGER :: nspmextr                               ! Number of spmdata extra  
     29                                                     ! variables 
     30   INTEGER :: nspmsets                               ! Number of spmdata sets 
     31   TYPE(obs_surf), POINTER, DIMENSION(:) :: spmdata  ! Initial spm data 
     32   TYPE(obs_surf), POINTER, DIMENSION(:) :: spmdatqc ! Sea ice data after quality control 
    3333 
    34 END MODULE obs_logchl 
     34END MODULE obs_spm 
    3535 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_spm_io.F90

    r6854 r6855  
    1 MODULE obs_logchl_io 
     1MODULE obs_spm_io 
    22   !!====================================================================== 
    3    !!                       ***  MODULE obs_logchl_io  *** 
    4    !! Observation operators : I/O for logchl files 
     3   !!                       ***  MODULE obs_spm_io  *** 
     4   !! Observation operators : I/O for spm files 
    55   !!====================================================================== 
    66   !! History :  
     
    88   !!---------------------------------------------------------------------- 
    99   !!---------------------------------------------------------------------- 
    10    !!   read_logchlfile    :  Read a obfbdata structure from a logchl file 
     10   !!   read_spmfile    :  Read a obfbdata structure from a spm file 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_kind 
     
    2626CONTAINS 
    2727 
    28 #include "obslogchl_io.h90" 
     28#include "obsspm_io.h90" 
    2929 
    30 END MODULE obs_logchl_io 
     30END MODULE obs_spm_io 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r6854 r6855  
    1212   !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format 
    1313   !!   obs_wri_logchl: Write logchl observation related diagnostics 
     14   !!   obs_wri_spm   : Write spm observation related diagnostics 
    1415   !!   obs_wri_stats : Print basic statistics on the data being written out 
    1516   !!---------------------------------------------------------------------- 
     
    4748      &   obs_wri_vel, &    ! Write velocity observation related diagnostics 
    4849      &   obs_wri_logchl, & ! Write logchl observation related diagnostics 
     50      &   obs_wri_spm, &    ! Write spm observation related diagnostics 
    4951      &   obswriinfo 
    5052    
     
    10811083   END SUBROUTINE obs_wri_logchl 
    10821084 
     1085   SUBROUTINE obs_wri_spm( cprefix, spmdata, padd, pext ) 
     1086      !!----------------------------------------------------------------------- 
     1087      !! 
     1088      !!                     *** ROUTINE obs_wri_spm  *** 
     1089      !! 
     1090      !! ** Purpose : Write spm observation diagnostics 
     1091      !!              related  
     1092      !! 
     1093      !! ** Method  : NetCDF 
     1094      !!  
     1095      !! ** Action  : 
     1096      !! 
     1097      !!----------------------------------------------------------------------- 
     1098 
     1099      !! * Modules used 
     1100      IMPLICIT NONE 
     1101 
     1102      !! * Arguments 
     1103      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
     1104      TYPE(obs_surf), INTENT(INOUT) :: spmdata   ! Full set of spm 
     1105      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
     1106      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
     1107 
     1108      !! * Local declarations  
     1109      TYPE(obfbdata) :: fbdata 
     1110      CHARACTER(LEN=40) :: cfname             ! netCDF filename 
     1111      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_spm' 
     1112      INTEGER :: jo 
     1113      INTEGER :: ja 
     1114      INTEGER :: je 
     1115      INTEGER :: nadd 
     1116      INTEGER :: next 
     1117 
     1118      IF ( PRESENT( padd ) ) THEN 
     1119         nadd = padd%inum 
     1120      ELSE 
     1121         nadd = 0 
     1122      ENDIF 
     1123 
     1124      IF ( PRESENT( pext ) ) THEN 
     1125         next = pext%inum 
     1126      ELSE 
     1127         next = 0 
     1128      ENDIF 
     1129 
     1130      CALL init_obfbdata( fbdata ) 
     1131 
     1132      CALL alloc_obfbdata( fbdata, 1, spmdata%nsurf, 1, & 
     1133         &                 1 + nadd, next, .TRUE. ) 
     1134 
     1135      fbdata%cname(1)      = 'spm' 
     1136      fbdata%coblong(1)    = 'spm' 
     1137      fbdata%cobunit(1)    = 'g/m3' 
     1138      DO je = 1, next 
     1139         fbdata%cextname(je) = pext%cdname(je) 
     1140         fbdata%cextlong(je) = pext%cdlong(je,1) 
     1141         fbdata%cextunit(je) = pext%cdunit(je,1) 
     1142      END DO 
     1143      fbdata%caddname(1)   = 'Hx' 
     1144      fbdata%caddlong(1,1) = 'Model interpolated spm' 
     1145      fbdata%caddunit(1,1) = 'g/m3' 
     1146      fbdata%cgrid(1)      = 'T' 
     1147      DO ja = 1, nadd 
     1148         fbdata%caddname(1+ja) = padd%cdname(ja) 
     1149         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     1150         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     1151      END DO 
     1152 
     1153      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
     1154 
     1155      IF(lwp) THEN 
     1156         WRITE(numout,*) 
     1157         WRITE(numout,*)'obs_wri_spm :' 
     1158         WRITE(numout,*)'~~~~~~~~~~~~~~~~' 
     1159         WRITE(numout,*)'Writing spm feedback file : ',TRIM(cfname) 
     1160      ENDIF 
     1161 
     1162      ! Transform obs_prof data structure into obfbdata structure 
     1163      fbdata%cdjuldref = '19500101000000' 
     1164      DO jo = 1, spmdata%nsurf 
     1165         fbdata%plam(jo)      = spmdata%rlam(jo) 
     1166         fbdata%pphi(jo)      = spmdata%rphi(jo) 
     1167         WRITE(fbdata%cdtyp(jo),'(I4)') spmdata%ntyp(jo) 
     1168         fbdata%ivqc(jo,:)    = 0 
     1169         fbdata%ivqcf(:,jo,:) = 0 
     1170         IF ( spmdata%nqc(jo) > 10 ) THEN 
     1171            fbdata%ioqc(jo)    = 4 
     1172            fbdata%ioqcf(1,jo) = 0 
     1173            fbdata%ioqcf(2,jo) = spmdata%nqc(jo) - 10 
     1174         ELSE 
     1175            fbdata%ioqc(jo)    = MAX(spmdata%nqc(jo),1) 
     1176            fbdata%ioqcf(:,jo) = 0 
     1177         ENDIF 
     1178         fbdata%ipqc(jo)      = 0 
     1179         fbdata%ipqcf(:,jo)   = 0 
     1180         fbdata%itqc(jo)      = 0 
     1181         fbdata%itqcf(:,jo)   = 0 
     1182         fbdata%cdwmo(jo)     = '' 
     1183         fbdata%kindex(jo)    = spmdata%nsfil(jo) 
     1184         IF (ln_grid_global) THEN 
     1185            fbdata%iobsi(jo,1) = spmdata%mi(jo) 
     1186            fbdata%iobsj(jo,1) = spmdata%mj(jo) 
     1187         ELSE 
     1188            fbdata%iobsi(jo,1) = mig(spmdata%mi(jo)) 
     1189            fbdata%iobsj(jo,1) = mjg(spmdata%mj(jo)) 
     1190         ENDIF 
     1191         CALL greg2jul( 0, & 
     1192            &           spmdata%nmin(jo), & 
     1193            &           spmdata%nhou(jo), & 
     1194            &           spmdata%nday(jo), & 
     1195            &           spmdata%nmon(jo), & 
     1196            &           spmdata%nyea(jo), & 
     1197            &           fbdata%ptim(jo),   & 
     1198            &           krefdate = 19500101 ) 
     1199         fbdata%padd(1,jo,1,1) = spmdata%rmod(jo,1) 
     1200         fbdata%pob(1,jo,1)    = spmdata%robs(jo,1) 
     1201         fbdata%pdep(1,jo)     = 0.0 
     1202         fbdata%idqc(1,jo)     = 0 
     1203         fbdata%idqcf(:,1,jo)  = 0 
     1204         IF ( spmdata%nqc(jo) > 10 ) THEN 
     1205            fbdata%ivlqc(1,jo,1) = 4 
     1206            fbdata%ivlqcf(1,1,jo,1) = 0 
     1207            fbdata%ivlqcf(2,1,jo,1) = spmdata%nqc(jo) - 10 
     1208         ELSE 
     1209            fbdata%ivlqc(1,jo,1) = MAX(spmdata%nqc(jo),1) 
     1210            fbdata%ivlqcf(:,1,jo,1) = 0 
     1211         ENDIF 
     1212         fbdata%iobsk(1,jo,1)  = 0 
     1213         DO ja = 1, nadd 
     1214            fbdata%padd(1,jo,1+ja,1) = & 
     1215               & spmdata%rext(jo,padd%ipoint(ja)) 
     1216         END DO 
     1217         DO je = 1, next 
     1218            fbdata%pext(1,jo,je) = & 
     1219               & spmdata%rext(jo,pext%ipoint(je)) 
     1220         END DO 
     1221 
     1222      END DO 
     1223 
     1224      ! Write the obfbdata structure 
     1225      CALL write_obfbdata( cfname, fbdata ) 
     1226       
     1227      ! Output some basic statistics 
     1228      CALL obs_wri_stats( fbdata ) 
     1229 
     1230      CALL dealloc_obfbdata( fbdata ) 
     1231 
     1232   END SUBROUTINE obs_wri_spm 
     1233 
    10831234   SUBROUTINE obs_wri_stats( fbdata ) 
    10841235      !!----------------------------------------------------------------------- 
  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obsspm_io.h90

    r6854 r6855  
    55   !!---------------------------------------------------------------------- 
    66 
    7    SUBROUTINE read_logchl( cdfilename, inpfile, kunit, ldwp, ldgrid ) 
     7   SUBROUTINE read_spm( cdfilename, inpfile, kunit, ldwp, ldgrid ) 
    88      !!--------------------------------------------------------------------- 
    99      !! 
    10       !!                     ** ROUTINE read_logchl ** 
    11       !! 
    12       !! ** Purpose : Read from file the logchl observations. 
     10      !!                     ** ROUTINE read_spm ** 
     11      !! 
     12      !! ** Purpose : Read from file the spm observations. 
    1313      !! 
    1414      !! ** Method  : The data file is a NetCDF file.  
     
    2828      LOGICAL          :: ldgrid     ! Save grid info in data structure 
    2929      !! * Local declarations 
    30       CHARACTER(LEN=12),PARAMETER :: cpname = 'read_logchl' 
     30      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_spm' 
    3131      INTEGER :: i_file_id    ! netcdf IDS 
    3232      INTEGER :: i_time_id 
     
    4141         & i_dtime, &       ! Offset in seconds since reference time 
    4242         & i_qc,    &       ! Quality control flag. 
    43          & i_type           ! Type of logchl measurement.             
     43         & i_type           ! Type of spm measurement.             
    4444      REAL(wp), DIMENSION(:), POINTER :: & 
    4545         & z_phi,   &       ! Latitudes 
    4646         & z_lam            ! Longitudes 
    4747      REAL(wp), DIMENSION(:,:), POINTER :: & 
    48          & z_logchl         ! logchl data      
     48         & z_spm         ! spm data      
    4949      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file 
    5050      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file 
     
    9494         & z_phi        ( i_data                 ), &    
    9595         & z_lam        ( i_data                 ), &   
    96          & z_logchl        ( i_data,i_time  )  & 
     96         & z_spm        ( i_data,i_time  )  & 
    9797         & ) 
    9898       
     
    124124      ! Get list of times for each ob in seconds relative to reference time 
    125125       
    126       CALL chkerr( nf90_inq_varid( i_file_id, 'LogChl_dtime', i_var_id ), &  
     126      CALL chkerr( nf90_inq_varid( i_file_id, 'spm_dtime', i_var_id ), &  
    127127         &       cpname, __LINE__ ) 
    128128      idims(1) = i_data 
     
    164164         &         cpname, __LINE__ ) 
    165165       
    166       ! Get logchl data 
    167        
    168       CALL chkerr( nf90_inq_varid( i_file_id, 'LogChl', & 
     166      ! Get spm data 
     167       
     168      CALL chkerr( nf90_inq_varid( i_file_id, 'spm', & 
    169169         &                         i_var_id ), &  
    170170         &         cpname, __LINE__ ) 
     
    172172      idims(2) = i_time 
    173173      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ ) 
    174       CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_logchl), & 
     174      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_spm), & 
    175175         &       cpname, __LINE__ ) 
    176176      zoff = 0. 
     
    192192            &                       "_FillValue",zfill), cpname, __LINE__ ) 
    193193      ENDIF 
    194       WHERE(z_logchl(:,:) /=  zfill) 
    195          z_logchl(:,:) = (zsca * z_logchl(:,:)) + zoff 
     194      WHERE(z_spm(:,:) /=  zfill) 
     195         z_spm(:,:) = (zsca * z_spm(:,:)) + zoff 
    196196      ELSEWHERE 
    197          z_logchl(:,:) = fbrmdi 
     197         z_spm(:,:) = fbrmdi 
    198198      END WHERE 
    199199       
     
    208208            &       cpname, __LINE__ ) 
    209209       
    210       ! Get logchl obs type 
     210      ! Get spm obs type 
    211211       
    212212      i_type(:,:)=1 
     
    223223      CALL init_obfbdata( inpfile ) 
    224224      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid ) 
    225       inpfile%cname(1) = 'LOGCHL' 
     225      inpfile%cname(1) = 'spm' 
    226226 
    227227      ! Fill the obfbdata structure from input data 
     
    233233            iobs = iobs + 1 
    234234            ! Characters 
    235             WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'logchl','  ' 
     235            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'spm','  ' 
    236236            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim) 
    237237            ! Real values 
    238238            inpfile%plam(iobs)         = z_lam(jobs) 
    239239            inpfile%pphi(iobs)         = z_phi(jobs) 
    240             inpfile%pob(1,iobs,1)      = z_logchl(jobs,jtim) 
     240            inpfile%pob(1,iobs,1)      = z_spm(jobs,jtim) 
    241241            inpfile%ptim(iobs)         = & 
    242242               & REAL(i_reftime(jtim))/(60.*60.*24.) + & 
     
    245245            ! Integers 
    246246            inpfile%kindex(iobs)       = iobs 
    247             IF ( z_logchl(jobs,jtim) == fbrmdi ) THEN 
     247            IF ( z_spm(jobs,jtim) == fbrmdi ) THEN 
    248248               inpfile%ioqc(iobs)      = 4 
    249249               inpfile%ivqc(iobs,1)    = 4  
     
    266266      END DO 
    267267 
    268    END SUBROUTINE read_logchl 
    269  
    270  
     268   END SUBROUTINE read_spm 
     269 
     270 
Note: See TracChangeset for help on using the changeset viewer.