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 7179 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2016-11-03T16:39:56+01:00 (7 years ago)
Author:
timgraham
Message:

Manually merge in changes from v3.6_extra_CMIP6_diagnostics branch.
This change also includes a change of the domain_def.xml file so XIOS2 must be used from this revision onwards

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO
Files:
6 added
1 deleted
35 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r6793 r7179  
    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 
    … …  
    8287      IF( nn_timing == 1 )   CALL timing_start('dia_ar5') 
    8388  
    84       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     89      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    8590      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    8691      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    … …  
    95100      CALL iom_put( 'voltot', zvol               ) 
    96101      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
     102      CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
    97103 
    98104      !                      
     105      IF( iom_use('sshthster') ) THEN 
    99106      ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    100107      ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    … …  
    116123         END IF 
    117124      END IF 
     125      ENDIF 
    118126      !                                          
    119127      zarho = SUM( area(:,:) * zbotpres(:,:) )  
    … …  
    190198      CALL iom_put( 'temptot', ztemp ) 
    191199      CALL iom_put( 'saltot' , zsal  ) 
    192       ! 
    193       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     200 
     201      IF( iom_use( 'tnpeo' )) THEN     
     202      ! Work done against stratification by vertical mixing 
     203      ! Exclude points where rn2 is negative as convection kicks in here and 
     204      ! work is not being done against stratification 
     205          pe(:,:) = 0._wp 
     206          IF( lk_zdfddm ) THEN 
     207             DO ji=1,jpi 
     208                DO jj=1,jpj 
     209                   DO jk=1,jpk 
     210                      zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     211                         &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
     212                      ! 
     213                      zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     214                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     215                      ! 
     216                      pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
     217                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     218                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     219 
     220                   ENDDO 
     221                ENDDO 
     222             ENDDO 
     223          ELSE 
     224             DO ji=1,jpi 
     225                DO jj=1,jpj 
     226                   DO jk=1,jpk 
     227                       pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 
     228                   ENDDO 
     229                ENDDO 
     230             ENDDO 
     231          ENDIF 
     232          CALL iom_put( 'tnpeo', pe ) 
     233      ENDIF 
     234      ! 
     235      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    194236      CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    195237      CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    … …  
    232274      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    233275 
    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 ) 
     276        CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
     277        CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     278        CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
     279        CALL iom_close( inum ) 
    238280 
    239281      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90

    r6491 r7179  
    2525   USE timing          ! preformance summary 
    2626   USE wrk_nemo        ! working array 
     27   USE diaptr 
    2728 
    2829   IMPLICIT NONE 
    … …  
    9899      ENDIF 
    99100 
    100       IF( iom_use("vt") ) THEN 
     101      IF( iom_use("vt") .OR. iom_use("sopht_vt") ) THEN 
    101102         z3d(:,:,:) = 0.e0  
    102103         DO jk = 1, jpkm1 
    … …  
    108109         END DO 
    109110         CALL iom_put( "vt", z3d )                  ! product of temperature and meridional velocity at V points 
     111         DO jk = 1, jpkm1 
     112            DO jj = 2, jpjm1 
     113               DO ji = fs_2, fs_jpim1   ! vector opt. 
     114                  z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 
     115               END DO 
     116            END DO 
     117         END DO 
     118         IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_tem, 'vts', z3d) 
    110119      ENDIF 
    111120 
    … …  
    139148      ENDIF 
    140149 
    141       IF( iom_use("vs") ) THEN 
     150      IF( iom_use("vs") .OR. iom_use("sopst_vs") ) THEN 
    142151         z3d(:,:,:) = 0.e0  
    143152         DO jk = 1, jpkm1 
    … …  
    149158         END DO 
    150159         CALL iom_put( "vs", z3d )                  ! product of salinity and meridional velocity at V points 
     160         DO jk = 1, jpkm1 
     161            DO jj = 2, jpjm1 
     162               DO ji = fs_2, fs_jpim1   ! vector opt. 
     163                  z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 
     164               END DO 
     165            END DO 
     166         END DO 
     167         IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_sal, 'vts', z3d) 
    151168      ENDIF 
    152169 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r6486 r7179  
    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 
    … …  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6498 r7179  
    323323      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
    324324      ! 
    325       IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
     325      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    326326         z3d(:,:,jpk) = 0.e0 
     327         z2d(:,:) = 0.e0 
    327328         DO jk = 1, jpkm1 
    328329            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     330            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    329331         END DO 
    330332         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     333         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    331334      ENDIF 
    332335       
    … …  
    391394         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    392395      ENDIF 
     396 
     397      ! Vertical integral of temperature 
     398      IF( iom_use("tosmint") ) THEN 
     399         z2d(:,:)=0._wp 
     400         DO jk = 1, jpkm1 
     401            DO jj = 2, jpjm1 
     402               DO ji = fs_2, fs_jpim1   ! vector opt. 
     403                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
     404               END DO 
     405            END DO 
     406         END DO 
     407         CALL lbc_lnk( z2d, 'T', -1. ) 
     408         CALL iom_put( "tosmint", z2d )  
     409      ENDIF 
     410 
     411      ! Vertical integral of salinity 
     412      IF( iom_use("somint") ) THEN 
     413         z2d(:,:)=0._wp 
     414         DO jk = 1, jpkm1 
     415            DO jj = 2, jpjm1 
     416               DO ji = fs_2, fs_jpim1   ! vector opt. 
     417                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
     418               END DO 
     419            END DO 
     420         END DO 
     421         CALL lbc_lnk( z2d, 'T', -1. ) 
     422         CALL iom_put( "somint", z2d )  
     423      ENDIF 
     424 
     425      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2) 
    393426      ! 
    394427      CALL wrk_dealloc( jpi , jpj      , z2d ) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6498 r7179  
    228228      ! automatic definitions of some of the xml attributs 
    229229      CALL set_xmlatt 
     230 
     231      CALL set_1point 
    230232 
    231233      ! end file definition 
    … …  
    15791581   END SUBROUTINE set_scalar 
    15801582 
     1583   SUBROUTINE set_1point 
     1584      !!---------------------------------------------------------------------- 
     1585      !!                     ***  ROUTINE set_1point  *** 
     1586      !! 
     1587      !! ** Purpose :   define zoom grid for scalar fields 
     1588      !! 
     1589      !!---------------------------------------------------------------------- 
     1590      REAL(wp), DIMENSION(1)   ::   zz = 1. 
     1591      INTEGER  :: ix, iy 
     1592      !!---------------------------------------------------------------------- 
     1593      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  Nearest point to north pole should be ocean 
     1594      CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 
     1595 
     1596   END SUBROUTINE set_1point 
     1597 
     1598 
    15811599 
    15821600   SUBROUTINE set_xmlatt 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6912 r7179  
    17281728         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 
    17291729#endif                   
    1730             CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1730         CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1)      )   ! liquid precipitation  
     1731         CALL iom_put( 'rain_ao_cea'  , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1)      )   ! liquid precipitation  
    17311732         IF( iom_use('hflx_rain_cea') )   & 
    1732             &  CALL iom_put( 'hflx_rain_cea',   frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:)                                            )  ! heat flux from liq. precip.  
     1733            &  CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1))   ! heat flux from liq. precip.  
     1734         IF( iom_use('hflx_prec_cea') )   & 
     1735            & CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) )   ! heat content flux from all precip  (cell avg) 
     1736         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
     1737            & ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    17331738         IF( iom_use('evap_ao_cea'  ) )   & 
    1734             &  CALL iom_put( 'evap_ao_cea'  ,   frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)                )  ! ice-free oce evap (cell average) 
     1739            &  CALL iom_put( 'evap_ao_cea'  , ztmp * tmask(:,:,1)                  )   ! ice-free oce evap (cell average) 
    17351740         IF( iom_use('hflx_evap_cea') )   & 
    1736             &  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) 
     1741            &  CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) )   ! heat flux from from evap (cell average) 
    17371742      CASE( 'oce and ice' )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    17381743         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    … …  
    17981803      ! runoffs and calving (put in emp_tot) 
    17991804      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1805      IF( iom_use('hflx_rnf_cea') )   & 
     1806         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
    18001807      IF( srcv(jpr_cal)%laction ) THEN  
    18011808         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r6755 r7179  
    9191    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale 
    9292    INTEGER           ::   ios           ! Local integer output status for namelist read 
     93 
     94    REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 
     95    REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d 
    9396      ! 
    9497      !!--------------------------------------------------------------------- 
    … …  
    355358 
    356359         ! output 
    357          IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf) 
    358          IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 
     360         IF( iom_use('qlatisf' ) )   CALL iom_put('qlatisf', qisf) 
     361         IF( iom_use('fwfisf'  ) )   CALL iom_put('fwfisf' , fwfisf * stbl(:,:) / soce ) 
    359362 
    360363         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 
    … …  
    366369         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.) 
    367370         CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
     371 
     372!============================================================================================================================================= 
     373         IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 
     374            CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     375            CALL wrk_alloc( jpi,jpj,     zqhcisf2d                        ) 
     376 
     377            zfwfisf3d(:,:,:) = 0.0_wp                         ! 3d ice shelf melting (kg/m2/s) 
     378            zqhcisf3d(:,:,:) = 0.0_wp                         ! 3d heat content flux (W/m2) 
     379            zqlatisf3d(:,:,:)= 0.0_wp                         ! 3d ice shelf melting latent heat flux (W/m2) 
     380            zqhcisf2d(:,:)   = fwfisf(:,:) * zt_frz * rcp     ! 2d heat content flux (W/m2) 
     381 
     382            DO jj = 1,jpj 
     383               DO ji = 1,jpi 
     384                  ikt = misfkt(ji,jj) 
     385                  ikb = misfkb(ji,jj) 
     386                  DO jk = ikt, ikb - 1 
     387                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     388                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     389                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     390                  END DO 
     391                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
     392                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
     393                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
     394               END DO 
     395            END DO 
     396 
     397            CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:)) 
     398            CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:)) 
     399            CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:)) 
     400            CALL iom_put('qhcisf'   , zqhcisf2d (:,:  )) 
     401 
     402            CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     403            CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        ) 
     404         END IF 
     405!============================================================================================================================================= 
    368406 
    369407         IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r6498 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r7061 r7179  
    2929   USE timing          ! Timing 
    3030   USE diaptr         ! Heat/Salt transport diagnostics 
     31   USE trddyn 
     32   USE trd_oce 
    3133 
    3234   IMPLICIT NONE 
    … …  
    163165         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current 
    164166         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current 
    165  
     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 
    166174         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d')        & 
    167175                                    .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 
    168176            z3d(:,:,jpk) = 0.e0 
     177            z2d(:,:) = 0.e0 
    169178            DO jk = 1, jpkm1 
    170179               z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     180               z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    171181            END DO 
    172182            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
    … …  
    305315 
    306316    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 ) 
    307342# endif   
    308343 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6795 r7179  
    3434   USE timing         ! Timing 
    3535   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     36   USE iom 
    3637 
    3738   IMPLICIT NONE 
    … …  
    4243 
    4344   LOGICAL ::   l_trd   ! flag to compute trends 
     45   LOGICAL ::   l_trans   ! flag to output vertically integrated transports 
    4446 
    4547   !! * Substitutions 
    … …  
    8587      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    8688      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     89      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 
     90      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    8891      !!---------------------------------------------------------------------- 
    8992      ! 
    … …  
    98101         ! 
    99102         l_trd = .FALSE. 
     103         l_trans = .FALSE. 
    100104         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     105         IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
    101106      ENDIF 
    102107      ! 
    103       IF( l_trd )  THEN 
     108      IF( l_trd .OR. l_trans )  THEN 
    104109         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    105110         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
     111         CALL wrk_alloc( jpi, jpj, z2d ) 
     112      ENDIF 
     113      ! 
     114      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     115         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     116         zptry(:,:,:) = 0._wp 
    106117      ENDIF 
    107118      ! 
    … …  
    187198 
    188199         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    189          IF( l_trd )  THEN  
     200         IF( l_trd .OR. l_trans )  THEN  
    190201            ! store intermediate advective trends 
    191202            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    192203         END IF 
    193204         !                                 ! "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 
     205         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
    198206 
    199207         ! 3. antidiffusive flux : high order minus low order 
    … …  
    253261 
    254262         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    255          IF( l_trd )  THEN  
     263         IF( l_trd .OR. l_trans )  THEN  
    256264            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    257265            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    258266            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) )  
     267         ENDIF 
     268          
     269         IF( l_trd ) THEN  
     270            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     271            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     272            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    263273         END IF 
    264          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     274 
     275         IF( l_trans .AND. jn==jp_tem ) THEN 
     276            z2d(:,:) = 0._wp  
     277            DO jk = 1, jpkm1 
     278               DO jj = 2, jpjm1 
     279                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     280                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
     281                  END DO 
     282               END DO 
     283            END DO 
     284            CALL lbc_lnk( z2d, 'U', -1. ) 
     285            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
     286              ! 
     287            z2d(:,:) = 0._wp  
     288            DO jk = 1, jpkm1 
     289               DO jj = 2, jpjm1 
     290                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     291                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
     292                  END DO 
     293               END DO 
     294            END DO 
     295            CALL lbc_lnk( z2d, 'V', -1. ) 
     296            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
     297         ENDIF 
     298         ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    265299         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(:) 
     300            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     301            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    268302         ENDIF 
    269303         ! 
    270304      END DO 
    271305      ! 
    272                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
    273       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     306      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
     307      IF( l_trd .OR. l_trans )  THEN  
     308         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     309         CALL wrk_dealloc( jpi, jpj, z2d ) 
     310      ENDIF 
     311      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    274312      ! 
    275313      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
    … …  
    318356      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
    319357      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     358      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    320359      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 
    321360      !!---------------------------------------------------------------------- 
    … …  
    339378         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    340379         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
     380      ENDIF 
     381      ! 
     382      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     383         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     384         zptry(:,:,:) = 0._wp 
    341385      ENDIF 
    342386      ! 
    … …  
    428472         END IF 
    429473         !                                 ! "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 
     474         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
    434475 
    435476         ! 3. antidiffusive flux : high order minus low order 
    … …  
    556597         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    557598         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(:) 
     599            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
     600            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    560601         ENDIF 
    561602         ! 
    … …  
    566607                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    567608      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     609      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    568610      ! 
    569611      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts') 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r7061 r7179  
    244244         ! 
    245245         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    246          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    247246            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    248             IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    249             IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    250          ENDIF 
     247         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    251248  
    252249         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
    … …  
    353350      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
    354351      DEALLOCATE( ztrax, ztray, ztraz )  
    355       IF( l_trdtra ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T )  
     352      IF( l_trdtra  .and. cdtype == 'TRA' ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T )  
    356353      ! 
    357354      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r6486 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

    r7061 r7179  
    6262   ! 
    6363   !                                                  !!!* Momentum trends indices 
    64    INTEGER, PUBLIC, PARAMETER ::   jptot_dyn  = 15     !: Total trend nb: change it when adding/removing one indice below 
     64   INTEGER, PUBLIC, PARAMETER ::   jptot_dyn  = 16     !: Total trend nb: change it when adding/removing one indice below 
    6565   !                               ===============     !   
    6666   INTEGER, PUBLIC, PARAMETER ::   jpdyn_hpg  =  1     !: hydrostatic pressure gradient  
    … …  
    7979   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgflt  = 14  !: filter contribution to surface pressure gradient (spg_flt) 
    8080   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spgexp  = 15  !: explicit contribution to surface pressure gradient (spg_flt) 
     81   INTEGER, PUBLIC, PARAMETER ::   jpdyn_eivke   = 16  !: K.E trend from Gent McWilliams scheme 
    8182   ! 
    8283   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r6487 r7179  
    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            CALL wrk_alloc( jpi, jpj, zke2d ) 
     205            zke2d(:,:) = 0._wp 
     206            DO jk = 1,jpk 
     207               DO ji = 1,jpi 
     208                  DO jj = 1,jpj 
     209                     zke2d(ji,jj) = zke2d(ji,jj) +  rau0 * fsaeiw(ji, jj, jk)               & 
     210                          &                      * ( wslpi(ji, jj, jk) * wslpi(ji,jj,jk)    & 
     211                          &                      +   wslpj(ji, jj, jk) * wslpj(ji,jj,jk) )  & 
     212                          &                      *   rn2(ji,jj,jk) * fse3w(ji, jj, jk) 
     213                  ENDDO 
     214               ENDDO 
     215            ENDDO 
     216            CALL iom_put("ketrd_eiv", zke2d) 
     217            CALL wrk_dealloc( jpi, jpj, zke2d ) 
    194218         ! 
    195219      END SELECT 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r6487 r7179  
    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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r7061 r7179  
    130130            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    131131            DO jk = 2, jpk 
    132                zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     132               zwt(:,:,jk) = avt_k(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    133133               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    134134            END DO 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r6533 r7179  
    147147      ! no need to output in offline mode 
    148148      IF( .NOT.lk_offline ) THEN    
    149       IF( kt >= nit000 ) THEN               ! workaround for calls before SOMETHING reads the XIOS namelist 
    150149         IF ( iom_use("mldr10_1") ) THEN 
    151150            IF( ln_isfcav ) THEN 
    … …  
    162161            END IF 
    163162         END IF 
    164       ENDIF 
    165163      ENDIF 
    166164       

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r6498 r7179  
    918918         CALL iom_put( "pcmap_tmx", pcmap_tmx ) 
    919919      ENDIF 
    920       CALL iom_put( "bn2", rn2 ) 
    921920      CALL iom_put( "emix_tmx", emix_tmx ) 
    922921       

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r6486 r7179  
    2525   USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14 
    2626 
     27   USE par_age   , ONLY : jp_age         !: number of tracers in AGE 
     28   USE par_age   , ONLY : jp_age_2d      !: number of tracers in AGE 
     29   USE par_age   , ONLY : jp_age_3d      !: number of tracers in AGE 
     30   USE par_age   , ONLY : jp_age_trd     !: number of tracers in AGE 
     31 
    2732   IMPLICIT NONE 
    2833 
    29    INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     !:  
    30    INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    31    INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    32    INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
     34   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     + jp_age      !:  
     35   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  + jp_age_2d   !: 
     36   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  + jp_age_3d   !: 
     37   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd  !: 
    3338 
    3439#if defined key_my_trc 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r7061 r7179  
    7373      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7474      ! 
    75       INTEGER ::   jk  
     75      INTEGER ::   jk, jn 
    7676      CHARACTER (len=22) ::   charout 
    7777      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r6486 r7179  
    6161      ENDIF 
    6262 
     63      IF( lk_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age0 , jp_age1               )  ! AGE tracer 
    6364      IF( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1               )  ! CFC model 
    6465      IF( lk_c14b    )   CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1              )  ! bomb C14 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r6486 r7179  
    1414   USE par_c14b      ! C14 bomb tracer 
    1515   USE par_cfc       ! CFC 11 and 12 tracers 
     16   USE par_age       ! AGE  tracer 
    1617   USE par_my_trc    ! user defined passive tracers 
    1718 
    … …  
    2425   ! Passive tracers : Total size 
    2526   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     27   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_age    + jp_my_trc 
     28   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_age_2d + jp_my_trc_2d 
     29   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_age_3d + jp_my_trc_3d 
    2930   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd 
    3132    
    3233   !  1D configuration ("key_c1d") 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6793 r7179  
    2323   USE trcini_pisces   ! PISCES   initialisation 
    2424   USE trcini_c14b     ! C14 bomb initialisation 
     25   USE trcini_age      ! AGE      initialisation 
    2526   USE trcini_my_trc   ! MY_TRC   initialisation 
    2627   USE trcdta          ! initialisation from files 
    … …  
    99100      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    100101      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    101       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     102      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
     103      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC    tracers 
    102104 
    103105      CALL trc_ice_ini                                 ! Tracers in sea ice 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r6487 r7179  
    2424   USE trcnam_cfc        ! CFC SMS namelist 
    2525   USE trcnam_c14b       ! C14 SMS namelist 
     26   USE trcnam_age        ! AGE SMS namelist 
    2627   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    2728   USE trd_oce        
    … …  
    161162      ENDIF 
    162163 
    163       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    164       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    165       ENDIF 
    166  
    167       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    168       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
     164      IF( lk_c14b    ) THEN  ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
     165      ELSE                   ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     166      ENDIF 
     167 
     168      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     169      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     170      ENDIF 
     171 
     172      IF( lk_my_trc  ) THEN  ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
     173      ELSE                   ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    169174      ENDIF 
    170175      ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r6486 r7179  
    2727   USE trcnam_trp 
    2828   USE iom 
     29   USE in_out_manager , ONLY : ln_rstdate 
    2930   USE daymod 
    3031   IMPLICIT NONE 
    … …  
    4849      !!---------------------------------------------------------------------- 
    4950      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     51      INTEGER             ::   iyear, imonth, iday 
     52      REAL (wp)           ::   zsec 
    5053      ! 
    5154      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    … …  
    7881      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    7982      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    80          ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    81          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    82          ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     83         IF ( ln_rstdate ) THEN 
     84            CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )            
     85            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     86         ELSE 
     87            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     88            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     89            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
     90            ENDIF 
    8391         ENDIF 
    8492         ! create the file 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r6487 r7179  
    1818   USE trcsms_cfc         ! CFC 11 & 12 
    1919   USE trcsms_c14b        ! C14b tracer  
     20   USE trcsms_age         ! AGE tracer  
    2021   USE trcsms_my_trc      ! MY_TRC  tracers 
    2122   USE prtctl_trc         ! Print control for debbuging 
    … …  
    5152      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    5253      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     54      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
    5355      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    5456 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r6486 r7179  
    2020   USE trcwri_cfc 
    2121   USE trcwri_c14b 
     22   USE trcwri_age 
    2223   USE trcwri_my_trc 
    2324 
    … …  
    5960      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6061      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     62      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6163      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    6264      ! 
Note: See TracChangeset for help on using the changeset viewer.