Changeset 15180 for NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_bias.F90

Timestamp:

2021-08-11T13:24:27+02:00 (3 years ago)

Author:

dford

Message:

Further generification, particularly surrounding additional and extra variables.

File:

• NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_bias.F90 (moved) (moved from NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_sstbias.F90) (14 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_bias.F90

@@ -1 @@
-MODULE obs_sstbias
+MODULE obs_bias
    !!======================================================================
-   !!                       ***  MODULE obs_sstbias  ***
-   !! Observation diagnostics: Read the bias for SST data
+   !!                       ***  MODULE obs_bias  ***
+   !! Observation diagnostics: Read the bias for observation data
    !!======================================================================
    !!----------------------------------------------------------------------
-   !!   obs_app_sstbias : Driver for reading and applying the SST bias
+   !!   obs_app_bias : Driver for reading and applying the bias
    !!----------------------------------------------------------------------
    !! * Modules used   
    USE par_kind, ONLY : &       ! Precision variables
-      & wp, &
-      & dp, &
-      & sp
+      & wp
    USE par_oce, ONLY : &        ! Domain parameters
       & jpi, &
-      & jpj, &
-      & jpim1
+      & jpj
    USE in_out_manager, ONLY : & ! I/O manager
       & lwp,    &
@@ -22 +19 @@
    USE dom_oce, ONLY : &        ! Domain variables
       & tmask, &
-      & tmask_i, &
-      & e1t,   &
-      & e2t,   &
       & gphit, &
       & glamt
-   USE oce, ONLY : &           ! Model variables
-      & sshn
    USE obs_inter_h2d
    USE obs_utils               ! Various observation tools
@@ -35 +27 @@
    !! * Routine accessibility
    PRIVATE
-   PUBLIC obs_app_sstbias     ! Read the altimeter bias
+   PUBLIC obs_app_bias     ! Read the observation bias
 CONTAINS
-   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, &
-                               cl_bias_files )
+   SUBROUTINE obs_app_bias( obsdata, kvar, k2dint, knumtypes, &
+                            cl_bias_files, cd_biasname )
       !!---------------------------------------------------------------------
       !!
-      !!                   *** ROUTINE obs_app_sstbias ***
-      !!
-      !! ** Purpose : Read SST bias data from files and apply correction to
-      !!             observations
+      !!                   *** ROUTINE obs_app_bias ***
+      !!
+      !! ** Purpose : Read bias data from files and apply correction to
+      !!              observations
       !!
       !! ** Method  :
@@ -54 +46 @@
       !! History : 
       !!      ! :  2014-08 (J. While) Bias correction code for SST obs,
-      !!      !                      based on obs_rea_altbias
+      !!      !                       based on obs_rea_altbias
+      !!      ! :  2021-07 (D. Ford)  Renamed obs_app_bias and made generic
       !!----------------------------------------------------------------------
       !! * Modules used
@@ -61 +54 @@
       !! * Arguments
 
-      TYPE(obs_surf), INTENT(INOUT) :: sstdata       ! SST data
+      TYPE(obs_surf), INTENT(INOUT) :: obsdata       ! Observation data
+      INTEGER, INTENT(IN) :: kvar    ! Index of obs type being bias corrected
       INTEGER, INTENT(IN) :: k2dint
       INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in
       CHARACTER(LEN=128), DIMENSION(knumtypes), INTENT(IN) :: &
                           cl_bias_files !List of files to read
+      CHARACTER(LEN=128), INTENT(IN) :: cd_biasname  !Variable name in file
       !! * Local declarations
       INTEGER :: jobs         ! Obs loop variable
-      INTEGER :: jpisstbias   ! Number of grid point in latitude for the bias
-      INTEGER :: jpjsstbias   ! Number of grid point in longitude for the bias
       INTEGER :: iico         ! Grid point indices
       INTEGER :: ijco
       INTEGER :: jt
-      INTEGER :: i_nx_id      ! Index to read the NetCDF file
-      INTEGER :: i_ny_id      !
-      INTEGER :: i_file_id    !
-      INTEGER :: i_var_id
       INTEGER, DIMENSION(knumtypes) :: &
          & ibiastypes             ! Array of the bias types in each file
       REAL(wp), DIMENSION(jpi,jpj,knumtypes) :: & 
