Changeset 15312

Timestamp:

2021-10-01T13:45:29+02:00 (20 months ago)

Author:

hadjt

Message:

Haney Correction for radiative fluxes

SBC/sbc_ssr.F90 edited to add the Haney Correction to the radiative fluxes
namelist keyword added to namsbc_ssr: ln_UKMO_haney

The version is committed in restrospect, so may not include all the changes to work.

File:

• NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/SBC/sbcssr.F90 (modified) (7 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/SBC/sbcssr.F90

@@ -44 +44 @@
    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
    INTEGER         ::   nn_sssr_ice     ! Control of restoring under ice
+   ! JT
+   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing  
+   ! JT
 
    REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
@@ -79 +82 @@
       INTEGER  ::   ierror   ! return error code
       !!
+      ! JT
+      REAL(wp) ::   sst1,sst2                      ! sea surface temperature
+      REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure
+      REAL(wp) ::   qs1,qs2                        ! specific humidity
+      REAL(wp) ::   pr_tmp                         ! temporary variable for pressure
+ 
+      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat   
+      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat   
+      ! JT
+      !!
       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
@@ -93 +106 @@
             !
             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
-                     qns(ji,jj) = qns(ji,jj) + zqrp
-                     qrp(ji,jj) = zqrp
-                  END DO
-               END DO
+               ! JT
+               IF( ln_UKMO_haney ) THEN
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        sst1   =  sst_m(ji,jj)
+                        sst2   =  sf_sst(1)%fnow(ji,jj,1)   
+                        e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1))
+                        e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))         
+                        pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0
+                        qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1)
+                        qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2)
+                        hny_frc1(ji,jj) = sst1-sst2                   
+                        hny_frc2(ji,jj) = qs1-qs2                     
+                       !Might need to mask off land points.
+                        hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42
+                        hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0
+                        ! JT Have masked out the land points 
+                        qns(ji,jj)=qns(ji,jj)+(hny_frc1(ji,jj)+hny_frc2(ji,jj))*tmask(ji,jj,1)
+                        qrp(ji,jj) = 0.e0
+                     END DO
+                  END DO
+               ELSE
+              ! JT
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+                        qns(ji,jj) = qns(ji,jj) + zqrp
+                        qrp(ji,jj) = zqrp
+                     END DO
+                  END DO
+               ENDIF
             ENDIF
+            ! JT
+            ! JT CALL iom_put( "qrp", qrp )                             ! heat flux damping
+            ! JT
             !
             IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN
@@ -126 +166 @@
                   END DO
                END DO
+
                !
             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
@@ -142 +183 @@
                   END DO
                END DO
+               ! JT CALL iom_put( "erp", erp )                             ! freshwater flux damping
             ENDIF
             !
@@ -170 +212 @@
       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, &
-              & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice
+              & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice, &
+              & ln_UKMO_haney    ! JT
       INTEGER     ::  ios
       !!----------------------------------------------------------------------
@@ -198 +241 @@
          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'
+         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney
          WRITE(numout,*) '      Cntrl of surface restoration under ice nn_sssr_ice    = ', nn_sssr_ice
          WRITE(numout,*) '          ( 0 = no restoration under ice)'