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/OPA_SRC/DIA/diaar5.F90 – 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

File:
1 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) )         
Note: See TracChangeset for help on using the changeset viewer.