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 13662 for NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/SBC/sbcssr.F90 – NEMO

Ignore:
Timestamp:
2020-10-22T20:49:56+02:00 (4 years ago)
Author:
clem
Message:

update to almost r4.0.4

Location:
NEMO/branches/2019/dev_r11842_SI3-10_EAP
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11842_SI3-10_EAP

    • Property svn:externals
      •  

        old new  
        1 ^/utils/build/arch@HEAD       arch 
        2 ^/utils/build/makenemo@HEAD   makenemo 
        3 ^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
        6 ^/vendors/FCM@HEAD            ext/FCM 
        7 ^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         1^/utils/build/arch@12130      arch 
         2^/utils/build/makenemo@12191  makenemo 
         3^/utils/build/mk@11662        mk 
         4^/utils/tools_r4.0-HEAD@12672 tools 
         5^/vendors/AGRIF/dev@10586     ext/AGRIF 
         6^/vendors/FCM@10134           ext/FCM 
         7^/vendors/IOIPSL@9655         ext/IOIPSL 
         8 
         9# SETTE mapping (inactive) 
         10#^/utils/CI/sette@12135        sette 
  • NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/SBC/sbcssr.F90

    r11536 r13662  
    3030   PUBLIC   sbc_ssr        ! routine called in sbcmod 
    3131   PUBLIC   sbc_ssr_init   ! routine called in sbcmod 
     32   PUBLIC   sbc_ssr_alloc  ! routine called in sbcmod 
    3233 
    3334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s] 
    3435   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2] 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   coefice   !: under ice relaxation coefficient 
    3537 
    3638   !                                   !!* Namelist namsbc_ssr * 
     
    4143   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term  
    4244   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
     45   INTEGER         ::   nn_sssr_ice     ! Control of restoring under ice 
    4346 
    4447   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
     
    97100                  END DO 
    98101               END DO 
    99                CALL iom_put( "qrp", qrp )                             ! heat flux damping 
     102            ENDIF 
     103            ! 
     104            IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN 
     105              ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 
     106              ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 
     107               DO jj = 1, jpj 
     108                  DO ji = 1, jpi 
     109                     SELECT CASE ( nn_sssr_ice ) 
     110                       CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice 
     111                       CASE  DEFAULT ;  coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice ) 
     112                     END SELECT 
     113                  END DO 
     114               END DO 
    100115            ENDIF 
    101116            ! 
     
    105120                  DO ji = 1, jpi 
    106121                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     122                        &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 
    107123                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    108124                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
     
    110126                  END DO 
    111127               END DO 
    112                CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    113128               ! 
    114129            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
     
    118133                  DO ji = 1, jpi                             
    119134                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     135                        &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 
    120136                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    121137                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) * tmask(ji,jj,1) 
     
    126142                  END DO 
    127143               END DO 
    128                CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    129144            ENDIF 
    130145            ! 
     
    154169      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    155170      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    156       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     171      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 
    157173      INTEGER     ::  ios 
    158174      !!---------------------------------------------------------------------- 
     
    182198         WRITE(numout,*) '         flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    183199         WRITE(numout,*) '         ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    184       ENDIF 
    185       ! 
    186       !                            !* Allocate erp and qrp array 
    187       ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
    188       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
     200         WRITE(numout,*) '      Cntrl of surface restoration under ice nn_sssr_ice    = ', nn_sssr_ice 
     201         WRITE(numout,*) '          ( 0 = no restoration under ice)' 
     202         WRITE(numout,*) '          ( 1 = restoration everywhere  )' 
     203         WRITE(numout,*) '          (>1 = enhanced restoration under ice  )' 
     204      ENDIF 
    189205      ! 
    190206      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
     
    216232      ENDIF 
    217233      ! 
     234      coefice(:,:) = 1._wp         !  Initialise coefice to 1._wp ; will not need to be changed if nn_sssr_ice=1 
    218235      !                            !* Initialize qrp and erp if no restoring  
    219236      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp 
     
    221238      ! 
    222239   END SUBROUTINE sbc_ssr_init 
     240          
     241   INTEGER FUNCTION sbc_ssr_alloc() 
     242      !!---------------------------------------------------------------------- 
     243      !!               ***  FUNCTION sbc_ssr_alloc  *** 
     244      !!---------------------------------------------------------------------- 
     245      sbc_ssr_alloc = 0       ! set to zero if no array to be allocated 
     246      IF( .NOT. ALLOCATED( erp ) ) THEN 
     247         ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc ) 
     248         ! 
     249         IF( lk_mpp                  )   CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc ) 
     250         IF( sbc_ssr_alloc /= 0 )   CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.') 
     251         ! 
     252      ENDIF 
     253   END FUNCTION 
    223254       
    224255   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.