Index: /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx_adj.F90
===================================================================
--- /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx_adj.F90	(revision 5881)
+++ /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx_adj.F90	(revision 5881)
@@ -0,0 +1,227 @@
+MODULE sbcflx_adj
+   !!======================================================================
+   !!                       ***  MODULE  sbcflx_adj  ***
+   !! Surface module :  flux adjustment of heat/freshwater. Add qrp/erp obtained from sbcssr
+   !!======================================================================
+   !! History :  0.0  !  2015-10-14  (K. Yamazaki)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_flx_adj       : add qrp/erp to sbc to perform flux adjustment
+   !!   sbc_flx_adj_init  : initialisation of flux adjustment
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition
+   USE phycst         ! physical constants
+   USE sbcrnf         ! surface boundary condition : runoffs
+   !
+   USE fldread        ! read input fields
+   USE iom            ! I/O manager
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_flx_adj        ! routine called in sbcmod
+   PUBLIC   sbc_flx_adj_init   ! routine called in sbcmod
+
+   !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s]
+   !ky!REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2]
+
+   !                                   !!* Namelist namsbc_flx_adj *
+   INTEGER, PUBLIC ::   nn_flxadjht     ! Heat/freshwater flux adjustment indicator
+   INTEGER, PUBLIC ::   nn_flxadjfw     ! Heat/freshwater flux adjustment indicator
+   REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS
+   REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS
+   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
+   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
+
+   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_erp   ! structure of input erp (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qrp   ! structure of input qrp (file informations, fields read)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: sbcssr.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_flx_adj( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_flx_adj  ***
+      !!
+      !! ** Purpose :   Add to heat and/or freshwater fluxes a qrp and/or erp
+      !!                to flux adjust temperature/salinity 
+      !!
+      !! ** Method  : - Read namelist namsbc_flx_adj
+      !!              - Read calculated qrp and/or erp
+      !!              - at each nscb time step
+      !!                   add qrp on qns    (nn_flxadjht = 1)
+      !!                   add erp on sfx        (nn_flxadjfw = 1)
+      !!                   add erp on emp        (nn_flxadjfw = 2)
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zerp     ! local scalar for evaporation damping
+      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
+      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
+      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
+      INTEGER  ::   ierror   ! return error code
+      !!
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_qrp, sn_erp        ! informations about the fields to be read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_flx_adj')
+      !
+      IF( nn_flxadjht + nn_flxadjfw /= 0 ) THEN
+         !
+         IF( nn_flxadjht == 1)   CALL fld_read( kt, nn_fsbc, sf_qrp )   ! Read qrp data and provides it at kt
+         IF( nn_flxadjfw >= 1)   CALL fld_read( kt, nn_fsbc, sf_erp )   ! Read erp data and provides it at kt
+         !
+         !                                         ! ========================= !
+         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
+            !                                      ! ========================= !
+            !
+            IF( nn_flxadjht == 1 ) THEN                                   !* Anomalous heat flux term (qrp)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zqrp = sf_qrp(1)%fnow(ji,jj,1)
+                     qns(ji,jj) = qns(ji,jj) + zqrp
+                  END DO
+               END DO
+            !ky!   CALL iom_put( "qrp", qrp )                             ! heat flux damping
+            ENDIF
+            !
+            IF( nn_flxadjfw == 1 ) THEN                               !* Anomalous freshwater term !(salt flux only (sfx))
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+!CDIR COLLAPSE
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zerp = ( 1. - 2.*rnfmsk(ji,jj) )  &              ! No damping in vicinity of river mouths
+                        &        * sf_erp(1)%fnow(ji,jj,1)     &      
+                        &        * MAX( sss_m(ji,jj), 1.e-20 )
+                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
+                  END DO
+               END DO
+               !ky!CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               !
+            ELSEIF( nn_flxadjfw == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+               zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
+!CDIR COLLAPSE
+               DO jj = 1, jpj
+                  DO ji = 1, jpi                            
+                     zerp = sf_erp(1)%fnow(ji,jj,1)
+                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
+                     emp(ji,jj) = emp (ji,jj) + zerp
+                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
+                  END DO
+               END DO
+               !ky!CALL iom_put( "erp", erp )                             ! freshwater flux damping
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_flx_adj')
+      !
+   END SUBROUTINE sbc_flx_adj
+
+ 
+   SUBROUTINE sbc_flx_adj_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_flx_adj_init  ***
+      !!
+      !! ** Purpose :   initialisation of surface damping term
+      !!
+      !! ** Method  : - Read namelist namsbc_flx_adj
+      !ky!!!              - Read observed SST and/or SSS if required
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zerp     ! local scalar for evaporation damping
+      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
+      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
+      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
+      INTEGER  ::   ierror   ! return error code
+      !!
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_qrp, sn_erp        ! informations about the fields to be read
+      NAMELIST/namsbc_flx_adj/ cn_dir, nn_flxadjht, nn_flxadjfw, rn_dqdt, rn_deds, sn_qrp, sn_erp, ln_sssr_bnd, rn_sssr_bnd
+      INTEGER     ::  ios
+      !!----------------------------------------------------------------------
+      !
+ 
+      REWIND( numnam_ref )              ! Namelist namsbc_flx_adj in reference namelist : 
+      READ  ( numnam_ref, namsbc_flx_adj, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_flx_adj in configuration namelist :
+      READ  ( numnam_cfg, namsbc_flx_adj, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx_adj in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_flx_adj )
+
+      IF(lwp) THEN                 !* control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_flx_adj : Heat and/or freshwater flux adjustment term '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namsbc_flx_adj :'
+         WRITE(numout,*) '      Anomalous heat flux (qrp) term (Yes=1)             nn_flxadjht     = ', nn_flxadjht
+         WRITE(numout,*) '      Anomalous freshwater flux (erp) term (Yes=1, salt flux)    nn_flxadjfw     = ', nn_flxadjfw
+         WRITE(numout,*) '                                           (Yes=2, volume flux) '
+         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K'
+         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day'
+         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
+         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
+      ENDIF
+      !
+      !                            !* Allocate erp and qrp array
+      !ky!ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
+      !ky!IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
+      !
+      IF( nn_flxadjht == 1 ) THEN      !* set sf_qrp structure & allocate arrays
+         !
+         ALLOCATE( sf_qrp(1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp structure' )
+         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp now array' )
+         !
+         ! fill sf_qrp with sn_qrp and control print
+         CALL fld_fill( sf_qrp, (/ sn_qrp /), cn_dir, 'sbc_flx_adj', 'Heat flux adjustment', 'namsbc_flx_adj' )
+         IF( sf_qrp(1)%ln_tint )   ALLOCATE( sf_qrp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_qrp data array' )
+         !
+      ENDIF
+      !
+      IF( nn_flxadjfw >= 1 ) THEN      !* set sf_erp structure & allocate arrays
+         !
+         ALLOCATE( sf_erp(1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp structure' )
+         ALLOCATE( sf_erp(1)%fnow(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp now array' )
+         !
+         ! fill sf_erp with sn_erp and control print
+         CALL fld_fill( sf_erp, (/ sn_erp /), cn_dir, 'sbc_erp', 'Freshwater flux adjustment term', 'namsbc_flx_adj' )
+         IF( sf_erp(1)%ln_tint )   ALLOCATE( sf_erp(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_flx_adj: unable to allocate sf_erp data array' )
+         !
+      ENDIF
+      !
+      !ky!!                            !* Initialize qrp and erp if no restoring 
+      !ky!IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
+      !ky!IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
+      !
+   END SUBROUTINE sbc_flx_adj_init
+      
+   !!======================================================================
+END MODULE sbcflx_adj
Index: /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5880)
+++ /branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 5881)
@@ -41,4 +41,5 @@
    USE cpl_oasis3       ! OASIS routines for coupling
    USE sbcssr           ! surface boundary condition: sea surface restoring
+   USE sbcflx_adj       ! surface boundary condition: sea surface flux adjustment
    USE sbcrnf           ! surface boundary condition: runoffs
    USE sbcisf           ! surface boundary condition: ice shelf
@@ -67,5 +68,5 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 4.0 , NEMO-consortium (2011) 
-   !! $Id$
+   !! $Id: sbcmod.F90 5501 2015-06-29 10:08:15Z deazer $
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -296,4 +297,7 @@
 
                                CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
+      !
+      ! KY 12/11/2015
+                               CALL sbc_flx_adj_init           ! Sea-Surface Flux adjustment
       !
       IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
@@ -399,4 +403,7 @@
       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
  
+      ! KY 12/11/2015
+                             CALL sbc_flx_adj( kt )               ! add flux adjustment term
+ 
       IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
 
