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 7218 for branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90 – NEMO

Ignore:
Timestamp:
2016-11-10T09:51:42+01:00 (7 years ago)
Author:
timgraham
Message:

Added in extra trend diagnostics from Dave Storkey

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r7063 r7218  
    8181# endif   
    8282      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
    83       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 
    8484      !!---------------------------------------------------------------------- 
    8585      ! 
     
    8888# if defined key_diaeiv  
    8989      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
    90       IF( ln_diaptr ) CALL wrk_alloc( jpi, jpj, jpk, z3d ) 
     90      CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 
    9191# else 
    9292      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
     
    172172           CALL iom_put( "weiv_masstr" , z3d )   
    173173         ENDIF 
    174          IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") ) THEN 
     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 
    175176            z3d(:,:,jpk) = 0.e0 
    176177            z2d(:,:) = 0.e0 
     
    182183         ENDIF 
    183184 
    184          IF( iom_use('ueiv_heattr') ) THEN 
     185         IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    185186            zztmp = 0.5 * rcp  
    186187            z2d(:,:) = 0.e0  
    187             DO jk = 1, jpkm1 
    188                DO jj = 2, jpjm1 
    189                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    190                      z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    191                   END DO 
    192                END DO 
    193             END DO 
    194             CALL lbc_lnk( z2d, 'U', -1. ) 
    195             CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
    196          ENDIF 
    197  
    198          IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") ) THEN 
     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 
    199231            z3d(:,:,jpk) = 0.e0 
    200             z2d(:,:) = 0.e0 
    201232            DO jk = 1, jpkm1 
    202233               z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     
    205236         ENDIF 
    206237             
    207          IF( iom_use('veiv_heattr') ) THEN 
     238         IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 
    208239            zztmp = 0.5 * rcp  
    209240            z2d(:,:) = 0.e0  
    210             DO jk = 1, jpkm1 
    211                DO jj = 2, jpjm1 
    212                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    213                      z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    214                   END DO 
    215                END DO 
    216             END DO 
    217             CALL lbc_lnk( z2d, 'V', -1. ) 
    218             CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in j-direction 
    219          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 
    220316    END IF 
    221317! 
     
    248344# if defined key_diaeiv  
    249345      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
    250       IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 
     346      CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 
    251347# else 
    252348      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
Note: See TracChangeset for help on using the changeset viewer.