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 6856 for branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90 – NEMO

Ignore:
Timestamp:
2016-08-08T17:22:29+02:00 (8 years ago)
Author:
dford
Message:

Initial implementation of observation operator for fCO2.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r6855 r6856  
    3232   USE obs_read_logchl          ! Reading and allocation of logchl observations 
    3333   USE obs_read_spm             ! Reading and allocation of spm observations 
     34   USE obs_read_fco2            ! Reading and allocation of fco2 observations 
    3435   USE obs_prep                 ! Preparation of obs. (grid search etc). 
    3536   USE obs_oper                 ! Observation operators 
    … …  
    4546   USE obs_logchl               ! logchl data storage 
    4647   USE obs_spm                  ! spm data storage 
     48   USE obs_fco2                 ! fco2 data storage 
    4749   USE obs_types                ! Definitions for observation types 
    4850   USE mpp_map                  ! MPP mapping 
    … …  
    9092   LOGICAL, PUBLIC :: ln_spm         !: Logical switch for spm 
    9193   LOGICAL, PUBLIC :: ln_spmfb       !: Logical switch for spm from feedback files 
     94   LOGICAL, PUBLIC :: ln_fco2        !: Logical switch for fco2 
     95   LOGICAL, PUBLIC :: ln_fco2fb      !: Logical switch for fco2 from feedback files 
    9296   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
    9397   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
    … …  
    177181      CHARACTER(len=128) :: spmfiles(MaxNumFiles) 
    178182      CHARACTER(len=128) :: spmfbfiles(MaxNumFiles) 
     183      CHARACTER(len=128) :: fco2files(MaxNumFiles) 
     184      CHARACTER(len=128) :: fco2fbfiles(MaxNumFiles) 
    179185      CHARACTER(LEN=128) :: reysstname 
    180186      CHARACTER(LEN=12)  :: reysstfmt 
    … …  
    205211         &            ln_spm, ln_spmfb,                               & 
    206212         &            spmfiles, spmfbfiles,                           & 
     213         &            ln_fco2, ln_fco2fb,                             & 
     214         &            fco2files, fco2fbfiles,                         & 
    207215         &            ln_profb_enatim, ln_ignmis, ln_cl4,             & 
    208216         &            ln_sstbias, sstbias_files 
    … …  
    230238      INTEGER :: jnumspm 
    231239      INTEGER :: jnumspmfb 
     240      INTEGER :: jnumfco2 
     241      INTEGER :: jnumfco2fb 
    232242      INTEGER :: ji 
    233243      INTEGER :: jset 
    … …  
    243253      ln_spm      = .FALSE. 
    244254      ln_spmfb    = .FALSE. 
     255      ln_fco2     = .FALSE. 
     256      ln_fco2fb   = .FALSE. 
    245257       
    246258      !Initalise all values in namelist arrays 
    … …  
    267279      spmfiles(:) = '' 
    268280      spmfbfiles(:) = '' 
     281      fco2files(:) = '' 
     282      fco2fbfiles(:) = '' 
    269283      sstbias_files(:) = '' 
    270284      endailyavtypes(:) = -1 
    … …  
    385399         WHERE (spmfbfiles(:) /= '') lmask(:) = .TRUE. 
    386400         jnumspmfb = COUNT(lmask) 
     401      ENDIF 
     402      IF (ln_fco2) THEN 
     403         lmask(:) = .FALSE. 
     404         WHERE (fco2files(:) /= '') lmask(:) = .TRUE. 
     405         jnumfco2 = COUNT(lmask) 
     406      ENDIF 
     407      IF (ln_fco2fb) THEN 
     408         lmask(:) = .FALSE. 
     409         WHERE (fco2fbfiles(:) /= '') lmask(:) = .TRUE. 
     410         jnumfco2fb = COUNT(lmask) 
    387411      ENDIF 
    388412       
    … …  
    420444         WRITE(numout,*) '             Logical switch for spm observations                ln_spm = ', ln_spm 
    421445         WRITE(numout,*) '             Logical switch for feedback spm data             ln_spmfb = ', ln_spmfb 
     446         WRITE(numout,*) '             Logical switch for fco2 observations              ln_fco2 = ', ln_fco2 
     447         WRITE(numout,*) '             Logical switch for feedback fco2 data           ln_fco2fb = ', ln_fco2fb 
    422448         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global 
    423449         WRITE(numout,*) & 
    … …  
    540566               WRITE(numout,'(1X,2A)') '             Feedback spm input observation file name   spmfbfiles = ', & 
    541567                  TRIM(spmfbfiles(ji)) 
     568            END DO 
     569         ENDIF 
     570         IF (ln_fco2) THEN 
     571            DO ji = 1, jnumfco2 
     572               WRITE(numout,'(1X,2A)') '             fco2 input observation file name  fco2files = ', & 
     573                  TRIM(fco2files(ji)) 
     574            END DO 
     575         ENDIF 
     576         IF (ln_fco2fb) THEN 
     577            DO ji = 1, jnumfco2fb 
     578               WRITE(numout,'(1X,2A)') '             Feedback fco2 input observation file name  fco2fbfiles = ', & 
     579                  TRIM(fco2fbfiles(ji)) 
    542580            END DO 
    543581         ENDIF 
    … …  
    577615         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 
    578616         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ).AND. & 
    579          & ( .NOT. ln_spm ) ) THEN 
     617         & ( .NOT. ln_spm ).AND.( .NOT. ln_fco2 ) ) THEN 
    580618         IF(lwp) WRITE(numout,cform_war) 
    581619         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 
    582620            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 
    583             &                    ' ln_logchl, ln_spm are all set to .FALSE.' 
     621            &                    ' ln_logchl, ln_spm, ln_fco2 are all set to .FALSE.' 
    584622         nwarn = nwarn + 1 
    585623      ENDIF 
    … …  
    11891227  
    11901228      ENDIF 
     1229 
     1230      !  - fco2 
     1231       
     1232      IF ( ln_fco2 ) THEN 
     1233 
     1234         ! Set the number of variables for fco2 to 1 
     1235         nfco2vars = 1 
     1236 
     1237         ! Set the number of extra variables for fco2 to 0 
     1238         nfco2extr = 0 
     1239          
     1240         IF ( ln_fco2fb ) THEN 
     1241            nfco2sets = jnumfco2fb 
     1242         ELSE 
     1243            nfco2sets = 1 
     1244         ENDIF 
     1245 
     1246         ALLOCATE(fco2data(nfco2sets)) 
     1247         ALLOCATE(fco2datqc(nfco2sets)) 
     1248         fco2data(:)%nsurf=0 
     1249         fco2datqc(:)%nsurf=0 
     1250 
     1251         nfco2sets = 0 
     1252 
     1253         IF ( ln_fco2fb ) THEN             ! Feedback file format 
     1254 
     1255            DO jset = 1, jnumfco2fb 
     1256             
     1257               nfco2sets = nfco2sets + 1 
     1258 
     1259               CALL obs_rea_fco2( 0, fco2data(nfco2sets), 1, & 
     1260                  &                 fco2fbfiles(jset:jset), & 
     1261                  &                 nfco2vars, nfco2extr, nitend-nit000+2, & 
     1262                  &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
     1263 
     1264               CALL obs_pre_fco2( fco2data(nfco2sets), fco2datqc(nfco2sets), & 
     1265                  &                 ln_fco2, ln_nea ) 
     1266             
     1267            ENDDO 
     1268 
     1269         ELSE                              ! Original file format 
     1270 
     1271            nfco2sets = nfco2sets + 1 
     1272 
     1273            CALL obs_rea_fco2( 1, fco2data(nfco2sets), jnumfco2, & 
     1274               &                 fco2files(1:jnumfco2), & 
     1275               &                 nfco2vars, nfco2extr, nitend-nit000+2, & 
     1276               &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
     1277 
     1278            CALL obs_pre_fco2( fco2data(nfco2sets), fco2datqc(nfco2sets), & 
     1279               &                 ln_fco2, ln_nea ) 
     1280 
     1281         ENDIF 
     1282  
     1283      ENDIF 
    11911284      
    11921285   END SUBROUTINE dia_obs_init 
    … …  
    12081301      !!               - Sea surface log10(chlorophyll) 
    12091302      !!               - Sea surface spm 
     1303      !!               - Sea surface fco2 
    12101304      !! 
    12111305      !! ** Action  :  
    … …  
    12461340#endif 
    12471341#if defined key_hadocc 
    1248       USE trc, ONLY :  &                ! HadOCC chlorophyll 
     1342      USE trc, ONLY :  &                ! HadOCC chlorophyll and fCO2 
    12491343         & HADOCC_CHL, & 
     1344         & HADOCC_FCO2, & 
    12501345         & HADOCC_FILL_FLT 
    12511346#elif defined key_medusa && defined key_foam_medusa 
    1252       USE trc, ONLY :  &                ! MEDUSA chlorophyll 
     1347      USE trc, ONLY :  &                ! MEDUSA chlorophyll and fCO2 
    12531348         & MEDUSA_CHL, & 
     1349         & MEDUSA_FCO2, & 
    12541350         & MEDUSA_FILL_FLT 
    12551351#elif defined key_fabm 
    1256       !USE ???                           ! ERSEM chlorophyll 
     1352      !USE ???                           ! ERSEM chlorophyll and fCO2 
    12571353#endif 
    12581354#if defined key_spm 
    … …  
    12731369      INTEGER :: jlogchlset             ! logchl data set loop variable 
    12741370      INTEGER :: jspmset                ! spm data set loop variable 
     1371      INTEGER :: jfco2set               ! fco2 data set loop variable 
    12751372      INTEGER :: jvar                   ! Variable number     
    12761373#if ! defined key_lim2 && ! defined key_lim3 
    … …  
    12841381      REAL(wp), DIMENSION(jpi,jpj) :: & 
    12851382         spm                            ! array for spm 
     1383      REAL(wp), DIMENSION(jpi,jpj) :: & 
     1384         fco2                           ! array for fco2 
     1385      REAL(wp), DIMENSION(jpi,jpj) :: & 
     1386         maskfco2                       ! array for special fco2 mask 
    12861387      INTEGER :: jn                     ! loop index 
    12871388      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    … …  
    14451546      ENDIF 
    14461547 
     1548      IF ( ln_fco2 ) THEN 
     1549         maskfco2(:,:) = tmask(:,:,1)         ! create a special mask to exclude certain things 
     1550#if defined key_hadocc 
     1551         fco2(:,:) = HADOCC_FCO2(:,:)    ! fCO2 from HadOCC 
     1552         IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ).AND.( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN 
     1553            fco2(:,:) = obfillflt 
     1554            maskfco2(:,:) = 0 
     1555            CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', & 
     1556               &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     1557               &           ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' ) 
     1558         ENDIF 
     1559#elif defined key_medusa && defined key_foam_medusa 
     1560         fco2(:,:) = MEDUSA_FCO2(:,:)    ! fCO2 from MEDUSA 
     1561         IF ( ( MINVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ).AND.( MAXVAL( MEDUSA_FCO2 ) == MEDUSA_FILL_FLT ) ) THEN 
     1562            fco2(:,:) = obfillflt 
     1563            maskfco2(:,:) = 0 
     1564            CALL ctl_warn( ' MEDUSA fCO2 values masked out for observation operator', & 
     1565               &           ' on timestep ' // TRIM(STR(kstp)),                              & 
     1566               &           ' as MEDUSA_FCO2(:,:) == MEDUSA_FILL_FLT' ) 
     1567         ENDIF 
     1568#elif defined key_fabm 
     1569         !fco2(:,:)  =  ???                 ! fCO2 from ERSEM 
     1570         CALL ctl_stop( ' Trying to run fco2 observation operator', & 
     1571            &           ' but not properly implemented for FABM-ERSEM yet' ) 
     1572#else 
     1573         CALL ctl_stop( ' Trying to run fco2 observation operator', & 
     1574            &           ' but no biogeochemical model appears to have been defined' ) 
     1575#endif 
     1576 
     1577         DO jfco2set = 1, nfco2sets 
     1578             CALL obs_fco2_opt( fco2datqc(jfco2set),                      & 
     1579               &                kstp, jpi, jpj, nit000, fco2(:,:), & 
     1580               &                maskfco2(:,:), n2dint ) 
     1581         END DO 
     1582      ENDIF 
     1583 
    14471584#if ! defined key_lim2 && ! defined key_lim3 
    14481585      CALL wrk_dealloc(jpi,jpj,frld)  
    … …  
    14791616      INTEGER :: jlogchlset               ! logchl data set loop variable 
    14801617      INTEGER :: jspmset                  ! spm data set loop variable 
     1618      INTEGER :: jfco2set                 ! fco2 data set loop variable 
    14811619      INTEGER :: jset 
    14821620      INTEGER :: jfbini 
    … …  
    17711909            WRITE(cdtmp,'(A,I2.2)')'spmfb_',jspmset 
    17721910            CALL obs_wri_spm( cdtmp, spmdata(jspmset) ) 
     1911 
     1912         END DO 
     1913 
     1914      ENDIF 
     1915 
     1916      !  - fco2 
     1917      IF ( ln_fco2 ) THEN 
     1918 
     1919         ! Copy data from fco2datqc to fco2data structures 
     1920         DO jfco2set = 1, nfco2sets 
     1921 
     1922            CALL obs_surf_decompress( fco2datqc(jfco2set), & 
     1923                 &                    fco2data(jfco2set), .TRUE., numout ) 
     1924 
     1925         END DO 
     1926          
     1927         ! Mark as bad observations with no valid model counterpart due to fCO2 not being in the restart 
     1928         ! Seem to need to set to fill value rather than marking as bad to be effective, so do both 
     1929         DO jfco2set = 1, nfco2sets 
     1930            WHERE ( fco2data(jfco2set)%rmod(:,1) == obfillflt ) 
     1931               fco2data(jfco2set)%nqc(:)    = 1 
     1932               fco2data(jfco2set)%robs(:,1) = obfillflt 
     1933            END WHERE 
     1934         END DO 
     1935 
     1936         ! Write the fco2 data 
     1937         DO jfco2set = 1, nfco2sets 
     1938       
     1939            WRITE(cdtmp,'(A,I2.2)')'fco2fb_',jfco2set 
     1940            CALL obs_wri_fco2( cdtmp, fco2data(jfco2set) ) 
    17731941 
    17741942         END DO 
Note: See TracChangeset for help on using the changeset viewer.