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 11384 for branches/UKMO/dev_r5518_STOPACK/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90 – NEMO

Ignore:
Timestamp:
2019-07-31T18:05:50+02:00 (5 years ago)
Author:
mattmartin
Message:

Included Andrea Storto's STOPACK code into NEMO3.6 branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_STOPACK/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4990 r11384  
    2525   USE timing         ! Timing 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE stopack 
     28   USE wrk_nemo       ! Memory Allocation 
    2729 
    2830   IMPLICIT NONE 
     
    7577      REAL(wp) ::   zerp     ! local scalar for evaporation damping 
    7678      REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
    77       REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
    7879      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
     80      REAL(wp), POINTER, DIMENSION(:,:) :: rn_dqdt_s, zsrp 
    7981      INTEGER  ::   ierror   ! return error code 
    8082      !! 
     
    9597            ! 
    9698            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
     99 
     100               CALL wrk_alloc( jpi, jpj, rn_dqdt_s) 
     101               rn_dqdt_s=rn_dqdt 
     102 
     103               IF( nn_spp_dqdt > 0 ) CALL spp_gen(kt, rn_dqdt_s,nn_spp_dqdt,rn_dqdt_sd,jk_spp_dqdt ) 
    97104               DO jj = 1, jpj 
    98105                  DO ji = 1, jpi 
    99                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
     106                     zqrp = rn_dqdt_s(ji,jj) * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    100107                     qns(ji,jj) = qns(ji,jj) + zqrp 
    101108                     qrp(ji,jj) = zqrp 
     
    103110               END DO 
    104111               CALL iom_put( "qrp", qrp )                             ! heat flux damping 
     112               CALL wrk_dealloc( jpi, jpj, rn_dqdt_s ) 
    105113            ENDIF 
    106114            ! 
    107115            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    108                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
     116               CALL wrk_alloc( jpi, jpj, zsrp) 
     117               zsrp = rn_deds 
     118               IF( nn_spp_dedt > 0 ) CALL spp_gen(kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds ) 
    109119!CDIR COLLAPSE 
    110120               DO jj = 1, jpj 
    111121                  DO ji = 1, jpi 
    112                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     122                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    113123                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )  
    114124                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
     
    117127               END DO 
    118128               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     129               CALL wrk_dealloc( jpi,jpj, zsrp ) 
    119130               ! 
    120131            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
    121                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
     132               CALL wrk_alloc( jpi, jpj, zsrp) 
     133               zsrp = rn_deds 
     134               IF( nn_spp_dedt > 0 ) CALL spp_gen(kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds ) 
    122135               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    123136!CDIR COLLAPSE 
    124137               DO jj = 1, jpj 
    125138                  DO ji = 1, jpi                             
    126                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     139                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    127140                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    128141                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
     
    134147               END DO 
    135148               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     149               CALL wrk_dealloc( jpi,jpj,zsrp ) 
    136150            ENDIF 
    137151            ! 
Note: See TracChangeset for help on using the changeset viewer.