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

Ignore:
Timestamp:
2018-07-23T11:33:03+02:00 (6 years ago)
Author:
emmafiedler
Message:

Merge with GO6 FOAMv14 package branch r9288

File:
1 edited

Legend:

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

    r7960 r9987  
    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 
     
    110110      ! Update after tracer on domain lateral boundaries 
    111111      !  
     112#if defined key_agrif 
     113      CALL Agrif_tra                     ! AGRIF zoom boundaries 
     114#endif 
     115      ! 
    112116      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
    113117      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
     
    115119#if defined key_bdy  
    116120      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    117 #endif 
    118 #if defined key_agrif 
    119       CALL Agrif_tra                     ! AGRIF zoom boundaries 
    120121#endif 
    121122  
     
    126127 
    127128      ! trends computation initialisation 
    128       IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter 
     129      IF( l_trdtra )   THEN                     
    129130         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    130          ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    131          ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     131         ztrdt(:,:,jpk) = 0._wp 
     132         ztrds(:,:,jpk) = 0._wp 
    132133         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    133134            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    134135            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
    135136         ENDIF 
     137         ! total trend for the non-time-filtered variables. 
     138         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 
     139         IF( lk_vvl ) THEN 
     140            DO jk = 1, jpkm1 
     141               zfact = 1.0 / rdttra(jk) 
     142               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 
     143               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 
     144            END DO 
     145         ELSE 
     146            DO jk = 1, jpkm1 
     147               zfact = 1.0 / rdttra(jk) 
     148               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
     149               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
     150            END DO 
     151         END IF 
     152         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
     153         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 
     154         IF( .NOT.lk_vvl )  THEN 
     155            ! Store now fields before applying the Asselin filter  
     156            ! in order to calculate Asselin filter trend later. 
     157            ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
     158            ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     159         END IF 
    136160      ENDIF 
    137161 
     
    142166            END DO 
    143167         END DO 
     168         IF (l_trdtra.AND.lk_vvl) THEN      ! Zero Asselin filter contribution must be explicitly written out since for vvl 
     169                                            ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 
     170            ztrdt(:,:,:) = 0._wp 
     171            ztrds(:,:,:) = 0._wp 
     172            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
     173            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
     174         END IF 
    144175      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    145176         ! 
     
    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 
    158       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
     181      ENDIF      
     182      ! 
     183     ! trends computation 
     184      IF( l_trdtra.AND..NOT.lk_vvl) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    159185         DO jk = 1, jpkm1 
    160186            zfact = 1._wp / r2dtra(jk)              
     
    164190         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    165191         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    166          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    167192      END IF 
     193      IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    168194      ! 
    169195      !                        ! control print 
     
    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 
    283       REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     309      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
    284310      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
     311      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf 
    285312      !!---------------------------------------------------------------------- 
    286313      ! 
     
    295322         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
    296323         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
     324         IF (nn_isf .GE. 1) THEN  
     325            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing 
     326         ELSE 
     327            ll_isf = .FALSE. 
     328         END IF 
    297329      ELSE                           
    298330         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    299331         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
    300332         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
    301       ENDIF 
    302       ! 
     333         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing 
     334      ENDIF 
     335      ! 
     336      IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) )   THEN 
     337         CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
     338         ztrd_atf(:,:,:,:) = 0.0_wp 
     339      ENDIF 
    303340      DO jn = 1, kjpt       
    304341         DO jk = 1, jpkm1 
     342            zfact = 1._wp / r2dtra(jk) 
    305343            zfact1 = atfp * p2dt(jk) 
    306344            zfact2 = zfact1 / rau0 
     
    321359                  ztc_f  = ztc_n  + atfp * ztc_d 
    322360                  ! 
    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) ) 
     361                  IF( jk == mikt(ji,jj) ) THEN           ! first level  
     362                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  & 
     363                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  & 
     364                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  ) 
    325365                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    326366                  ENDIF 
    327367 
    328                   IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only) 
     368                  ! solar penetration (temperature only) 
     369                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            &  
    329370                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
    330371 
    331                   IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &            ! river runoffs 
     372                  ! river runoff 
     373                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          & 
    332374                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
    333375                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     376 
     377                  ! ice shelf 
     378                  IF( ll_isf ) THEN 
     379                     ! level fully include in the Losch_2008 ice shelf boundary layer 
     380                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          & 
     381                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
     382                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 
     383                     ! level partially include in Losch_2008 ice shelf boundary layer  
     384                     IF ( jk == misfkb(ji,jj) )                                                   & 
     385                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  & 
     386                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 
     387                  END IF 
    334388 
    335389                  ze3t_f = 1.e0 / ze3t_f 
     
    340394                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
    341395                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
     396                  ENDIF 
     397                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 
     398                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 
    342399                  ENDIF 
    343400               END DO 
     
    347404      END DO 
    348405      ! 
     406      IF( l_trdtra .and. cdtype == 'TRA' ) THEN  
     407         CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 
     408         CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 
     409         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
     410      ENDIF 
     411      IF( l_trdtrc .and. cdtype == 'TRC' ) THEN 
     412         DO jn = 1, kjpt 
     413            CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 
     414         END DO 
     415         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
     416      ENDIF 
     417 
    349418   END SUBROUTINE tra_nxt_vvl 
    350419 
Note: See TracChangeset for help on using the changeset viewer.