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 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 – NEMO

Ignore:
Timestamp:
2014-12-15T17:42:49+01:00 (9 years ago)
Author:
timgraham
Message:

Merged branches/2014/dev_MERGE_2014 back onto the trunk as follows:

In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
1 conflict in LIM_SRC_3/limdiahsb.F90
Resolved by keeping the version from dev_MERGE_2014 branch
and commited at r4989

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2014/dev_MERGE_2014
to merge the branch into the trunk - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3764 r4990  
    1818   USE dom_oce         ! ocean space domain variables 
    1919   USE phycst          ! physical constant 
     20   USE sbcmod          ! ln_rnf   
     21   USE sbcrnf          ! River runoff   
    2022   USE traqsr          ! solar radiation penetration 
    21    USE trdmod_oce      ! ocean trends  
    22    USE trdtra          ! ocean trends 
     23   USE trd_oce         ! trends: ocean variables 
     24   USE trdtra          ! trends manager: tracers  
     25   ! 
    2326   USE in_out_manager  ! I/O manager 
    2427   USE prtctl          ! Print control 
    2528   USE sbcrnf          ! River runoff   
     29   USE sbcisf          ! Ice shelf    
    2630   USE sbcmod          ! ln_rnf   
    2731   USE iom 
     
    2933   USE wrk_nemo        ! Memory Allocation 
    3034   USE timing          ! Timing 
     35   USE eosbn2 
    3136 
    3237   IMPLICIT NONE 
     
    3944#  include "vectopt_loop_substitute.h90" 
    4045   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4247   !! $Id$ 
    4348   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    9196      !!         where emp, the surface freshwater budget (evaporation minus 
    9297      !!         precipitation minus runoff) given in kg/m2/s is divided 
    93       !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.     
     98      !!         by rau0 (density of sea water) to obtain m/s.     
    9499      !!         Note: even though Fwe does not appear explicitly for  
    95100      !!         temperature in this routine, the heat carried by the water 
     
    107112      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated 
    108113      !!                with the tracer surface boundary condition  
    109       !!              - save the trend it in ttrd ('key_trdtra') 
     114      !!              - send trends to trdtra module (l_trdtra=T) 
    110115      !!---------------------------------------------------------------------- 
    111116      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    112117      !! 
    113118      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
     119      INTEGER  ::   ikt, ikb  
     120      INTEGER  ::   nk_isf 
    114121      REAL(wp) ::   zfact, z1_e3t, zdep 
     122      REAL(wp) ::   zalpha, zhk 
     123      REAL(wp) ::  zt_frz, zpress 
    115124      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    116125      !!---------------------------------------------------------------------- 
     
    124133      ENDIF 
    125134 
    126       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     135      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    127136         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    128137         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     
    137146 
    138147      !---------------------------------------- 
    139       !        EMP, EMPS and QNS effects 
     148      !        EMP, SFX and QNS effects 
    140149      !---------------------------------------- 
    141150      !                                          Set before sbc tracer content fields 
     
    146155              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
    147156            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file' 
    148             zfact = 0.5e0 
     157            zfact = 0.5_wp 
    149158            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend 
    150159            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    151160         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    152             zfact = 1.e0 
    153             sbc_tsc_b(:,:,:) = 0.e0 
     161            zfact = 1._wp 
     162            sbc_tsc_b(:,:,:) = 0._wp 
    154163         ENDIF 
    155164      ELSE                                         ! Swap of forcing fields 
    156165         !                                         ! ---------------------- 
    157          zfact = 0.5e0 
     166         zfact = 0.5_wp 
    158167         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
    159168      ENDIF 
     
    182191            END DO 
    183192         END DO 
    184          CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )                          ! c/d term on sst 
    185          CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )                          ! c/d term on sss 
     193         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )   ! c/d term on sst 
     194         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )   ! c/d term on sss 
    186195      ENDIF 
    187196      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff   
     
    205214      ENDIF 
    206215      ! 
     216      ! 
     217      !---------------------------------------- 
     218      !       Ice Shelf effects (ISF) 
     219      !     tbl treated as in Losh (2008) JGR 
     220      !---------------------------------------- 
     221      ! 
     222      IF( nn_isf > 0 ) THEN 
     223         zfact = 0.5e0 
     224         DO jj = 2, jpj 
     225            DO ji = fs_2, fs_jpim1 
     226          
     227               ikt = misfkt(ji,jj) 
     228               ikb = misfkb(ji,jj) 
     229    
     230               ! level fully include in the ice shelf boundary layer 
     231               ! if isfdiv, we have to remove heat flux due to inflow at 0oC (as in rnf when you add rnf at sst) 
     232               ! sign - because fwf sign of evapo (rnf sign of precip) 
     233               DO jk = ikt, ikb - 1 
     234               ! compute tfreez for the temperature correction (we add water at freezing temperature) 
     235!                  zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
     236                  zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
     237               ! compute trend 
     238                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          & 
     239                     &           + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          & 
     240                     &               - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 
     241                     &           * r1_hisf_tbl(ji,jj) 
     242                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                          & 
     243                     &           + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) 
     244               END DO 
     245    
     246               ! level partially include in ice shelf boundary layer  
     247               ! compute tfreez for the temperature correction (we add water at freezing temperature) 
     248!               zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04 
     249               zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress ) 
     250               ! compute trend 
     251               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           & 
     252                  &              + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)          & 
     253                  &                  - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) &  
     254                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 
     255               tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal)                                           & 
     256                  &              + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)  
     257            END DO 
     258         END DO 
     259         IF( lrst_oce ) THEN 
     260            IF(lwp) WRITE(numout,*) 
     261            IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   & 
     262               &                    'at it= ', kt,' date= ', ndastp 
     263            IF(lwp) WRITE(numout,*) '~~~~' 
     264            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          ) 
     265            CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 
     266            CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 
     267         ENDIF 
     268      END IF 
     269      ! 
    207270      !---------------------------------------- 
    208271      !        River Runoff effects 
     
    226289      ENDIF 
    227290  
    228       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     291      IF( l_trdtra )   THEN                      ! send trends for further diagnostics 
    229292         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    230293         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    231          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt ) 
    232          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds ) 
     294         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
     295         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    233296         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    234297      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.