-         & z_sstbias              ! Array to store the SST bias values
+         & z_obsbias              ! Array to store the bias values
       REAL(wp), DIMENSION(jpi,jpj) :: & 
-         & z_sstbias_2d           ! Array to store the SST bias values   
+         & z_obsbias_2d           ! Array to store the bias values   
       REAL(wp), DIMENSION(1) :: &
          & zext, &
@@ -105 +94 @@
          & igrdi_tmp, &
          & igrdj_tmp   
-      INTEGER :: numsstbias
+      INTEGER :: numobsbias
       INTEGER(KIND=NF90_INT) :: ifile_source
      
@@ -113 +102 @@
       INTEGER :: inumtype
       IF(lwp)WRITE(numout,*) 
-      IF(lwp)WRITE(numout,*) 'obs_rea_sstbias : '
+      IF(lwp)WRITE(numout,*) 'obs_app_bias : '
       IF(lwp)WRITE(numout,*) '----------------- '
-      IF(lwp)WRITE(numout,*) 'Read SST bias '
+      IF(lwp)WRITE(numout,*) 'Read observation bias for ', TRIM(obsdata%cvars(kvar))
       ! Open and read the files
-      z_sstbias(:,:,:)=0.0_wp
+      z_obsbias(:,:,:)=0.0_wp
       DO jtype = 1, knumtypes
      
-         numsstbias=0
+         numobsbias=0
          IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype)
-         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )       
-         IF (numsstbias > 0) THEN
+         CALL iom_open( cl_bias_files(jtype), numobsbias, ldstop=.FALSE. )       
+         IF (numobsbias > 0) THEN
      
             !Read the bias type from the file
@@ -130 +119 @@
             !routines directly - should be upgraded in the future
             iret=NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile)
-            iret=NF90_GET_ATT( incfile, NF90_GLOBAL, "SST_source", &
+            iret=NF90_GET_ATT( incfile, NF90_GLOBAL, TRIM(obsdata%cvars(kvar))//"_source", &
                               ifile_source )
             ibiastypes(jtype) = ifile_source                 
@@ -136 +125 @@
            
             IF ( iret /= 0  ) CALL ctl_stop( &
-               'obs_rea_sstbias : Cannot read bias type from file '// &
+               'obs_app_bias : Cannot read bias type from file '// &
                cl_bias_files(jtype) )
-            ! Get the SST bias data
-            CALL iom_get( numsstbias, jpdom_data, 'tn', z_sstbias_2d(:,:), 1 )
-            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)       
+            ! Get the bias data
+            CALL iom_get( numobsbias, jpdom_data, TRIM(cd_biasname), z_obsbias_2d(:,:), 1 )
+            z_obsbias(:,:,jtype) = z_obsbias_2d(:,:)       
             ! Close the file
-            CALL iom_close(numsstbias)       
+            CALL iom_close(numobsbias)       
          ELSE
