Changeset 15799 for NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_readmdt.F90

Timestamp:

2022-04-25T17:15:21+02:00 (2 years ago)

Author:

dford

Message:

More generic interface and structure for OBS code. See Met Office utils tickets 471 and 530.

File:

• NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_readmdt.F90 (modified) (9 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_readmdt.F90

@@ -31 +31 @@
    
    PUBLIC   obs_rea_mdt     ! called by dia_obs_init
-   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt
-
-   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme
-   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction
-   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction
 
    !!----------------------------------------------------------------------
@@ -44 +39 @@
 CONTAINS
 
-   SUBROUTINE obs_rea_mdt( sladata, k2dint )
+   SUBROUTINE obs_rea_mdt( sladata, k2dint, kmdt, nn_msshc, rn_mdtcorr, &
+                           rn_mdtcutoff )
       !!---------------------------------------------------------------------
       !!
@@ -57 +53 @@
       USE iom
       !
-      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data
-      INTEGER       , INTENT(in)    ::   k2dint    ! ?
+      TYPE(obs_surf), INTENT(inout) :: sladata      ! SLA data
+      INTEGER       , INTENT(in)    :: k2dint       ! Interpolation type
+      INTEGER       , INTENT(in)    :: kmdt         ! Index of MDT extra var
+      INTEGER       , INTENT(in)    :: nn_msshc     ! MDT correction scheme
+      REAL(wp)      , INTENT(in)    :: rn_mdtcorr   ! User specified MDT correction
+      REAL(wp)      , INTENT(in)    :: rn_mdtcutoff ! MDT cutoff for computed correction
       !
       CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
@@ -105 +105 @@
 
       ! Remove the offset between the MDT used with the sla and the model MDT
-      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) &
-         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill )
-
-      ! Intepolate the MDT already on the model grid at the observation point
-  
+      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) THEN
+         CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill, nn_msshc, &
+            &                 rn_mdtcorr, rn_mdtcutoff )
+      ENDIF
+
+      ! Interpolate the MDT already on the model grid at the observation point
+
       ALLOCATE( &
          & igrdi(2,2,sladata%nsurf), &
@@ -118 +120 @@
          & zmdtl(2,2,sladata%nsurf)  &
          & )
-         
+
       DO jobs = 1, sladata%nsurf
 
@@ -147 +149 @@
             
          CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
- 
-         sladata%rext(jobs,2) = zext(1)
+
+         sladata%rext(jobs,kmdt) = zext(1)
 
 ! mark any masked data with a QC flag
          IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = IBSET(sladata%nqc(jobs),15)
 
-         END DO
-         
+      END DO
+
       DEALLOCATE( &
          & igrdi, &
@@ -169 +171 @@
 
 
-   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill )
+   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill, nn_msshc, rn_mdtcorr, &
+                              rn_mdtcutoff )
       !!---------------------------------------------------------------------
       !!
@@ -183 +186 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(IN) ::  kpi, kpj
-      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid
-      REAL(wp)                    , INTENT(IN   ) ::   zfill 
+      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: mdt          ! MDT used on the model grid
+      REAL(wp)                    , INTENT(IN   ) :: zfill        ! Fill value
+      INTEGER                     , INTENT(IN   ) :: nn_msshc     ! MDT correction scheme
+      REAL(wp)                    , INTENT(IN   ) :: rn_mdtcorr   ! User specified MDT correction
+      REAL(wp)                    , INTENT(IN   ) :: rn_mdtcutoff ! MDT cutoff for computed correction
       ! 
       INTEGER  :: ji, jj
@@ -246 +252 @@
          WRITE(numout,*) '               zcorr         = ', zcorr
          WRITE(numout,*) '               nn_msshc        = ', nn_msshc
+
+         IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
+         IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
+         IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
       ENDIF
-
-      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
-      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
-      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
 
       !