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 15312 – NEMO

Changeset 15312


Ignore:
Timestamp:
2021-10-01T13:45:29+02:00 (3 years 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:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/SBC/sbcssr.F90

    r14075 r15312  
    4444   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
    4545   INTEGER         ::   nn_sssr_ice     ! Control of restoring under ice 
     46   ! JT 
     47   LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing   
     48   ! JT 
    4649 
    4750   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
     
    7982      INTEGER  ::   ierror   ! return error code 
    8083      !! 
     84      ! JT 
     85      REAL(wp) ::   sst1,sst2                      ! sea surface temperature 
     86      REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure 
     87      REAL(wp) ::   qs1,qs2                        ! specific humidity 
     88      REAL(wp) ::   pr_tmp                         ! temporary variable for pressure 
     89  
     90      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat    
     91      REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat    
     92      ! JT 
     93      !! 
    8194      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    8295      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
     
    93106            ! 
    94107            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    95                DO jj = 1, jpj 
    96                   DO ji = 1, jpi 
    97                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    98                      qns(ji,jj) = qns(ji,jj) + zqrp 
    99                      qrp(ji,jj) = zqrp 
    100                   END DO 
    101                END DO 
     108               ! JT 
     109               IF( ln_UKMO_haney ) THEN 
     110                  DO jj = 1, jpj 
     111                     DO ji = 1, jpi 
     112                        sst1   =  sst_m(ji,jj) 
     113                        sst2   =  sf_sst(1)%fnow(ji,jj,1)    
     114                        e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 
     115                        e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))          
     116                        pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0 
     117                        qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 
     118                        qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 
     119                        hny_frc1(ji,jj) = sst1-sst2                    
     120                        hny_frc2(ji,jj) = qs1-qs2                      
     121                       !Might need to mask off land points. 
     122                        hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 
     123                        hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 
     124                        ! JT Have masked out the land points  
     125                        qns(ji,jj)=qns(ji,jj)+(hny_frc1(ji,jj)+hny_frc2(ji,jj))*tmask(ji,jj,1) 
     126                        qrp(ji,jj) = 0.e0 
     127                     END DO 
     128                  END DO 
     129               ELSE 
     130              ! JT 
     131                  DO jj = 1, jpj 
     132                     DO ji = 1, jpi 
     133                        zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
     134                        qns(ji,jj) = qns(ji,jj) + zqrp 
     135                        qrp(ji,jj) = zqrp 
     136                     END DO 
     137                  END DO 
     138               ENDIF 
    102139            ENDIF 
     140            ! JT 
     141            ! JT CALL iom_put( "qrp", qrp )                             ! heat flux damping 
     142            ! JT 
    103143            ! 
    104144            IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN 
     
    126166                  END DO 
    127167               END DO 
     168 
    128169               ! 
    129170            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
     
    142183                  END DO 
    143184               END DO 
     185               ! JT CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    144186            ENDIF 
    145187            ! 
     
    170212      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    171213      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 
    172               & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice 
     214              & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice, & 
     215              & ln_UKMO_haney    ! JT 
    173216      INTEGER     ::  ios 
    174217      !!---------------------------------------------------------------------- 
     
    198241         WRITE(numout,*) '         flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    199242         WRITE(numout,*) '         ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     243         WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney 
    200244         WRITE(numout,*) '      Cntrl of surface restoration under ice nn_sssr_ice    = ', nn_sssr_ice 
    201245         WRITE(numout,*) '          ( 0 = no restoration under ice)' 
Note: See TracChangeset for help on using the changeset viewer.