-            CALL ctl_stop('obs_read_sstbias: File '// & 
+            CALL ctl_stop('obs_app_bias: File '// & 
                            TRIM( cl_bias_files(jtype) )//' Not found')
          ENDIF
@@ -151 +140 @@
       ! Interpolate the bias already on the model grid at the observation point
       ALLOCATE( &
-         & igrdi(2,2,sstdata%nsurf), &
-         & igrdj(2,2,sstdata%nsurf), &
-         & zglam(2,2,sstdata%nsurf), &
-         & zgphi(2,2,sstdata%nsurf), &
-         & zmask(2,2,sstdata%nsurf)  )
+         & igrdi(2,2,obsdata%nsurf), &
+         & igrdj(2,2,obsdata%nsurf), &
+         & zglam(2,2,obsdata%nsurf), &
+         & zgphi(2,2,obsdata%nsurf), &
+         & zmask(2,2,obsdata%nsurf)  )
        
-      DO jobs = 1, sstdata%nsurf 
-         igrdi(1,1,jobs) = sstdata%mi(jobs)-1
-         igrdj(1,1,jobs) = sstdata%mj(jobs)-1
-         igrdi(1,2,jobs) = sstdata%mi(jobs)-1
-         igrdj(1,2,jobs) = sstdata%mj(jobs)
-         igrdi(2,1,jobs) = sstdata%mi(jobs)
-         igrdj(2,1,jobs) = sstdata%mj(jobs)-1
-         igrdi(2,2,jobs) = sstdata%mi(jobs)
-         igrdj(2,2,jobs) = sstdata%mj(jobs)
+      DO jobs = 1, obsdata%nsurf 
+         igrdi(1,1,jobs) = obsdata%mi(jobs)-1
+         igrdj(1,1,jobs) = obsdata%mj(jobs)-1
+         igrdi(1,2,jobs) = obsdata%mi(jobs)-1
+         igrdj(1,2,jobs) = obsdata%mj(jobs)
+         igrdi(2,1,jobs) = obsdata%mi(jobs)
+         igrdj(2,1,jobs) = obsdata%mj(jobs)-1
+         igrdi(2,2,jobs) = obsdata%mi(jobs)
+         igrdj(2,2,jobs) = obsdata%mj(jobs)
       END DO
-      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+      CALL obs_int_comm_2d( 2, 2, obsdata%nsurf, jpi, jpj, &
          &                  igrdi, igrdj, glamt, zglam )
-      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+      CALL obs_int_comm_2d( 2, 2, obsdata%nsurf, jpi, jpj, &
          &                  igrdi, igrdj, gphit, zgphi )
-      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+      CALL obs_int_comm_2d( 2, 2, obsdata%nsurf, jpi, jpj, &
          &                  igrdi, igrdj, tmask(:,:,1), zmask )
       DO jtype = 1, knumtypes
          
          !Find the number observations of type and allocate tempory arrays
-         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) )
+         inumtype = COUNT( obsdata%ntyp(:) == ibiastypes(jtype) )
          ALLOCATE( &
             & igrdi_tmp(2,2,inumtype), &
@@ -185 +174 @@
             & zbias( 2,2,inumtype ) )
          jt=1
-         DO jobs = 1, sstdata%nsurf 
-            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+         DO jobs = 1, obsdata%nsurf 
+            IF ( obsdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
                igrdi_tmp(:,:,jt) = igrdi(:,:,jobs) 
                igrdj_tmp(:,:,jt) = igrdj(:,:,jobs)
@@ -198 +187 @@
          CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, &
                &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), &
-               &           z_sstbias(:,:,jtype), zbias(:,:,:) )
+               &           z_obsbias(:,:,jtype), zbias(:,:,:) )
          jt=1
-         DO jobs = 1, sstdata%nsurf
-            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
-               zlam = sstdata%rlam(jobs)
-               zphi = sstdata%rphi(jobs)
-               iico = sstdata%mi(jobs)
-               ijco = sstdata%mj(jobs)         
+         DO jobs = 1, obsdata%nsurf
+            IF ( obsdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+               zlam = obsdata%rlam(jobs)
+               zphi = obsdata%rphi(jobs)
+               iico = obsdata%mi(jobs)
+               ijco = obsdata%mj(jobs)         
                CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
                   &                   zglam_tmp(:,:,jt), &
@@ -211 +200 @@
                   &                   zmask_tmp(:,:,jt), zweig, zobsmask )
                CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext )
-               ! adjust sst with bias field
-               sstdata%robs(jobs,1) = sstdata%robs(jobs,1) - zext(1)
+               ! adjust observations with bias field
+               obsdata%robs(jobs,kvar) = obsdata%robs(jobs,kvar) - zext(1)
                jt=jt+1
             ENDIF
@@ -235 +224 @@
       IF(lwp) THEN
          WRITE(numout,*) " "
-         WRITE(numout,*) "SST bias correction applied successfully"
+         WRITE(numout,*) "Bias correction applied successfully"
          WRITE(numout,*) "Obs types: ",ibiastypes(:), &
                               " Have all been bias corrected\n"
       ENDIF
-   END SUBROUTINE obs_app_sstbias
+   END SUBROUTINE obs_app_bias
  
-END MODULE obs_sstbias
+END MODULE obs_bias