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 10253 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:55:40+01:00 (5 years ago)
Author:
kingr
Message:

Merged AMM15_v3_6_STABLE_package_collate@10237

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r10251 r10253  
    2828   USE sbc_oce         ! surface boundary condition: ocean 
    2929   USE sbcrnf          ! river runoffs 
     30   USE sbcisf          ! ice shelf melting/freezing 
    3031   USE zdf_oce         ! ocean vertical mixing 
    3132   USE domvvl          ! variable volume 
     
    4647   USE timing          ! Timing 
    4748#if defined key_agrif 
    48    USE agrif_opa_update 
    4949   USE agrif_opa_interp 
    5050#endif 
     
    5858 
    5959   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
     60   INTEGER  ::   warn_1, warn_2   ! indicators for warning statement 
    6061 
    6162   !! * Substitutions 
     
    9394      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    9495      !! 
    95       INTEGER  ::   jk, jn    ! dummy loop indices 
    96       REAL(wp) ::   zfact     ! local scalars 
     96      INTEGER  ::   jk, jn, ji, jj     ! dummy loop indices 
     97      REAL(wp) ::   zfact, zfreeze     ! local scalars 
    9798      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    9899      !!---------------------------------------------------------------------- 
     
    110111      ! Update after tracer on domain lateral boundaries 
    111112      !  
     113#if defined key_agrif 
     114      CALL Agrif_tra                     ! AGRIF zoom boundaries 
     115#endif 
     116      ! 
    112117      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
    113118      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
     
    115120#if defined key_bdy  
    116121      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    117 #endif 
    118 #if defined key_agrif 
    119       CALL Agrif_tra                     ! AGRIF zoom boundaries 
    120122#endif 
    121123  
     
    124126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
    125127      ENDIF 
     128 
     129#if ( ! defined key_lim3 && ! defined key_lim2 && ! key_cice ) 
     130      IF ( kt == nit000 ) warn_1=0 
     131      warn_2=0 
     132      DO jk = 1, jpkm1 
     133         DO jj = 1, jpj 
     134            DO ji = 1, jpi 
     135               IF ( tsa(ji,jj,jk,jp_tem) .lt. 0.0 ) THEN 
     136                  ! calculate freezing point 
     137                  zfreeze = ( -0.0575_wp + 1.710523E-3 * Sqrt(Abs(tsn(ji,jj,jk,jp_sal)))   &  
     138                            - 2.154996E-4 * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) - 7.53E-4 * ( 10.0_wp + fsdept(ji,jj,jk) ) 
     139                  IF ( tsa(ji,jj,jk,jp_tem) .lt. zfreeze ) THEN 
     140                     tsa(ji,jj,jk,jp_tem)=zfreeze 
     141                     warn_2=1 
     142                  ENDIF 
     143               ENDIF 
     144            END DO 
     145         END DO 
     146      END DO 
     147      CALL mpp_max(warn_1) 
     148      CALL mpp_max(warn_2) 
     149      IF ( (warn_1 == 0) .and. (warn_2 /= 0) ) THEN 
     150         IF(lwp) THEN 
     151            CALL ctl_warn( ' Temperatures dropping below freezing point, ', & 
     152                      &    ' being forced to freezing point, no longer conservative' )  
     153         ENDIF 
     154         warn_1=1 
     155      ENDIF 
     156#endif 
    126157 
    127158      ! trends computation initialisation 
     
    148179         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
    149180         ENDIF 
    150       ENDIF  
    151       ! 
    152 #if defined key_agrif 
    153       ! Update tracer at AGRIF zoom boundaries 
    154       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only 
    155 #endif       
    156       ! 
    157       ! trends computation 
     181      ENDIF      
     182      ! 
     183     ! trends computation 
    158184      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    159185         DO jk = 1, jpkm1 
     
    279305 
    280306      !!      
    281       LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical 
     307      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical 
    282308      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    283309      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     
    295321         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
    296322         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
     323         IF (nn_isf .GE. 1) THEN  
     324            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing 
     325         ELSE 
     326            ll_isf = .FALSE. 
     327         END IF 
    297328      ELSE                           
    298329         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    299330         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
    300331         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
     332         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing 
    301333      ENDIF 
    302334      ! 
     
    321353                  ztc_f  = ztc_n  + atfp * ztc_d 
    322354                  ! 
    323                   IF( jk == 1 ) THEN           ! first level  
    324                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) ) 
     355                  IF( jk == mikt(ji,jj) ) THEN           ! first level  
     356                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  & 
     357                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  & 
     358                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  ) 
    325359                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    326360                  ENDIF 
    327361 
    328                   IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only) 
     362                  ! solar penetration (temperature only) 
     363                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            &  
    329364                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
    330365 
    331                   IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &            ! river runoffs 
     366                  ! river runoff 
     367                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          & 
    332368                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
    333369                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     370 
     371                  ! ice shelf 
     372                  IF( ll_isf ) THEN 
     373                     ! level fully include in the Losch_2008 ice shelf boundary layer 
     374                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          & 
     375                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
     376                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 
     377                     ! level partially include in Losch_2008 ice shelf boundary layer  
     378                     IF ( jk == misfkb(ji,jj) )                                                   & 
     379                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
     380                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 
     381                  END IF 
    334382 
    335383                  ze3t_f = 1.e0 / ze3t_f 
Note: See TracChangeset for help on using the changeset viewer.