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 7806 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2017-03-17T08:46:30+01:00 (7 years ago)
Author:
cbricaud
Message:

phaze dev_r5003_MERCATOR6_CRS branch with rev7805 of 3.6_stable branch

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC
Files:
46 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7256 r7806  
    2424   USE phycst         ! physical constant 
    2525   USE in_out_manager  ! I/O manager 
     26   USE zdfddm 
     27   USE zdf_oce 
    2628 
    2729   IMPLICIT NONE 
    … …  
    4244   !! * Substitutions 
    4345#  include "domzgr_substitute.h90" 
     46#  include "zdfddm_substitute.h90" 
    4447   !!---------------------------------------------------------------------- 
    4548   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    7578      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    7679      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 
     80      REAL(wp) ::   zaw, zbw, zrw 
    7781      ! 
    7882      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
     83      REAL(wp), POINTER, DIMENSION(:,:)     :: pe                         ! 2D workspace  
    7984      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace 
    8085      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8186      !!-------------------------------------------------------------------- 
    8287      IF( nn_timing == 1 )   CALL timing_start('dia_ar5') 
     88 
     89      !Call to init moved to here so that we can call iom_use in the 
     90      !initialisation 
     91      IF( kt == nit000 )     CALL dia_ar5_init 
    8392  
    84       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     93      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    8594      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    8695      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    … …  
    95104      CALL iom_put( 'voltot', zvol               ) 
    96105      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
     106      CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
    97107 
    98108      !                      
    99       ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    100       ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    101       CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    102       ! 
    103       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    104       DO jk = 1, jpkm1 
    105          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    106       END DO 
    107       IF( .NOT.lk_vvl ) THEN 
    108          IF ( ln_isfcav ) THEN 
    109             DO ji=1,jpi 
    110                DO jj=1,jpj 
    111                   zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     109      IF( iom_use('sshthster')) THEN 
     110         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     111         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
     112         CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     113         ! 
     114         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     115         DO jk = 1, jpkm1 
     116            zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
     117         END DO 
     118         IF( .NOT.lk_vvl ) THEN 
     119            IF ( ln_isfcav ) THEN 
     120               DO ji=1,jpi 
     121                  DO jj=1,jpj 
     122                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     123                  END DO 
    112124               END DO 
    113             END DO 
    114          ELSE 
    115             zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     125            ELSE 
     126               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     127            END IF 
    116128         END IF 
    117       END IF 
    118129      !                                          
    119       zarho = SUM( area(:,:) * zbotpres(:,:) )  
    120       IF( lk_mpp )   CALL mpp_sum( zarho ) 
    121       zssh_steric = - zarho / area_tot 
    122       CALL iom_put( 'sshthster', zssh_steric ) 
    123        
     130         zarho = SUM( area(:,:) * zbotpres(:,:) )  
     131         IF( lk_mpp )   CALL mpp_sum( zarho ) 
     132         zssh_steric = - zarho / area_tot 
     133         CALL iom_put( 'sshthster', zssh_steric ) 
     134      ENDIF 
    124135      !                                         ! steric sea surface height 
    125136      CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )                 ! now in situ and potential density 
    … …  
    190201      CALL iom_put( 'temptot', ztemp ) 
    191202      CALL iom_put( 'saltot' , zsal  ) 
    192       ! 
    193       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     203 
     204      IF( iom_use( 'tnpeo' )) THEN     
     205      ! Work done against stratification by vertical mixing 
     206      ! Exclude points where rn2 is negative as convection kicks in here and 
     207      ! work is not being done against stratification 
     208          pe(:,:) = 0._wp 
     209          IF( lk_zdfddm ) THEN 
     210             DO ji=1,jpi 
     211                DO jj=1,jpj 
     212                   DO jk=1,jpk 
     213                      zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     214                         &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
     215                      ! 
     216                      zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     217                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     218                      ! 
     219                      pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
     220                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     221                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     222 
     223                   ENDDO 
     224                ENDDO 
     225             ENDDO 
     226          ELSE 
     227             DO ji=1,jpi 
     228                DO jj=1,jpj 
     229                   DO jk=1,jpk 
     230                       pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 
     231                   ENDDO 
     232                ENDDO 
     233             ENDDO 
     234          ENDIF 
     235          CALL lbc_lnk(pe, 'T', 1._wp)          
     236          CALL iom_put( 'tnpeo', pe ) 
     237      ENDIF 
     238      ! 
     239      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    194240      CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    195241      CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    … …  
    232278      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    233279 
    234       CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
    235       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
    236       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
    237       CALL iom_close( inum ) 
    238  
    239       sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    240       sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    241       IF( ln_zps ) THEN               ! z-coord. partial steps 
    242          DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    243             DO ji = 1, jpi 
    244                ik = mbkt(ji,jj) 
    245                IF( ik > 1 ) THEN 
    246                   zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    247                   sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    248                ENDIF 
     280      IF( iom_use('sshthster')) THEN 
     281         CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
     282         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     283         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
     284         CALL iom_close( inum ) 
     285 
     286         sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     287         sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     288         IF( ln_zps ) THEN               ! z-coord. partial steps 
     289            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     290               DO ji = 1, jpi 
     291                  ik = mbkt(ji,jj) 
     292                  IF( ik > 1 ) THEN 
     293                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     294                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     295                  ENDIF 
     296               END DO 
    249297            END DO 
    250          END DO 
     298         ENDIF 
    251299      ENDIF 
    252300      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r5602 r7806  
    99   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
    1010   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
     11   !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    2122   USE dom_oce          ! ocean space and time domain 
    2223   USE phycst           ! physical constants 
     24   USE ldftra_oce  
    2325   ! 
    2426   USE iom              ! IOM library 
    … …  
    3840   PUBLIC   dia_ptr_init   ! call in step module 
    3941   PUBLIC   dia_ptr        ! call in step module 
     42   PUBLIC   dia_ptr_ohst_components        ! called from tra_ldf/tra_adv routines 
    4043 
    4144   !                                  !!** namelist  namptr  ** 
    42    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
    43    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    44     
     45   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv, htr_vt   !: Heat TRansports (adv, diff, Bolus.) 
     46   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv, str_vs   !: Salt TRansports (adv, diff, Bolus.) 
     47   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.) 
     48   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic ) 
    4549 
    4650   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    4751   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
    48    INTEGER        ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
     52   INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
    4953 
    5054   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    … …  
    6569   !!---------------------------------------------------------------------- 
    6670   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    67    !! $Id$  
     71   !! $Id$ 
    6872   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6973   !!---------------------------------------------------------------------- 
    … …  
    7781      ! 
    7882      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    79       REAL(wp) ::   zv, zsfc               ! local scalar 
     83      REAL(wp) ::   zsfc,zvfc               ! local scalar 
    8084      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    8185      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
    8286      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    8387      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    84       CHARACTER( len = 10 )  :: cl1 
     88      REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace 
     89      REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace 
     90  
     91      ! 
     92      !overturning calculation 
     93      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
     94      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
     96 
     97 
     98      CHARACTER( len = 12 )  :: cl1 
    8599      !!---------------------------------------------------------------------- 
    86100      ! 
    … …  
    111125            END DO 
    112126         ENDIF 
     127         IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     128            ! define fields multiplied by scalar 
     129            zmask(:,:,:) = 0._wp 
     130            zts(:,:,:,:) = 0._wp 
     131            zvn(:,:,:) = 0._wp 
     132            DO jk = 1, jpkm1 
     133               DO jj = 1, jpjm1 
     134                  DO ji = 1, jpi 
     135                     zvfc = e1v(ji,jj) * fse3v(ji,jj,jk) 
     136                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     137                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     138                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
     139                     zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
     140                  ENDDO 
     141               ENDDO 
     142             ENDDO 
     143         ENDIF 
     144         IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 
     145             sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 
     146             r1_sjk(:,:,1) = 0._wp 
     147             WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 
     148 
     149             ! i-mean T and S, j-Stream-Function, global 
     150             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
     151             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
     152             v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
     153 
     154             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
     155             str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 
     156 
     157             z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW) 
     158             DO ji = 1, jpi 
     159               z2d(ji,:) = z2d(1,:) 
     160             ENDDO 
     161             cl1 = 'sophtove' 
     162             CALL iom_put( TRIM(cl1), z2d ) 
     163             z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg) 
     164             DO ji = 1, jpi 
     165               z2d(ji,:) = z2d(1,:) 
     166             ENDDO 
     167             cl1 = 'sopstove' 
     168             CALL iom_put( TRIM(cl1), z2d ) 
     169             IF( ln_subbas ) THEN 
     170                DO jn = 2, nptr 
     171                    sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     172                    r1_sjk(:,:,jn) = 0._wp 
     173                    WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
     174 
     175                    ! i-mean T and S, j-Stream-Function, basin 
     176                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     177                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     178                    v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
     179                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
     180                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
     181 
     182                    z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW) 
     183                    DO ji = 1, jpi 
     184                        z2d(ji,:) = z2d(1,:) 
     185                    ENDDO 
     186                    cl1 = TRIM('sophtove_'//clsubb(jn)) 
     187                    CALL iom_put( cl1, z2d ) 
     188                    z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg) 
     189                    DO ji = 1, jpi 
     190                        z2d(ji,:) = z2d(1,:) 
     191                    ENDDO 
     192                    cl1 = TRIM('sopstove_'//clsubb(jn)) 
     193                    CALL iom_put( cl1, z2d ) 
     194                END DO 
     195             ENDIF 
     196         ENDIF 
     197         IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     198         ! Calculate barotropic heat and salt transport here  
     199             sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 
     200             r1_sjk(:,1,1) = 0._wp 
     201             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
     202             
     203            vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
     204            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
     205            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
     206            htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 
     207            str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 
     208            z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW) 
     209            DO ji = 2, jpi 
     210               z2d(ji,:) = z2d(1,:) 
     211            ENDDO 
     212            cl1 = 'sophtbtr' 
     213            CALL iom_put( TRIM(cl1), z2d ) 
     214            z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg) 
     215            DO ji = 2, jpi 
     216              z2d(ji,:) = z2d(1,:) 
     217            ENDDO 
     218            cl1 = 'sopstbtr' 
     219            CALL iom_put( TRIM(cl1), z2d ) 
     220            IF( ln_subbas ) THEN 
     221                DO jn = 2, nptr 
     222                    sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     223                    r1_sjk(:,1,jn) = 0._wp 
     224                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
     225                    vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
     226                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     227                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     228                    htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 
     229                    str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 
     230                    z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW) 
     231                    DO ji = 1, jpi 
     232                        z2d(ji,:) = z2d(1,:) 
     233                    ENDDO 
     234                    cl1 = TRIM('sophtbtr_'//clsubb(jn)) 
     235                    CALL iom_put( cl1, z2d ) 
     236                    z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg) 
     237                    DO ji = 1, jpi 
     238                        z2d(ji,:) = z2d(1,:) 
     239                    ENDDO 
     240                    cl1 = TRIM('sopstbtr_'//clsubb(jn)) 
     241                    CALL iom_put( cl1, z2d ) 
     242               ENDDO 
     243            ENDIF !ln_subbas 
     244         ENDIF !iom_use("sopstbtr....) 
    113245         ! 
    114246      ELSE 
    … …  
    150282         !                                ! Advective and diffusive heat and salt transport 
    151283         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
    152             z2d(1,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW) 
     284            z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW) 
    153285            DO ji = 1, jpi 
    154286               z2d(ji,:) = z2d(1,:) 
    … …  
    156288            cl1 = 'sophtadv'                  
    157289            CALL iom_put( TRIM(cl1), z2d ) 
    158             z2d(1,:) = str_adv(:) * rc_ggram        ! (conversion in Gg) 
     290            z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg) 
    159291            DO ji = 1, jpi 
    160292               z2d(ji,:) = z2d(1,:) 
    … …  
    162294            cl1 = 'sopstadv' 
    163295            CALL iom_put( TRIM(cl1), z2d ) 
     296            IF( ln_subbas ) THEN 
     297              DO jn=2,nptr 
     298               z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW) 
     299               DO ji = 1, jpi 
     300                 z2d(ji,:) = z2d(1,:) 
     301               ENDDO 
     302               cl1 = TRIM('sophtadv_'//clsubb(jn))                  
     303               CALL iom_put( cl1, z2d ) 
     304               z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg) 
     305               DO ji = 1, jpi 
     306                  z2d(ji,:) = z2d(1,:) 
     307               ENDDO 
     308               cl1 = TRIM('sopstadv_'//clsubb(jn))                  
     309               CALL iom_put( cl1, z2d )               
     310              ENDDO 
     311            ENDIF 
    164312         ENDIF 
    165313         ! 
    166314         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
    167             z2d(1,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW)  
     315            z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW)  
    168316            DO ji = 1, jpi 
    169317               z2d(ji,:) = z2d(1,:) 
    … …  
    171319            cl1 = 'sophtldf' 
    172320            CALL iom_put( TRIM(cl1), z2d ) 
    173             z2d(1,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg) 
     321            z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg) 
    174322            DO ji = 1, jpi 
    175323               z2d(ji,:) = z2d(1,:) 
    … …  
    177325            cl1 = 'sopstldf' 
    178326            CALL iom_put( TRIM(cl1), z2d ) 
    179          ENDIF 
     327            IF( ln_subbas ) THEN 
     328              DO jn=2,nptr 
     329               z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW) 
     330               DO ji = 1, jpi 
     331                 z2d(ji,:) = z2d(1,:) 
     332               ENDDO 
     333               cl1 = TRIM('sophtldf_'//clsubb(jn))                  
     334               CALL iom_put( cl1, z2d ) 
     335               z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg) 
     336               DO ji = 1, jpi 
     337                  z2d(ji,:) = z2d(1,:) 
     338               ENDDO 
     339               cl1 = TRIM('sopstldf_'//clsubb(jn))                  
     340               CALL iom_put( cl1, z2d )               
     341              ENDDO 
     342            ENDIF 
     343         ENDIF 
     344 
     345         IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN    
     346            z2d(1,:) = htr_vt(:,1) * rc_pwatt        !  (conversion in PW)  
     347            DO ji = 1, jpi 
     348               z2d(ji,:) = z2d(1,:) 
     349            ENDDO 
     350            cl1 = 'sopht_vt' 
     351            CALL iom_put( TRIM(cl1), z2d ) 
     352            z2d(1,:) = str_vs(:,1) * rc_ggram        !  (conversion in Gg) 
     353            DO ji = 1, jpi 
     354               z2d(ji,:) = z2d(1,:) 
     355            ENDDO 
     356            cl1 = 'sopst_vs' 
     357            CALL iom_put( TRIM(cl1), z2d ) 
     358            IF( ln_subbas ) THEN 
     359              DO jn=2,nptr 
     360               z2d(1,:) = htr_vt(:,jn) * rc_pwatt        !  (conversion in PW) 
     361               DO ji = 1, jpi 
     362                 z2d(ji,:) = z2d(1,:) 
     363               ENDDO 
     364               cl1 = TRIM('sopht_vt_'//clsubb(jn))                  
     365               CALL iom_put( cl1, z2d ) 
     366               z2d(1,:) = str_vs(:,jn) * rc_ggram        ! (conversion in Gg) 
     367               DO ji = 1, jpi 
     368                  z2d(ji,:) = z2d(1,:) 
     369               ENDDO 
     370               cl1 = TRIM('sopst_vs_'//clsubb(jn))                  
     371               CALL iom_put( cl1, z2d )               
     372              ENDDO 
     373            ENDIF 
     374         ENDIF 
     375 
     376#ifdef key_diaeiv 
     377         IF(lk_traldf_eiv) THEN 
     378            IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
     379               z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
     380               DO ji = 1, jpi 
     381                  z2d(ji,:) = z2d(1,:) 
     382               ENDDO 
     383               cl1 = 'sophteiv' 
     384               CALL iom_put( TRIM(cl1), z2d ) 
     385               z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg) 
     386               DO ji = 1, jpi 
     387                  z2d(ji,:) = z2d(1,:) 
     388               ENDDO 
     389               cl1 = 'sopsteiv' 
     390               CALL iom_put( TRIM(cl1), z2d ) 
     391               IF( ln_subbas ) THEN 
     392                  DO jn=2,nptr 
     393                     z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW) 
     394                     DO ji = 1, jpi 
     395                        z2d(ji,:) = z2d(1,:) 
     396                     ENDDO 
     397                     cl1 = TRIM('sophteiv_'//clsubb(jn))                  
     398                     CALL iom_put( cl1, z2d ) 
     399                     z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg) 
     400                     DO ji = 1, jpi 
     401                        z2d(ji,:) = z2d(1,:) 
     402                     ENDDO 
     403                     cl1 = TRIM('sopsteiv_'//clsubb(jn))  
     404                     CALL iom_put( cl1, z2d )               
     405                  ENDDO 
     406               ENDIF 
     407            ENDIF 
     408         ENDIF 
     409#endif 
    180410         ! 
    181411      ENDIF 
    … …  
    256486         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    257487         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    258          htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp   
    259          htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp  
     488         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
     489         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
     490         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     491         htr_vt(:,:) = 0._wp  ;   str_vs(:,:) =  0._wp 
     492         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
     493         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
    260494         ! 
    261495      ENDIF  
    … …  
    263497   END SUBROUTINE dia_ptr_init 
    264498 
     499   SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva )  
     500      !!---------------------------------------------------------------------- 
     501      !!                    ***  ROUTINE dia_ptr_ohst_components  *** 
     502      !!---------------------------------------------------------------------- 
     503      !! Wrapper for heat and salt transport calculations to calculate them for each basin 
     504      !! Called from all advection and/or diffusion routines 
     505      !!---------------------------------------------------------------------- 
     506      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
     507      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
     508      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     509      INTEGER                                        :: jn    ! 
     510 
     511      IF( cptr == 'adv' ) THEN 
     512         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     513         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     514      ENDIF 
     515      IF( cptr == 'ldf' ) THEN 
     516         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     517         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     518      ENDIF 
     519      IF( cptr == 'eiv' ) THEN 
     520         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     521         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     522      ENDIF 
     523      IF( cptr == 'vts' ) THEN 
     524         IF( ktra == jp_tem )  htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 
     525         IF( ktra == jp_sal )  str_vs(:,1) = ptr_sj( pva(:,:,:) ) 
     526      ENDIF 
     527      ! 
     528      IF( ln_subbas ) THEN 
     529         ! 
     530         IF( cptr == 'adv' ) THEN 
     531             IF( ktra == jp_tem ) THEN  
     532                DO jn = 2, nptr 
     533                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     534                END DO 
     535             ENDIF 
     536             IF( ktra == jp_sal ) THEN  
     537                DO jn = 2, nptr 
     538                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     539                END DO 
     540             ENDIF 
     541         ENDIF 
     542         IF( cptr == 'ldf' ) THEN 
     543             IF( ktra == jp_tem ) THEN  
     544                DO jn = 2, nptr 
     545                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     546                 END DO 
     547             ENDIF 
     548             IF( ktra == jp_sal ) THEN  
     549                DO jn = 2, nptr 
     550                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     551                END DO 
     552             ENDIF 
     553         ENDIF 
     554         IF( cptr == 'eiv' ) THEN 
     555             IF( ktra == jp_tem ) THEN  
     556                DO jn = 2, nptr 
     557                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     558                 END DO 
     559             ENDIF 
     560             IF( ktra == jp_sal ) THEN  
     561                DO jn = 2, nptr 
     562                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     563                END DO 
     564             ENDIF 
     565         ENDIF 
     566         IF( cptr == 'vts' ) THEN 
     567             IF( ktra == jp_tem ) THEN  
     568                DO jn = 2, nptr 
     569                    htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     570                 END DO 
     571             ENDIF 
     572             IF( ktra == jp_sal ) THEN  
     573                DO jn = 2, nptr 
     574                   str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     575                END DO 
     576             ENDIF 
     577         ENDIF 
     578         ! 
     579      ENDIF 
     580   END SUBROUTINE dia_ptr_ohst_components 
     581 
    265582 
    266583   FUNCTION dia_ptr_alloc() 
    … …  
    273590      ierr(:) = 0 
    274591      ! 
    275       ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    276          &      htr_adv(jpj) , str_adv(jpj) ,   & 
    277          &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  ) 
     592      ALLOCATE( btmsk(jpi,jpj,nptr) ,              & 
     593         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
     594         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
     595         &      htr_vt(jpj,nptr)  , str_vs(jpj,nptr)  ,   & 
     596         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   & 
     597         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   & 
     598         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  ) 
    278599         ! 
    279600      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
    … …  
    402723#endif 
    403724      !!-------------------------------------------------------------------- 
    404       ! 
     725     ! 
    405726      p_fval => p_fval2d 
    406727 
    … …  
    434755#endif 
    435756      ! 
     757 
    436758   END FUNCTION ptr_sjk 
    437759 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7256 r7806  
    156156      IF( iom_use("e3tdef") )   & 
    157157         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
     158      CALL iom_put("tpt_dep", fsdept_n(:,:,:) ) 
     159 
    158160 
    159161 
    … …  
    318320      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
    319321      ! 
    320       IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
     322      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    321323         z3d(:,:,jpk) = 0.e0 
     324         z2d(:,:) = 0.e0 
    322325         DO jk = 1, jpkm1 
    323326            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     327            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    324328         END DO 
    325329         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     330         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    326331      ENDIF 
    327332       
    … …  
    386391         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    387392      ENDIF 
     393 
     394      ! Vertical integral of temperature 
     395      IF( iom_use("tosmint") ) THEN 
     396         z2d(:,:)=0._wp 
     397         DO jk = 1, jpkm1 
     398            DO jj = 2, jpjm1 
     399               DO ji = fs_2, fs_jpim1   ! vector opt. 
     400                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
     401               END DO 
     402            END DO 
     403         END DO 
     404         CALL lbc_lnk( z2d, 'T', -1. ) 
     405         CALL iom_put( "tosmint", z2d )  
     406      ENDIF 
     407 
     408      ! Vertical integral of salinity 
     409      IF( iom_use("somint") ) THEN 
     410         z2d(:,:)=0._wp 
     411         DO jk = 1, jpkm1 
     412            DO jj = 2, jpjm1 
     413               DO ji = fs_2, fs_jpim1   ! vector opt. 
     414                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
     415               END DO 
     416            END DO 
     417         END DO 
     418         CALL lbc_lnk( z2d, 'T', -1. ) 
     419         CALL iom_put( "somint", z2d )  
     420      ENDIF 
     421 
     422      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2) 
    388423      ! 
    389424      CALL wrk_dealloc( jpi , jpj      , z2d ) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7217 r7806  
    2323   USE dom_oce         ! domain: ocean 
    2424   USE sbc_oce         ! surface boundary condition: ocean 
     25   USE trc_oce         ! shared ocean-passive tracers variables 
    2526   USE phycst          ! physical constants 
    2627   USE closea          ! closed seas 
    … …  
    9798      END DO 
    9899      ! 
    99       IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh 
    100       ! 
    101       IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
    102       ! 
    103       ! 
    104       hu(:,:) = 0._wp                          ! Ocean depth at U-points 
    105       hv(:,:) = 0._wp                          ! Ocean depth at V-points 
    106       ht(:,:) = 0._wp                          ! Ocean depth at T-points 
    107       DO jk = 1, jpkm1 
    108          hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    109          hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
    110          ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    111       END DO 
    112       !                                        ! Inverse of the local depth 
    113       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    114       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     100      IF( lk_c1d )           CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
     101      ! 
     102      IF( .NOT.lk_offline ) THEN 
     103        ! 
     104        IF( lk_vvl )         CALL dom_vvl_init ! Vertical variable mesh 
     105        ! 
     106        hu(:,:) = 0._wp                          ! Ocean depth at U-points 
     107        hv(:,:) = 0._wp                          ! Ocean depth at V-points 
     108        ht(:,:) = 0._wp                          ! Ocean depth at T-points 
     109        DO jk = 1, jpkm1 
     110           hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
     111           hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     112           ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     113        END DO 
     114        !                                        ! Inverse of the local depth 
     115        hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
     116        hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     117        ! 
     118      ENDIF 
    115119 
    116120                             CALL dom_stp      ! time step 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r7256 r7806  
    395395      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry' 
    396396      IF(lwp) WRITE(numout,*) '    ~~~~~~~' 
     397      ! 
     398      ! (ISF) initialisation ice shelf draft and top level 
     399      risfdep(:,:)=0._wp 
     400      misfdep(:,:)=1 
    397401      !                                               ! ================== !  
    398402      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  ! 
    … …  
    484488            END DO 
    485489         END DO 
    486          risfdep(:,:)=0.e0 
    487          misfdep(:,:)=1 
    488490         ! 
    489491         DEALLOCATE( idta, zdta ) 
    … …  
    535537            CALL iom_close( inum ) 
    536538            !                                                 
    537             risfdep(:,:)=0._wp          
    538             misfdep(:,:)=1              
    539539            IF ( ln_isfcav ) THEN 
    540540               CALL iom_open ( 'isf_draft_meter.nc', inum )  

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5602 r7806  
    6565#if defined key_lim3 || defined key_cice 
    6666   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    67    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    68    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    69    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     67   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     68   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K] 
    7069   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7170   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    … …  
    8382   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
    8483   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     84#endif 
     85#if defined key_cice 
     86   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K], now namelist parameter for LIM3 
    8587#endif 
    8688#if defined key_lim3 
    … …  
    177179      IF(lwp) THEN 
    178180         WRITE(numout,*) 
     181#if defined key_cice 
    179182         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    180          WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
     183#endif 
     184         WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    181185         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    182186         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4990 r7806  
    166166            ! 
    167167         ENDIF 
     168        IF( l_trddyn )   THEN                      ! Put here so code doesn't crash when doing KE trend but needs to be done properly 
     169            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
     170         ENDIF 
    168171         ! 
    169172      ELSE                       ! fixed volume  (add the surface pressure gradient + unweighted time stepping) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5602 r7806  
    601601            DO jk = 1, jpk 
    602602               DO jj = 1, jpjm1 
    603                   DO ji = 1, jpim1 
     603                  DO ji = 1, fs_jpim1 
    604604                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    605605                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    606                      IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = 4.0_wp / ze3 
     606                     IF   ( ze3 /= 0._wp ) THEN ;   ze3f(ji,jj,jk) = 4.0_wp / ze3 
     607                     ELSE                       ;   ze3f(ji,jj,jk) = 0.0_wp 
     608                     ENDIF 
    607609                  END DO 
    608610               END DO 
    … …  
    611613            DO jk = 1, jpk 
    612614               DO jj = 1, jpjm1 
    613                   DO ji = 1, jpim1 
     615                  DO ji = 1, fs_jpim1 
    614616                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    615617                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    616618                     zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    617619                        &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
    618                      IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3 
     620                     IF   ( ze3 /= 0._wp ) THEN ;   ze3f(ji,jj,jk) = zmsk / ze3 
     621                     ELSE                       ;   ze3f(ji,jj,jk) = 0.0_wp 
     622                     ENDIF 
    619623                  END DO 
    620624               END DO 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r7398 r7806  
    235235      ! automatic definitions of some of the xml attributs 
    236236      CALL set_xmlatt 
     237 
     238      CALL set_1point 
    237239 
    238240      ! end file definition 
    … …  
    15861588      zz=REAL(narea,wp) 
    15871589      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1588        
     1590 
    15891591   END SUBROUTINE set_scalar 
     1592 
     1593   SUBROUTINE set_1point 
     1594      !!---------------------------------------------------------------------- 
     1595      !!                     ***  ROUTINE set_1point  *** 
     1596      !! 
     1597      !! ** Purpose :   define zoom grid for scalar fields 
     1598      !! 
     1599      !!---------------------------------------------------------------------- 
     1600      REAL(wp), DIMENSION(1)   ::   zz = 1. 
     1601      INTEGER  :: ix, iy 
     1602      !!---------------------------------------------------------------------- 
     1603      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  Nearest point to north pole should be ocean 
     1604      CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 
     1605 
     1606   END SUBROUTINE set_1point 
    15901607 
    15911608 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r5601 r7806  
    804804            ELSE 
    805805               startloop = 3 
    806                pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     806               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    807807            ENDIF 
    808808            DO ji = startloop, nlci 
    … …  
    816816            ELSE 
    817817               startloop = 3 
    818                pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     818               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    819819            ENDIF 
    820820            DO ji = startloop, nlci 
    … …  
    910910               DO ji = startloop , endloop 
    911911                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    912                   pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
     912                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    913913               END DO 
    914914 
    … …  
    926926               DO ji = startloop , endloop 
    927927                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    928                   pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
     928                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 
    929929               END DO 
    930930 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7256 r7806  
    40264026      INTEGER          , INTENT(inout) ::   kios      ! IO status after reading the namelist 
    40274027      CHARACTER(len=*) , INTENT(in   ) ::   cdnam     ! group name of namelist for which error occurs 
    4028       CHARACTER(len=4)                 ::   clios     ! string to convert iostat in character for print 
     4028      CHARACTER(len=5)                 ::   clios     ! string to convert iostat in character for print 
    40294029      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print 
    40304030      !!---------------------------------------------------------------------- 
    … …  
    40324032      !  
    40334033      ! ---------------- 
    4034       WRITE (clios, '(I4.0)') kios 
     4034      WRITE (clios, '(I5.0)') kios 
    40354035      IF( kios < 0 ) THEN          
    40364036         CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' & 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r7256 r7806  
    3939   !                             !!* namelist namsbc_alb 
    4040   INTEGER  ::   nn_ice_alb 
    41    REAL(wp) ::   rn_albice 
     41   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 
    4242 
    4343   !!---------------------------------------------------------------------- 
    … …  
    101101      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    102102 
     103      ralb_sf = rn_alb_sdry ! dry snow 
     104      ralb_sm = rn_alb_smlt ! melting snow 
     105      ralb_if = rn_alb_idry ! bare frozen ice 
     106      ralb_im = rn_alb_imlt ! bare puddled ice  
    103107       
    104108      SELECT CASE ( nn_ice_alb ) 
    … …  
    109113      CASE( 0 ) 
    110114        
    111          ralb_sf = 0.80       ! dry snow 
    112          ralb_sm = 0.65       ! melting snow 
    113          ralb_if = 0.72       ! bare frozen ice 
    114          ralb_im = rn_albice  ! bare puddled ice  
    115           
     115         !ralb_sf = 0.80       ! dry snow 
     116         !ralb_sm = 0.65       ! melting snow 
     117         !ralb_if = 0.72       ! bare frozen ice 
     118         !ralb_im = ...        ! bare puddled ice  
     119 
    116120         !  Computation of ice albedo (free of snow) 
    117121         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
    … …  
    163167      CASE( 1 )  
    164168 
    165          ralb_im = rn_albice  ! bare puddled ice 
     169!        ralb_im = ...        ! bare puddled ice 
    166170! compilation of values from literature 
    167          ralb_sf = 0.85      ! dry snow 
    168          ralb_sm = 0.75      ! melting snow 
    169          ralb_if = 0.60      ! bare frozen ice 
     171!        ralb_sf = 0.85      ! dry snow 
     172!        ralb_sm = 0.75      ! melting snow 
     173!        ralb_if = 0.60      ! bare frozen ice 
    170174! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 
    171175!         ralb_sf = 0.85       ! dry snow 
    … …  
    248252      !!---------------------------------------------------------------------- 
    249253      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    250       NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
     254      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt 
    251255      !!---------------------------------------------------------------------- 
    252256      ! 
    … …  
    268272         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
    269273         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb 
    270          WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice 
     274         WRITE(numout,*) '      albedo of dry snow                                  rn_alb_sdry = ', rn_alb_sdry 
     275         WRITE(numout,*) '      albedo of melting snow                              rn_alb_smlt = ', rn_alb_smlt 
     276         WRITE(numout,*) '      albedo of dry ice                                   rn_alb_idry = ', rn_alb_idry 
     277         WRITE(numout,*) '      albedo of bare puddled ice                          rn_alb_imlt = ', rn_alb_imlt 
    271278      ENDIF 
    272279      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5602 r7806  
    113113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]   
    114114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]   
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]   
    115116   !! 
    116117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
    … …  
    164165         ! 
    165166      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    166          &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     167         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,     & 
     168         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) ) 
    167169         ! 
    168170      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7256 r7806  
    4343   USE eosbn2 
    4444   USE sbcrnf   , ONLY : l_rnfcpl 
     45   USE sbcisf   , ONLY : l_isfcpl 
    4546#if defined key_cpl_carbon_cycle 
    4647   USE p4zflx, ONLY : oce_co2 
    … …  
    105106   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106107   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108   INTEGER, PARAMETER ::   jpr_isf    = 43 
     109   INTEGER, PARAMETER ::   jpr_icb    = 44 
     110   INTEGER, PARAMETER ::   jprcv      = 44            ! total number of fields received 
    108111 
    109112   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    … …  
    149152   ! Received from the atmosphere                     ! 
    150153   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    151    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     154   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_icb, sn_rcv_isf                                
    152155   ! Other namelist parameters                        ! 
    153156   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    219222         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
    220223         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
    221          &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
     224         &                  sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf, nn_cplmodel  , ln_usecplmask 
    222225      !!--------------------------------------------------------------------- 
    223226      ! 
    … …  
    258261         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    259262         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     263         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')' 
     264         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
    260265         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    261266         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
    … …  
    397402      END SELECT 
    398403 
    399       !                                                      ! ------------------------- ! 
    400       !                                                      !     Runoffs & Calving     !    
    401       !                                                      ! ------------------------- ! 
     404 
     405      !                                                      ! ---------------------------------------------------- ! 
     406      !                                                      !     Runoffs, Calving, Iceberg, Iceshelf cavities     !    
     407      !                                                      ! ---------------------------------------------------- ! 
    402408      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    403409      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    … …  
    409415      ENDIF 
    410416      ! 
    411       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     417      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     418      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
     419      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     420 
     421      IF( srcv(jpr_isf)%laction .AND. nn_isf > 0 ) THEN 
     422         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf 
     423         IF(lwp) WRITE(numout,*) 
     424         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis ' 
     425      ENDIF 
    412426 
    413427      !                                                      ! ------------------------- ! 
    … …  
    10711085         ENDIF 
    10721086         ! 
     1087         !    
    10731088         !                                                        ! runoffs and calving (added in emp) 
    1074          IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1089         IF( srcv(jpr_rnf)%laction )     rnf(:,:)  = frcv(jpr_rnf)%z3(:,:,1) 
    10751090         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1091 
     1092         IF( srcv(jpr_icb)%laction )  THEN  
     1093             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1094             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs 
     1095         ENDIF 
     1096         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
    10761097          
    10771098         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
    … …  
    10911112            ENDIF 
    10921113         ENDIF 
     1114         ! 
     1115         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1116         ! 
    10931117         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
    10941118         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    … …  
    13871411      ! 
    13881412      INTEGER ::   jl         ! dummy loop index 
    1389       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk, zsnw 
     1413      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw 
    13901414      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 
    13911415      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
    … …  
    13951419      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    13961420      ! 
    1397       CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1421      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
    13981422      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    13991423      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
    … …  
    14181442         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    14191443         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 
    1420                CALL iom_put( 'rain'         ,   frcv(jpr_rain)%z3(:,:,1)                                                         )  ! liquid precipitation  
     1444         IF( iom_use('precip') )          & 
     1445            &  CALL iom_put( 'precip'       ,   frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1)                              )  ! total  precipitation 
     1446         IF( iom_use('rain') )            & 
     1447            &  CALL iom_put( 'rain'         ,   frcv(jpr_rain)%z3(:,:,1)                                                         )  ! liquid precipitation  
     1448         IF( iom_use('rain_ao_cea') )   & 
     1449            &  CALL iom_put( 'rain_ao_cea'  , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1)      )   ! liquid precipitation  
    14211450         IF( iom_use('hflx_rain_cea') )   & 
    1422             &  CALL iom_put( 'hflx_rain_cea',   frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:)                                            )  ! heat flux from liq. precip.  
     1451            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1))   ! heat flux from liq. precip.  
     1452         IF( iom_use('hflx_prec_cea') )   & 
     1453            CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) )   ! heat content flux from all precip  (cell avg) 
     1454         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
     1455            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    14231456         IF( iom_use('evap_ao_cea'  ) )   & 
    1424             &  CALL iom_put( 'evap_ao_cea'  ,   frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)                )  ! ice-free oce evap (cell average) 
     1457            CALL iom_put( 'evap_ao_cea'  , ztmp * tmask(:,:,1)                  )   ! ice-free oce evap (cell average) 
    14251458         IF( iom_use('hflx_evap_cea') )   & 
    1426             &  CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) )  ! heat flux from from evap (cell average) 
    1427       CASE( 'oce and ice' )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
     1459            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) )   ! heat flux from from evap (cell average) 
     1460      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    14281461         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    14291462         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 
    … …  
    14581491         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    14591492      ENDIF 
     1493 
     1494      IF( srcv(jpr_icb)%laction )  THEN  
     1495         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1496         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1497         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1498      ENDIF 
     1499      IF( srcv(jpr_isf)%laction )  THEN 
     1500        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1501        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1502      ENDIF 
     1503 
    14601504 
    14611505      IF( ln_mixcpl ) THEN 
    … …  
    14881532      ! runoffs and calving (put in emp_tot) 
    14891533      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1534      IF( iom_use('hflx_rnf_cea') )   & 
     1535         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
    14901536      IF( srcv(jpr_cal)%laction ) THEN  
    14911537         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    14921538         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    14931539      ENDIF 
     1540 
     1541 
     1542      IF( srcv(jpr_icb)%laction )  THEN  
     1543         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1544         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1545         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1546      ENDIF 
     1547      IF( srcv(jpr_isf)%laction )  THEN 
     1548        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1549        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1550      ENDIF 
     1551 
    14941552 
    14951553      IF( ln_mixcpl ) THEN 
    … …  
    15601618      ENDIF 
    15611619 
     1620!!chris      
     1621!!    The heat content associated to the ice shelf in removed in the routine sbcisf.F90 
     1622      ! 
     1623      IF( srcv(jpr_icb)%laction )  zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1624      ! 
     1625!!      ! 
     1626 
    15621627#if defined key_lim3       
    15631628      ! --- non solar flux over ocean --- ! 
    … …  
    15661631      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
    15671632 
     1633      ! Heat content per unit mass of snow (J/kg) 
     1634      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = cpic * SUM( (tn_ice -rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1635      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:) 
     1636      ENDWHERE 
     1637      ! Heat content per unit mass of rain (J/kg) 
     1638      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) -rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )  
     1639 
    15681640      ! --- heat flux associated with emp (W/m2) --- ! 
    15691641      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn(:,:)   &       ! evap 
    1570          &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &       ! liquid precip 
    1571          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus )  ! solid precip over ocean + snow melting 
     1642         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &       ! liquid precip 
     1643         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw(:,:) - lfus )  ! solid precip over ocean + snow melting 
    15721644!      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
    15731645!         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
    1574       zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 
     1646      zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptsnw(:,:) - lfus ) ! solid precip over ice (only) 
    15751647                                                                                                       ! qevap_ice=0 since we consider Tice=0degC 
    15761648       
    15771649      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    1578       zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1650      zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus ) 
     1651      !zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1652       
    15791653 
    15801654      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
    … …  
    17371811      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    17381812 
    1739       CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1813      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
    17401814      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    17411815      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r7256 r7806  
    650650CONTAINS 
    651651   SUBROUTINE sbc_ice_lim ( kt, kblk )     ! Dummy routine 
     652      INTEGER, INTENT(in) ::   kt, kblk 
    652653      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 
    653654   END SUBROUTINE sbc_ice_lim 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r7256 r7806  
    3232   PRIVATE 
    3333 
    34    PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur 
     34   PUBLIC   sbc_isf, sbc_isf_init, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur 
    3535 
    3636   ! public in order to be able to output then  
    … …  
    5454   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 
    5555   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
     56 
     57   LOGICAL, PUBLIC ::   l_isfcpl = .false.       ! isf recieved from oasis 
    5658 
    5759 
    … …  
    8183  
    8284  SUBROUTINE sbc_isf(kt) 
     85 
    8386    INTEGER, INTENT(in)          ::   kt         ! ocean time step 
     87    INTEGER                      ::   ji, jj, jk 
     88    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer 
     89    REAL(wp)                     ::   zhk 
     90    REAL(wp)                     ::   zt_frz, zpress 
     91    REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 
     92    REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d 
     93    REAL(wp)                            :: zhisf 
     94 
     95 
     96      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
     97 
     98         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 
     99         DO jj = 1,jpj 
     100            DO ji = 1,jpi 
     101               ikt = misfkt(ji,jj) 
     102               ikb = misfkt(ji,jj) 
     103               ! thickness of boundary layer at least the top level thickness 
     104               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt)) 
     105 
     106               ! determine the deepest level influenced by the boundary layer 
     107               DO jk = ikt, mbkt(ji,jj) 
     108                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     109               END DO 
     110               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     111               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
     112               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
     113 
     114               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
     115               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     116            END DO 
     117         END DO 
     118 
     119         ! compute salf and heat flux 
     120         IF (nn_isf == 1) THEN 
     121            ! realistic ice shelf formulation 
     122            ! compute T/S/U/V for the top boundary layer 
     123            CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T') 
     124            CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T') 
     125            CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U') 
     126            CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V') 
     127            ! iom print 
     128            CALL iom_put('ttbl',ttbl(:,:)) 
     129            CALL iom_put('stbl',stbl(:,:)) 
     130            CALL iom_put('utbl',utbl(:,:)) 
     131            CALL iom_put('vtbl',vtbl(:,:)) 
     132            ! compute fwf and heat flux 
     133            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt) 
     134            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * lfusisf              ! heat        flux 
     135            ENDIF 
     136 
     137         ELSE IF (nn_isf == 2) THEN 
     138            ! Beckmann and Goosse parametrisation  
     139            stbl(:,:)   = soce 
     140            CALL sbc_isf_bg03(kt) 
     141 
     142         ELSE IF (nn_isf == 3) THEN 
     143            ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
     144            IF( .NOT.l_isfcpl ) THEN 
     145               CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
     146               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
     147            ENDIF 
     148            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
     149            stbl(:,:)   = soce 
     150 
     151         ELSE IF (nn_isf == 4) THEN 
     152            ! specified fwf and heat flux forcing beneath the ice shelf 
     153            IF( .NOT.l_isfcpl ) THEN 
     154               CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
     155               !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
     156               fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
     157            ENDIF 
     158            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
     159            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
     160            stbl(:,:)   = soce 
     161 
     162         END IF 
     163         ! compute tsc due to isf 
     164         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 
     165!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
     166         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
     167         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 
     168          
     169         ! salt effect already take into account in vertical advection 
     170         risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 
     171 
     172         ! output 
     173         IF( iom_use('qlatisf' ) )   CALL iom_put('qlatisf', qisf) 
     174         IF( iom_use('fwfisf'  ) )   CALL iom_put('fwfisf' , fwfisf * stbl(:,:) / soce ) 
     175 
     176         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 
     177         fwfisf(:,:) = rdivisf * fwfisf(:,:)          
     178  
     179         ! lbclnk 
     180         CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) 
     181         CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.) 
     182         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.) 
     183         CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
     184 
     185         ! Diagnostics 
     186         IF( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 
     187            ! 
     188            CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     189            CALL wrk_alloc( jpi,jpj,     zqhcisf2d                        ) 
     190            ! 
     191            zfwfisf3d(:,:,:) = 0.0_wp                         ! 3d ice shelf melting (kg/m2/s) 
     192            zqhcisf3d(:,:,:) = 0.0_wp                         ! 3d heat content flux (W/m2) 
     193            zqlatisf3d(:,:,:)= 0.0_wp                         ! 3d ice shelf melting latent heat flux (W/m2) 
     194            zqhcisf2d(:,:)   = fwfisf(:,:) * zt_frz * rcp     ! 2d heat content flux (W/m2) 
     195            ! 
     196            DO jj = 1,jpj 
     197               DO ji = 1,jpi 
     198                  ikt = misfkt(ji,jj) 
     199                  ikb = misfkb(ji,jj) 
     200                  DO jk = ikt, ikb - 1 
     201                     zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     202                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf(ji,jj)    * zhisf 
     203                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf 
     204                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf(ji,jj)      * zhisf 
     205                  END DO 
     206                  jk = ikb 
     207                  zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     208                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * zhisf * ralpha(ji,jj)  
     209                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf * ralpha(ji,jj) 
     210                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * zhisf * ralpha(ji,jj) 
     211               END DO 
     212            END DO 
     213            ! 
     214            CALL iom_put( 'fwfisf3d' , zfwfisf3d (:,:,:) ) 
     215            CALL iom_put( 'qlatisf3d', zqlatisf3d(:,:,:) ) 
     216            CALL iom_put( 'qhcisf3d' , zqhcisf3d (:,:,:) ) 
     217            CALL iom_put( 'qhcisf'   , zqhcisf2d (:,:  ) ) 
     218            ! 
     219            CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     220            CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        ) 
     221            ! 
     222         END IF 
     223         !  
     224      END IF 
     225      ! 
     226      ! 
     227      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
     228         IF( ln_rstart .AND.    &                     ! Restart: read in restart file 
     229              & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 
     230            IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
     231            CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) ) ! before salt content isf_tsc trend 
     232            CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend 
     233            CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend 
     234         ELSE 
     235            fwfisf_b(:,:)    = fwfisf(:,:) 
     236            risf_tsc_b(:,:,:)= risf_tsc(:,:,:) 
     237         END IF 
     238      ENDIF 
     239      ! 
     240      IF( lrst_oce ) THEN 
     241         IF(lwp) WRITE(numout,*) 
     242         IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   & 
     243            &                    'at it= ', kt,' date= ', ndastp 
     244         IF(lwp) WRITE(numout,*) '~~~~' 
     245         CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 
     246         CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 
     247         CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 
     248      ENDIF 
     249       ! 
     250  END SUBROUTINE sbc_isf 
     251 
     252  SUBROUTINE sbc_isf_init 
     253 
    84254    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror 
    85255    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer 
    86     REAL(wp)                     ::   rmin 
    87256    REAL(wp)                     ::   zhk 
    88     REAL(wp)                     ::   zt_frz, zpress 
    89257    CHARACTER(len=256)           ::   cfisf , cvarzisf, cvarhisf   ! name for isf file 
    90258    CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file 
    91259    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale 
    92260    INTEGER           ::   ios           ! Local integer output status for namelist read 
     261 
    93262      ! 
    94263      !!--------------------------------------------------------------------- 
    … …  
    97266      ! 
    98267      ! 
    99       !                                         ! ====================== ! 
    100       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    101          !                                      ! ====================== ! 
    102268         REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    103269         READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901) 
    … …  
    139305            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv 
    140306         ELSE IF ((nn_isf == 3) .OR. (nn_isf == 2)) THEN 
    141             ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
    142             ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
    143             CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     307            IF( .NOT.l_isfcpl ) THEN 
     308               ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
     309               ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
     310               CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     311             ENDIF 
    144312 
    145313            !: read effective lenght (BG03) 
    … …  
    182350             
    183351            ! load variable used in fldread (use for temporal interpolation of isf fwf forcing) 
    184             ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
    185             ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
    186             ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
    187             CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
    188             !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     352            IF( .NOT.l_isfcpl ) THEN 
     353               ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
     354               ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
     355               ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
     356               CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     357               !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     358            ENDIF 
    189359         END IF 
    190           
    191360         ! save initial top boundary layer thickness          
    192361         rhisf_tbl_0(:,:) = rhisf_tbl(:,:) 
    193  
    194       END IF 
    195  
    196       !                                            ! ---------------------------------------- ! 
    197       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    198          !                                         ! ---------------------------------------- ! 
    199          fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000 
    200          risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine 
    201          ! 
    202       ENDIF 
    203  
    204       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
    205  
    206          ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 
    207          DO jj = 1,jpj 
    208             DO ji = 1,jpi 
    209                ikt = misfkt(ji,jj) 
    210                ikb = misfkt(ji,jj) 
    211                ! thickness of boundary layer at least the top level thickness 
    212                rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt)) 
    213  
    214                ! determine the deepest level influenced by the boundary layer 
    215                DO jk = ikt, mbkt(ji,jj) 
    216                   IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    217                END DO 
    218                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    219                misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
    220                r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    221  
    222                zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
    223                ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
    224             END DO 
    225          END DO 
    226  
    227          ! compute salf and heat flux 
    228          IF (nn_isf == 1) THEN 
    229             ! realistic ice shelf formulation 
    230             ! compute T/S/U/V for the top boundary layer 
    231             CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T') 
    232             CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T') 
    233             CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U') 
    234             CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V') 
    235             ! iom print 
    236             CALL iom_put('ttbl',ttbl(:,:)) 
    237             CALL iom_put('stbl',stbl(:,:)) 
    238             CALL iom_put('utbl',utbl(:,:)) 
    239             CALL iom_put('vtbl',vtbl(:,:)) 
    240             ! compute fwf and heat flux 
    241             CALL sbc_isf_cav (kt) 
    242  
    243          ELSE IF (nn_isf == 2) THEN 
    244             ! Beckmann and Goosse parametrisation  
    245             stbl(:,:)   = soce 
    246             CALL sbc_isf_bg03(kt) 
    247  
    248          ELSE IF (nn_isf == 3) THEN 
    249             ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
    250             CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
    251             fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
    252             qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    253             stbl(:,:)   = soce 
    254  
    255          ELSE IF (nn_isf == 4) THEN 
    256             ! specified fwf and heat flux forcing beneath the ice shelf 
    257             CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
    258             !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
    259             fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
    260             qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    261             !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
    262             stbl(:,:)   = soce 
    263  
    264          END IF 
    265          ! compute tsc due to isf 
    266          ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 
    267 !         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
    268          zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
    269          risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 
    270           
    271          ! salt effect already take into account in vertical advection 
    272          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 
    273  
    274          ! output 
    275          IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf) 
    276          IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 
    277  
    278          ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 
    279          fwfisf(:,:) = rdivisf * fwfisf(:,:)          
    280   
    281          ! lbclnk 
    282          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) 
    283          CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.) 
    284          CALL lbc_lnk(fwfisf(:,:)   ,'T',1.) 
    285          CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
    286  
    287          IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    288             IF( ln_rstart .AND.    &                     ! Restart: read in restart file 
    289                  & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 
    290                IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    291                CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) )   ! before salt content isf_tsc trend 
    292                CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend 
    293                CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend 
    294             ELSE 
    295                fwfisf_b(:,:)    = fwfisf(:,:) 
    296                risf_tsc_b(:,:,:)= risf_tsc(:,:,:) 
    297             END IF 
    298          ENDIF 
    299362         !  
    300       END IF 
    301    
    302   END SUBROUTINE sbc_isf 
     363   END SUBROUTINE sbc_isf_init 
     364       
     365 
    303366 
    304367  INTEGER FUNCTION sbc_isf_alloc() 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7256 r7806  
    300300      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    301301      ! 
     302      IF( nn_isf   /= 0    )   CALL sbc_isf_init               ! Compute iceshelves 
     303 
    302304                               CALL sbc_rnf_init               ! Runof initialisation 
    303305      ! 
    … …  
    343345            rnf_b    (:,:  ) = rnf    (:,:  ) 
    344346            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     347         ENDIF 
     348         IF( nn_isf /= 0  )  THEN 
     349            fwfisf_b  (:,:  ) = fwfisf  (:,:  )                
     350            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               
    345351         ENDIF 
    346352      ENDIF 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5602 r7806  
    2626   USE cla             ! cross land advection      (cla_traadv     routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   USE trd_oce         ! trends: ocean variables 
     29   USE trdtra          ! trends manager: tracers  
    2830   ! 
    2931   USE in_out_manager  ! I/O manager 
    … …  
    7981      INTEGER ::   jk   ! dummy loop index 
    8082      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    8184      !!---------------------------------------------------------------------- 
    8285      ! 
    … …  
    120123      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
    121124      ! 
    122     
     125      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     126         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     127         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     128         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     129      ENDIF 
     130      ! 
    123131      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    124132      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    … …  
    151159      END SELECT 
    152160      ! 
     161      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     162         DO jk = 1, jpkm1 
     163            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     164            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     165         END DO 
     166         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
     167         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
     168         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     169      ENDIF 
    153170      !                                              ! print mean trends (used for debugging) 
    154171      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r7256 r7806  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    282            IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    283            IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    284          ENDIF 
     281         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    285282         ! 
    286283      END DO 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r7256 r7806  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE diaptr         ! Heat/Salt transport diagnostics 
     31   USE trddyn 
     32   USE trd_oce 
    3033 
    3134   IMPLICIT NONE 
    … …  
    7881# endif   
    7982      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 
    8084      !!---------------------------------------------------------------------- 
    8185      ! 
    … …  
    8488# if defined key_diaeiv  
    8589      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     90      CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 
    8691# else 
    8792      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
    … …  
    160165         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current 
    161166         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current 
    162          IF( iom_use('ueiv_heattr') ) THEN 
    163             zztmp = 0.5 * rau0 * rcp  
     167         IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value 
     168           z2d(:,:) = rau0 * e12t(:,:) 
     169           DO jk = 1, jpk 
     170              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     171           END DO 
     172           CALL iom_put( "weiv_masstr" , z3d )   
     173         ENDIF 
     174         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d')        & 
     175                                    .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 
     176            z3d(:,:,jpk) = 0.e0 
     177            z2d(:,:) = 0.e0 
     178            DO jk = 1, jpkm1 
     179               z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     180               z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     181            END DO 
     182            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
     183         ENDIF 
     184 
     185         IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
     186            zztmp = 0.5 * rcp  
    164187            z2d(:,:) = 0.e0  
    165             DO jk = 1, jpkm1 
    166                DO jj = 2, jpjm1 
    167                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                      z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 
    169                        &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk)  
    170                   END DO 
    171                END DO 
    172             END DO 
    173             CALL lbc_lnk( z2d, 'U', -1. ) 
    174             CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
     188            z3d_T(:,:,:) = 0.e0  
     189            DO jk = 1, jpkm1 
     190               DO jj = 2, jpjm1 
     191                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     192                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     193                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     194                  END DO 
     195               END DO 
     196            END DO 
     197            IF (iom_use('ueiv_heattr') ) THEN 
     198               CALL lbc_lnk( z2d, 'U', -1. ) 
     199               CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! 2D heat transport in i-direction 
     200            ENDIF 
     201            IF (iom_use('ueiv_heattr3d') ) THEN 
     202               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     203               CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in i-direction 
     204            ENDIF 
     205         ENDIF 
     206 
     207         IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 
     208            zztmp = 0.5 * 0.001 
     209            z2d(:,:) = 0.e0  
     210            z3d_T(:,:,:) = 0.e0  
     211            DO jk = 1, jpkm1 
     212               DO jj = 2, jpjm1 
     213                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     214                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     215                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     216                  END DO 
     217               END DO 
     218            END DO 
     219            IF (iom_use('ueiv_salttr') ) THEN 
     220               CALL lbc_lnk( z2d, 'U', -1. ) 
     221               CALL iom_put( "ueiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     222            ENDIF 
     223            IF (iom_use('ueiv_salttr3d') ) THEN 
     224               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     225               CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     226            ENDIF 
     227         ENDIF 
     228 
     229         IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d')       & 
     230                                    .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 
     231            z3d(:,:,jpk) = 0.e0 
     232            DO jk = 1, jpkm1 
     233               z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     234            END DO 
     235            CALL iom_put( "veiv_masstr", z3d )                  ! mass transport in j-direction 
    175236         ENDIF 
    176237             
    177          IF( iom_use('veiv_heattr') ) THEN 
    178             zztmp = 0.5 * rau0 * rcp  
     238         IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 
     239            zztmp = 0.5 * rcp  
    179240            z2d(:,:) = 0.e0  
    180             DO jk = 1, jpkm1 
    181                DO jj = 2, jpjm1 
    182                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                      z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 
    184                      &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk)  
    185                   END DO 
    186                END DO 
    187             END DO 
    188             CALL lbc_lnk( z2d, 'V', -1. ) 
    189             CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in i-direction 
    190          ENDIF 
     241            z3d_T(:,:,:) = 0.e0  
     242            DO jk = 1, jpkm1 
     243               DO jj = 2, jpjm1 
     244                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     245                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     246                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     247                  END DO 
     248               END DO 
     249            END DO 
     250            IF (iom_use('veiv_heattr') ) THEN 
     251               CALL lbc_lnk( z2d, 'V', -1. ) 
     252               CALL iom_put( "veiv_heattr", zztmp * z2d )                  ! 2D heat transport in j-direction 
     253            ENDIF 
     254            IF (iom_use('veiv_heattr3d') ) THEN 
     255               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     256               CALL iom_put( "veiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in j-direction 
     257            ENDIF 
     258         ENDIF 
     259 
     260         IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 
     261            zztmp = 0.5 * 0.001 
     262            z2d(:,:) = 0.e0  
     263            z3d_T(:,:,:) = 0.e0  
     264            DO jk = 1, jpkm1 
     265               DO jj = 2, jpjm1 
     266                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     267                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     268                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 
     269                  END DO 
     270               END DO 
     271            END DO 
     272            IF (iom_use('veiv_salttr') ) THEN 
     273               CALL lbc_lnk( z2d, 'V', -1. ) 
     274               CALL iom_put( "veiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     275            ENDIF 
     276            IF (iom_use('veiv_salttr3d') ) THEN 
     277               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     278               CALL iom_put( "veiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     279            ENDIF 
     280         ENDIF 
     281 
     282         IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN   ! vertical mass transport & its square value 
     283           z2d(:,:) = rau0 * e12t(:,:) 
     284           DO jk = 1, jpk 
     285              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     286           END DO 
     287           CALL iom_put( "weiv_masstr" , z3d )                  ! mass transport in k-direction 
     288         ENDIF 
     289 
     290         IF( iom_use('weiv_heattr3d') ) THEN 
     291            zztmp = 0.5 * rcp  
     292            DO jk = 1, jpkm1 
     293               DO jj = 2, jpjm1 
     294                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     295                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 
     296                  END DO 
     297               END DO 
     298            END DO 
     299            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     300            CALL iom_put( "weiv_heattr3d", zztmp * z3d_T )                 ! 3D heat transport in k-direction 
     301         ENDIF 
     302 
     303         IF( iom_use('weiv_salttr3d') ) THEN 
     304            zztmp = 0.5 * 0.001  
     305            DO jk = 1, jpkm1 
     306               DO jj = 2, jpjm1 
     307                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     308                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 
     309                  END DO 
     310               END DO 
     311            END DO 
     312            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     313            CALL iom_put( "weiv_salttr3d", zztmp * z3d_T )                 ! 3D salt transport in k-direction 
     314         ENDIF 
     315 
    191316    END IF 
     317! 
     318    IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 
     319       z3d(:,:,:) = 0._wp 
     320       DO jk = 1, jpkm1 
     321          DO jj = 2, jpjm1 
     322             DO ji = fs_2, fs_jpim1   ! vector opt. 
     323                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 
     324                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     325             END DO 
     326          END DO 
     327       END DO 
     328       CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 
     329       z3d(:,:,:) = 0._wp 
     330       DO jk = 1, jpkm1 
     331          DO jj = 2, jpjm1 
     332             DO ji = fs_2, fs_jpim1   ! vector opt. 
     333                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 
     334                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     335             END DO 
     336          END DO 
     337       END DO 
     338       CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 
     339    ENDIF 
     340 
     341    IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 
    192342# endif   
    193       !  
     343 
    194344# if defined key_diaeiv  
    195345      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     346      CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 
    196347# else 
    197348      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r5602 r7806  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id$  
     47   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    … …  
    219219         END IF 
    220220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    222             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    223             IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    224          ENDIF 
     221         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    225222 
    226223         ! II. Vertical advective fluxes 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r5602 r7806  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    39    !! $Id$  
     39   !! $Id$ 
    4040   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
    … …  
    200200 
    201201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    202          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    203             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    204             IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    205          ENDIF 
     202         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    206203 
    207204         ! II. Vertical advective fluxes 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5602 r7806  
    355355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    356356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    357          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    358            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    359            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    360          ENDIF 
     357         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    361358         ! 
    362359      END DO 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r7256 r7806  
    2727   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    2828   USE diaptr         ! poleward transport diagnostics 
     29   USE phycst 
    2930   ! 
    3031   USE lib_mpp        ! MPP library 
    … …  
    3435   USE timing         ! Timing 
    3536   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     37   USE iom 
    3638 
    3739   IMPLICIT NONE 
    … …  
    4244 
    4345   LOGICAL ::   l_trd   ! flag to compute trends 
     46   LOGICAL ::   l_trans   ! flag to output vertically integrated transports 
    4447 
    4548   !! * Substitutions 
    … …  
    8588      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    8689      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     90      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 
     91      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    8892      !!---------------------------------------------------------------------- 
    8993      ! 
    … …  
    97101         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    98102         ! 
    99          l_trd = .FALSE. 
    100          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    101103      ENDIF 
    102       ! 
    103       IF( l_trd )  THEN 
     104 
     105      l_trd = .FALSE. 
     106      l_trans = .FALSE. 
     107      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     108      IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
     109      ! 
     110      IF( l_trd .OR. l_trans )  THEN 
    104111         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    105112         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
     113         CALL wrk_alloc( jpi, jpj, z2d ) 
     114      ENDIF 
     115      ! 
     116      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     117         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     118         zptry(:,:,:) = 0._wp 
    106119      ENDIF 
    107120      ! 
    … …  
    187200 
    188201         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    189          IF( l_trd )  THEN  
     202         IF( l_trd .OR. l_trans )  THEN  
    190203            ! store intermediate advective trends 
    191204            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    192205         END IF 
    193206         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    194          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    195            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    196            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    197          ENDIF 
     207         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
    198208 
    199209         ! 3. antidiffusive flux : high order minus low order 
    … …  
    253263 
    254264         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    255          IF( l_trd )  THEN  
     265         IF( l_trd .OR. l_trans )  THEN  
    256266            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    257267            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    258268            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    259              
    260             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    261             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    262             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     269         ENDIF 
     270          
     271         IF( l_trd ) THEN  
     272            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     273            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     274            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    263275         END IF 
    264          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     276 
     277         IF( l_trans .AND. jn==jp_tem ) THEN 
     278            z2d(:,:) = 0._wp  
     279            DO jk = 1, jpkm1 
     280               DO jj = 2, jpjm1 
     281                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     282                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
     283                  END DO 
     284               END DO 
     285            END DO 
     286            CALL lbc_lnk( z2d, 'U', -1. ) 
     287            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
     288              ! 
     289            z2d(:,:) = 0._wp  
     290            DO jk = 1, jpkm1 
     291               DO jj = 2, jpjm1 
     292                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     293                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
     294                  END DO 
     295               END DO 
     296            END DO 
     297            CALL lbc_lnk( z2d, 'V', -1. ) 
     298            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
     299         ENDIF 
     300         ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    265301         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    266            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
    267            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
     302            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     303            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    268304         ENDIF 
    269305         ! 
    270306      END DO 
    271307      ! 
    272                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
    273       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     308      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
     309      IF( l_trd .OR. l_trans )  THEN  
     310         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     311         CALL wrk_dealloc( jpi, jpj, z2d ) 
     312      ENDIF 
     313      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    274314      ! 
    275315      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
    … …  
    318358      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
    319359      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     360      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    320361      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 
    321362      !!---------------------------------------------------------------------- 
    … …  
    339380         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    340381         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
     382      ENDIF 
     383      ! 
     384      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     385         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     386         zptry(:,:,:) = 0._wp 
    341387      ENDIF 
    342388      ! 
    … …  
    428474         END IF 
    429475         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    430          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    431            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    432            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    433          ENDIF 
     476         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
    434477 
    435478         ! 3. antidiffusive flux : high order minus low order 
    … …  
    556599         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    557600         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    558            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
    559            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
     601            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
     602            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    560603         ENDIF 
    561604         ! 
    … …  
    566609                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    567610      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     611      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    568612      ! 
    569613      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts') 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90

    r7795 r7806  
    183183            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    184184         END IF 
    185          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    187            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    188            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    189          ENDIF 
    190185 
    191186         ! 3. antidiffusive flux : high order minus low order 
    … …  
    245240            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    246241         END IF 
    247          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    248          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    249            IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
    250            IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    251          ENDIF 
    252242         ! 
    253243      END DO 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r5602 r7806  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    180             IF( jn == jp_tem )  htr_adv(:) = ptr_sj( ztv(:,:,:) ) 
    181             IF( jn == jp_sal )  str_adv(:) = ptr_sj( ztv(:,:,:) ) 
    182          ENDIF 
     179         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 
    183180          
    184181         ! TVD scheme for the vertical direction   

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r5602 r7806  
    173173         !                                                 
    174174         ! "zonal" mean lateral diffusive heat and salt transport 
    175          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    176            IF( jn == jp_tem )  htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    177            IF( jn == jp_sal )  str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    178          ENDIF 
     175         IF( cdtype == 'TRA' .AND. ln_diaptr )   CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    179176         !                                                ! =========== 
    180177      END DO                                              ! tracer loop 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r5602 r7806  
    247247         !                                                ! =============== 
    248248         ! "Poleward" diffusive heat or salt transport 
    249          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 
    250             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    251             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    252             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    253          ENDIF 
     249        ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     250         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 
    254251 
    255252         !                             ! ************ !   ! =============== 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5602 r7806  
    235235         ! 
    236236         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    237          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    238237            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    239             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    240             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    241          ENDIF 
     238         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    242239  
    243240         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90

    r7311 r7806  
    210210         !                                             ! =============== 
    211211         ! 
    212          ! "Poleward" diffusive heat or salt transports (T-S case only) 
    213          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    214             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    215             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    216          ENDIF 
    217212  
    218213#if defined key_diaar5 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r5602 r7806  
    386386         ! 
    387387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    388          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    389             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
    390             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    391          ENDIF 
     388         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 
    392389 
    393390         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r5602 r7806  
    154154         ! 
    155155         ! "Poleward" diffusive heat or salt transports 
    156          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    157             IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    158             IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    159          ENDIF 
     156         IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    160157         !                                                  ! ================== 
    161158      END DO                                                ! end of tracer loop 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90

    r6772 r7806  
    149149         END DO                                             !  End of slab   
    150150         ! 
    151          ! "Poleward" diffusive heat or salt transports 
    152          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    153             IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    154             IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( ztv(:,:,:) ) 
    155          ENDIF 
    156151         !                                                  ! ================== 
    157152      END DO                                                ! end of tracer loop 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r7256 r7806  
    129129 
    130130      ! trends computation initialisation 
    131       IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter 
     131      IF( l_trdtra )   THEN                     
    132132         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    133          ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    134          ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     133         ztrdt(:,:,jk) = 0._wp 
     134         ztrds(:,:,jk) = 0._wp 
    135135         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    136136            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    137137            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
    138138         ENDIF 
     139         ! total trend for the non-time-filtered variables.  
     140         DO jk = 1, jpkm1 
     141            zfact = 1.0 / rdttra(jk) 
     142            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
     143            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
     144         END DO 
     145         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
     146         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 
     147         ! Store now fields before applying the Asselin filter  
     148         ! in order to calculate Asselin filter trend later. 
     149         ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
     150         ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
    139151      ENDIF 
    140152 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7256 r7806  
    248248            END DO 
    249249         END DO 
    250          IF( lrst_oce ) THEN 
    251             IF(lwp) WRITE(numout,*) 
    252             IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   & 
    253                &                    'at it= ', kt,' date= ', ndastp 
    254             IF(lwp) WRITE(numout,*) '~~~~' 
    255             CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          ) 
    256             CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 
    257             CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 
    258          ENDIF 
    259250      END IF 
    260251      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

    r5602 r7806  
    3333# endif 
    3434   !                                                  !!!* Active tracers trends indexes 
    35    INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 14     !: Total trend nb: change it when adding/removing one indice below 
     35   INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 20     !: Total trend nb: change it when adding/removing one indice below 
    3636   !                               ===============     !   
    3737   INTEGER, PUBLIC, PARAMETER ::   jptra_xad  =  1     !: x- horizontal advection 
    … …  
    3939   INTEGER, PUBLIC, PARAMETER ::   jptra_zad  =  3     !: z- vertical   advection 
    4040   INTEGER, PUBLIC, PARAMETER ::   jptra_sad  =  4     !: z- vertical   advection 
    41    INTEGER, PUBLIC, PARAMETER ::   jptra_ldf  =  5     !: lateral       diffusion 
    42    INTEGER, PUBLIC, PARAMETER ::   jptra_zdf  =  6     !: vertical      diffusion 
    43    INTEGER, PUBLIC, PARAMETER ::   jptra_zdfp =  7     !: "PURE" vert.  diffusion (ln_traldf_iso=T) 
    44    INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  =  8     !: Bottom Boundary Condition (geoth. heating)  
    45    INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  =  9     !: Bottom Boundary Layer (diffusive and/or advective) 
    46    INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 10     !: non-penetrative convection treatment 
    47    INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 11     !: internal restoring (damping) 
    48    INTEGER, PUBLIC, PARAMETER ::   jptra_qsr  = 12     !: penetrative solar radiation 
    49    INTEGER, PUBLIC, PARAMETER ::   jptra_nsr  = 13     !: non solar radiation / C/D on salinity  (+runoff if ln_rnf=T) 
    50    INTEGER, PUBLIC, PARAMETER ::   jptra_atf  = 14     !: Asselin time filter 
     41   INTEGER, PUBLIC, PARAMETER ::   jptra_totad  =  5   !: total         advection 
     42   INTEGER, PUBLIC, PARAMETER ::   jptra_ldf  =  6     !: lateral       diffusion 
     43   INTEGER, PUBLIC, PARAMETER ::   jptra_zdf  =  7     !: vertical      diffusion 
     44   INTEGER, PUBLIC, PARAMETER ::   jptra_zdfp =  8     !: "PURE" vert.  diffusion (ln_traldf_iso=T) 
     45   INTEGER, PUBLIC, PARAMETER ::   jptra_evd  =  9     !: EVD term (convection) 
     46   INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  = 10     !: Bottom Boundary Condition (geoth. heating)  
     47   INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  = 11     !: Bottom Boundary Layer (diffusive and/or advective) 
     48   INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 12     !: non-penetrative convection treatment 
     49   INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 13     !: internal restoring (damping) 
     50   INTEGER, PUBLIC, PARAMETER ::   jptra_qsr  = 14     !: penetrative solar radiation 
     51   INTEGER, PUBLIC, PARAMETER ::   jptra_nsr  = 15     !: non solar radiation / C/D on salinity  (+runoff if ln_rnf=T) 
     52   INTEGER, PUBLIC, PARAMETER ::   jptra_atf  = 16     !: Asselin time filter 
     53   INTEGER, PUBLIC, PARAMETER ::   jptra_tot  = 17     !: Model total trend 
    5154   ! 
    5255   !                                                  !!!* Passive tracers trends indices (use if "key_top" defined) 
    53    INTEGER, PUBLIC, PARAMETER ::   jptra_sms  = 15     !: sources m. sinks 
    54    INTEGER, PUBLIC, PARAMETER ::   jptra_radn = 16     !: corr. trn<0 in trcrad 
    55    INTEGER, PUBLIC, PARAMETER ::   jptra_radb = 17     !: corr. trb<0 in trcrad (like atf) 
     56   INTEGER, PUBLIC, PARAMETER ::   jptra_sms  = 18     !: sources m. sinks 
     57   INTEGER, PUBLIC, PARAMETER ::   jptra_radn = 19     !: corr. trn<0 in trcrad 
     58   INTEGER, PUBLIC, PARAMETER ::   jptra_radb = 20     !: corr. trb<0 in trcrad (like atf) 
    5659   ! 
    5760   !                                                  !!!* Momentum trends indices 
    58    INTEGER, PUBLIC, PARAMETER ::   jptot_dyn  = 15     !: Total trend nb: change it when adding/removing one indice below 
     61   INTEGER, PUBLIC, PARAMETER ::   jptot_dyn  = 16     !: Total trend nb: change it when adding/removing one indice below 
    5962   !                               ===============     !   
    6063   INTEGER, PUBLIC, PARAMETER ::   jpdyn_hpg  =  1     !: hydrostatic pressure gradient  
    … …  
    7376   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgflt  = 14  !: filter contribution to surface pressure gradient (spg_flt) 
    7477   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgexp  = 15  !: explicit contribution to surface pressure gradient (spg_flt) 
     78   INTEGER, PUBLIC, PARAMETER ::   jpdyn_eivke   = 16  !: K.E trend from Gent McWilliams scheme 
    7579   ! 
    7680   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r5602 r7806  
    9191!!gm end 
    9292      ! 
    93       IF( lk_vvl .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' ) 
     93!      IF( lk_vvl .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' ) 
    9494       
    9595!!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r7256 r7806  
    2727   USE lib_mpp        ! MPP library 
    2828   USE wrk_nemo       ! Memory allocation 
     29   USE ldfslp         ! Isopycnal slopes 
    2930 
    3031   IMPLICIT NONE 
    … …  
    4243#  include "domzgr_substitute.h90" 
    4344#  include "vectopt_loop_substitute.h90" 
     45#  include "ldfeiv_substitute.h90" 
     46 
    4447   !!---------------------------------------------------------------------- 
    4548   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    192195                    CALL ken_p2k( kt , zke ) 
    193196                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     197        CASE( jpdyn_eivke ) 
     198            ! CMIP6 diagnostic tknebto = tendency of KE from 
     199            ! parameterized mesoscale eddy advection 
     200            ! = vertical_integral( k (N S)^2 ) rho dz 
     201            ! rho = reference density 
     202            ! S = isoneutral slope. 
     203            ! Most terms are on W grid so work on this grid 
     204#ifdef key_traldf_eiv 
     205            CALL wrk_alloc( jpi, jpj, zke2d ) 
     206            zke2d(:,:) = 0._wp 
     207            DO jk = 1,jpk 
     208               DO ji = 1,jpi 
     209                  DO jj = 1,jpj 
     210                     zke2d(ji,jj) = zke2d(ji,jj) +  rau0 * fsaeiw(ji, jj, jk)               & 
     211                          &                      * ( wslpi(ji, jj, jk) * wslpi(ji,jj,jk)    & 
     212                          &                      +   wslpj(ji, jj, jk) * wslpj(ji,jj,jk) )  & 
     213                          &                      *   rn2(ji,jj,jk) * fse3w(ji, jj, jk) 
     214                  ENDDO 
     215               ENDDO 
     216            ENDDO 
     217            CALL iom_put("ketrd_eiv", zke2d) 
     218            CALL wrk_dealloc( jpi, jpj, zke2d ) 
     219#endif 
    194220         ! 
    195221      END SELECT 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r7256 r7806  
    150150      rab_pe(:,:,:,:) = 0._wp 
    151151      ! 
    152       IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume') 
     152!      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume') 
    153153      ! 
    154154      nkstp     = nit000 - 1 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r4990 r7806  
    3838   REAL(wp) ::   r2dt   ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    3939 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt  ! use to store the temperature trends 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_evd  ! store avt_evd to calculate EVD trend 
    4142 
    4243   !! * Substitutions 
    … …  
    5556      !!                  ***  FUNCTION trd_tra_alloc  *** 
    5657      !!--------------------------------------------------------------------- 
    57       ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
     58      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc ) 
    5859      ! 
    5960      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc ) 
    … …  
    104105                                 ztrds(:,:,:) = 0._wp 
    105106                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     107         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    106108         CASE DEFAULT                 ! other trends: masked trends 
    107109            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store 
    … …  
    128130            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    129131            DO jk = 2, jpk 
    130                zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     132               zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    131133               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    132134            END DO 
    … …  
    138140            END DO 
    139141            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     142            ! 
     143            !                         ! Also calculate EVD trend at this point.  
     144            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes 
     145            DO jk = 2, jpk 
     146               zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     147               zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     148            END DO 
     149            ! 
     150            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
     151            DO jk = 1, jpkm1 
     152               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
     153               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
     154            END DO 
     155            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )   
    140156            ! 
    141157            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
    … …  
    312328                                  CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
    313329                               ENDIF 
     330      CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )        ! total   advection 
     331                               CALL iom_put( "strd_totad" , ptrdy ) 
    314332      CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
    315333                               CALL iom_put( "strd_ldf" , ptrdy ) 
    … …  
    318336      CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
    319337                               CALL iom_put( "strd_zdfp", ptrdy ) 
     338      CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection) 
     339                               CALL iom_put( "strd_evd", ptrdy ) 
    320340      CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
    321341                               CALL iom_put( "strd_dmp" , ptrdy ) 
    … …  
    324344      CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
    325345                               CALL iom_put( "strd_npc" , ptrdy ) 
    326       CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx )        ! surface forcing + runoff (ln_rnf=T) 
    327                                CALL iom_put( "strd_cdt" , ptrdy ) 
     346      CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) )        ! surface forcing + runoff (ln_rnf=T) 
     347                               CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields 
    328348      CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
    329349      CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
    330350      CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
    331351                               CALL iom_put( "strd_atf" , ptrdy ) 
     352      CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )        ! model total trend 
     353                               CALL iom_put( "strd_tot" , ptrdy ) 
    332354      END SELECT 
    333355      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r4990 r7806  
    1919   USE zdf_oce         ! ocean vertical physics variables 
    2020   USE zdfkpp          ! KPP vertical mixing 
     21   USE trd_oce         ! trends: ocean variables 
     22   USE trdtra          ! trends manager: tracers  
    2123   USE in_out_manager  ! I/O manager 
    2224   USE iom             ! for iom_put 
    … …  
    122124      zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    123125      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     126      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    124127      ! 
    125128      IF( nn_timing == 1 )  CALL timing_stop('zdf_evd') 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7256 r7806  
    323323                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    324324                  !                                           ! TKE Langmuir circulation source term 
    325                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   & 
     325                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   & 
    326326                     &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    327327               END DO 
    … …  
    436436               DO ji = fs_2, fs_jpim1   ! vector opt. 
    437437                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    438                      &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     438                     &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    439439               END DO 
    440440            END DO 
    … …  
    445445               jk = nmln(ji,jj) 
    446446               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    447                   &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     447                  &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    448448            END DO 
    449449         END DO 
    … …  
    461461                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    462462                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    463                      &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     463                     &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    464464               END DO 
    465465            END DO 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7332 r7806  
    487487      !                                     ! Diagnostics 
    488488      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    489       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    490489                            CALL dia_ptr_init   ! Poleward TRansports initialization 
    491490      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    … …  
    755754      ! ilfax contains the set of allowed factors. 
    756755      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    757       !!---------------------------------------------------------------------- 
    758       ! ilfax contains the set of allowed factors. 
    759       ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    760756 
    761757      ! Clear the error flag and initialise output vars 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7256 r7806  
    237237      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
    238238      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis 
     239                            CALL dia_prod( kstp )        ! ocean model: product diagnostics 
    239240                            CALL dia_wri( kstp )         ! ocean model: outputs 
    240241      ! 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r7256 r7806  
    9595   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine) 
    9696   USE diaharm 
     97   USE diaprod          ! ocean model: product diagnostics 
    9798   USE flo_oce          ! floats variables 
    9899   USE floats           ! floats computation               (flo_stp routine) 

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r7256 r7806  
    180180      ENDIF 
    181181 
    182 9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 ) 
    183 9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10) 
     1829200  FORMAT('it:', i8, ' iter:', i4, ' r: ',d23.16, ' b: ',d23.16 ) 
     1839300  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16) 
    184184      ! 
    185185   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.