New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

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

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

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

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

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

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/DIA
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r4313 r4990  
    104104         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    105105      END DO 
    106       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     106      IF( .NOT.lk_vvl ) THEN 
     107         DO ji=1,jpi 
     108            DO jj=1,jpj 
     109               zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     110            END DO 
     111         END DO 
     112      END IF 
    107113      !                                          
    108114      zarho = SUM( area(:,:) * zbotpres(:,:) )  
    … …  
    120126         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    121127      END DO 
    122       IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     128      IF( .NOT.lk_vvl ) THEN 
     129         DO ji=1,jpi 
     130            DO jj=1,jpj 
     131               zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     132            END DO 
     133         END DO 
     134      END IF 
    123135      !     
    124136      zarho = SUM( area(:,:) * zbotpres(:,:) )  
    … …  
    145157      END DO 
    146158      IF( .NOT.lk_vvl ) THEN 
    147          ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
    148          zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
     159         DO ji=1,jpi 
     160            DO jj=1,jpj 
     161               ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)  
     162               zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)  
     163            END DO 
     164         END DO 
    149165      ENDIF 
    150166      IF( lk_mpp ) THEN   

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r4147 r4990  
    77   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    88   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!---------------------------------------------------------------------- 
    10 #if ! defined key_coupled 
    11   
     9   !!----------------------------------------------------------------------  
    1210   !!---------------------------------------------------------------------- 
    1311   !!   Only for ORCA2 ORCA1 and ORCA025 
    … …  
    2927 
    3028   PUBLIC dia_fwb    ! routine called by step.F90 
    31  
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag 
    3329 
    3430   REAL(wp)               ::   a_fwf ,          & 
    … …  
    453449   END SUBROUTINE dia_fwb 
    454450 
    455 #else 
    456    !!---------------------------------------------------------------------- 
    457    !!   Default option :                                       Dummy Module 
    458    !!---------------------------------------------------------------------- 
    459    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    !: fresh water budget flag 
    460 CONTAINS 
    461    SUBROUTINE dia_fwb( kt )        ! Empty routine 
    462       WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt 
    463    END SUBROUTINE dia_fwb 
    464 #endif 
    465  
    466451   !!====================================================================== 
    467452END MODULE diafwb 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r4683 r4990  
    193193                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
    194194 
    195                DO jj = 1, jpj 
    196                   DO ji = 1, jpi 
     195               DO jj = 1,jpj 
     196                  DO ji = 1,jpi 
    197197                     ! Elevation 
    198                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask(ji,jj,1) 
     198                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask_i(ji,jj)         
    199199#if defined key_dynspg_ts 
    200                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 
    201                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 
     200                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask_i(ji,jj) 
     201                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask_i(ji,jj) 
    202202#endif 
    203203                  END DO 
    … …  
    294294               X1 = ana_amp(ji,jj,jh,1) 
    295295               X2 =-ana_amp(ji,jj,jh,2) 
    296                out_eta(ji,jj,jh       ) = X1 * tmask(ji,jj,1) 
    297                out_eta(ji,jj,jh+nb_ana) = X2 * tmask(ji,jj,1) 
     296               out_eta(ji,jj,jh       ) = X1 * tmask_i(ji,jj) 
     297               out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj) 
    298298            END DO 
    299299         END DO 
    … …  
    326326         DO ji = 1, jpi 
    327327            DO jh = 1, nb_ana  
    328                X1 = ana_amp(ji,jj,jh,1) 
    329                X2 =-ana_amp(ji,jj,jh,2) 
    330                out_u(ji,jj,jh       ) = X1 * umask(ji,jj,1) 
    331                out_u(ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 
    332             END DO 
    333          END DO 
    334       END DO 
     328               X1= ana_amp(ji,jj,jh,1) 
     329               X2=-ana_amp(ji,jj,jh,2) 
     330               out_u(ji,jj,       jh) = X1 * umask_i(ji,jj) 
     331               out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj) 
     332            ENDDO 
     333         ENDDO 
     334      ENDDO 
    335335 
    336336      ! vbar: 
    … …  
    362362               X1=ana_amp(ji,jj,jh,1) 
    363363               X2=-ana_amp(ji,jj,jh,2) 
    364                out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 
    365                out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 
     364               out_v(ji,jj,       jh)=X1 * vmask_i(ji,jj) 
     365               out_v(ji,jj,nb_ana+jh)=X2 * vmask_i(ji,jj) 
    366366            END DO 
    367367         END DO 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4624 r4990  
    99 
    1010   !!---------------------------------------------------------------------- 
     11   !!   dia_hsb       : Diagnose the conservation of ocean heat and salt contents, and volume 
     12   !!   dia_hsb_rst   : Read or write DIA file in restart file 
     13   !!   dia_hsb_init  : Initialization of the conservation diagnostic 
     14   !!---------------------------------------------------------------------- 
    1115   USE oce             ! ocean dynamics and tracers 
    1216   USE dom_oce         ! ocean space and time domain 
    1317   USE phycst          ! physical constants 
    1418   USE sbc_oce         ! surface thermohaline fluxes 
    15    USE in_out_manager  ! I/O manager 
     19   USE sbcrnf          ! river runoff 
     20   USE sbcisf          ! ice shelves 
    1621   USE domvvl          ! vertical scale factors 
    1722   USE traqsr          ! penetrative solar radiation 
    1823   USE trabbc          ! bottom boundary condition  
    19    USE lib_mpp         ! distributed memory computing library 
    2024   USE trabbc          ! bottom boundary condition 
    2125   USE bdy_par         ! (for lk_bdy) 
     26   USE restart         ! ocean restart 
     27   ! 
     28   USE iom             ! I/O manager 
     29   USE in_out_manager  ! I/O manager 
     30   USE lib_fortran     ! glob_sum 
     31   USE lib_mpp         ! distributed memory computing library 
    2232   USE timing          ! preformance summary 
    23    USE iom             ! I/O manager 
    24    USE lib_fortran     ! glob_sum 
    25    USE restart         ! ocean restart 
    26    USE wrk_nemo         ! work arrays 
    27    USE sbcrnf         ! river runoffd 
     33   USE wrk_nemo        ! work arrays 
    2834 
    2935   IMPLICIT NONE 
    … …  
    3642   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets 
    3743 
    38    REAL(dp)                                ::   surf_tot                ! 
    39    REAL(dp)                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends 
    40    REAL(dp)                                ::   frc_wn_t      , frc_wn_s ! global forcing trends 
    41    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              ! 
    42    REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
    43    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini 
     44   REAL(wp) ::   surf_tot              ! ocean surface 
     45   REAL(wp) ::   frc_t, frc_s, frc_v   ! global forcing trends 
     46   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends 
     47   ! 
     48   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf          , ssh_ini          ! 
     49   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   ! 
     50   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
    4451 
    4552   !! * Substitutions 
    4653#  include "domzgr_substitute.h90" 
    4754#  include "vectopt_loop_substitute.h90" 
    48  
    4955   !!---------------------------------------------------------------------- 
    5056   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    5258   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5359   !!---------------------------------------------------------------------- 
    54  
    5560CONTAINS 
    5661 
    … …  
    6772      !!--------------------------------------------------------------------------- 
    6873      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    69       !! 
    70       INTEGER    ::   jk                          ! dummy loop indice 
    71       REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
    72       REAL(dp)   ::   zdiff_hc1   , zdiff_sc1     ! -   -   -   -   -   -   -   -  
    73       REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
    74       REAL(dp)   ::   zerr_hc1    , zerr_sc1       ! heat and salt content misfit 
    75       REAL(dp)   ::   zvol_tot                    ! volume 
    76       REAL(dp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
    77       REAL(dp)   ::   z_frc_trd_v                 !    -     - 
    78       REAL(dp)   ::   z_wn_trd_t , z_wn_trd_s   !    -     - 
    79       REAL(dp)   ::   z_ssh_hc , z_ssh_sc   !    -     - 
     74      ! 
     75      INTEGER    ::   ji, jj, jk                  ! dummy loop indice 
     76      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
     77      REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        -  
     78      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
     79      REAL(wp)   ::   zerr_hc1    , zerr_sc1      ! heat and salt content misfit 
     80      REAL(wp)   ::   zvol_tot                    ! volume 
     81      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
     82      REAL(wp)   ::   z_frc_trd_v                 !    -     - 
     83      REAL(wp)   ::   z_wn_trd_t , z_wn_trd_s     !    -     - 
     84      REAL(wp)   ::   z_ssh_hc , z_ssh_sc         !    -     - 
     85      REAL(wp), DIMENSION(:,:), POINTER ::   z2d0, z2d1 
    8086      !!--------------------------------------------------------------------------- 
    8187      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')       
    82  
     88      CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 ) 
     89      ! 
     90      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 
     91      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 
    8392      ! ------------------------- ! 
    8493      ! 1 - Trends due to forcing ! 
    8594      ! ------------------------- ! 
    86       z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 
    87       z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )       ! heat fluxes 
    88       z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )       ! salt fluxes 
     95      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes 
     96      z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                               ! heat fluxes 
     97      z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                               ! salt fluxes 
    8998      ! Add runoff heat & salt input 
    9099      IF( ln_rnf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 
    91100      IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 
     101      ! Add geothermal ice shelf 
     102      IF( nn_isf .GE. 1 )  THEN 
     103          z_frc_trd_t = z_frc_trd_t & 
     104              &   + glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * (-1.9) * r1_rau0 ) * surf(:,:) ) 
     105          z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 
     106      ENDIF 
    92107 
    93108      ! Add penetrative solar radiation 
    … …  
    97112      ! 
    98113      IF( .NOT. lk_vvl ) THEN 
    99          z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 
    100          z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 
     114         z2d0=0.0_wp ; z2d1=0.0_wp 
     115         DO ji=1,jpi 
     116            DO jj=1,jpj 
     117              z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 
     118              z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 
     119            ENDDO 
     120         ENDDO 
     121         z_wn_trd_t = - glob_sum( z2d0 )  
     122         z_wn_trd_s = - glob_sum( z2d1 ) 
    101123      ENDIF 
    102124 
    … …  
    113135      ! 2 -  Content variations ! 
    114136      ! ------------------------ ! 
    115       zdiff_v2 = 0.d0 
    116       zdiff_hc = 0.d0 
    117       zdiff_sc = 0.d0 
     137      zdiff_v2 = 0._wp 
     138      zdiff_hc = 0._wp 
     139      zdiff_sc = 0._wp 
    118140 
    119141      ! volume variation (calculated with ssh) 
    … …  
    122144      ! heat & salt content variation (associated with ssh) 
    123145      IF( .NOT. lk_vvl ) THEN 
    124          z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 
    125          z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 
     146         z2d0 = 0._wp   ;   z2d1 = 0._wp 
     147         DO ji = 1, jpi 
     148            DO jj = 1, jpj 
     149              z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )  
     150              z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )  
     151            END DO 
     152         END DO 
     153         z_ssh_hc = glob_sum( z2d0 )  
     154         z_ssh_sc = glob_sum( z2d1 )  
    126155      ENDIF 
    127156 
    … …  
    153182      ! 3 - Diagnostics writing ! 
    154183      ! ----------------------- ! 
    155       zvol_tot   = 0.d0                                                   ! total ocean volume 
     184      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors) 
    156185      DO jk = 1, jpkm1 
    157186         zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 
    158187      END DO 
     188 
     189!!gm to be added ? 
     190!      IF( .NOT. lk_vvl ) THEN            ! fixed volume, add the ssh contribution 
     191!        zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) ) 
     192!      ENDIF 
     193!!gm end 
     194 
    159195 
    160196      IF( lk_vvl ) THEN 
    … …  
    183219      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' ) 
    184220 
     221      CALL wrk_dealloc( jpi,jpj,   z2d0, z2d1 ) 
     222 
    185223      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb') 
    186 ! 
     224      ! 
    187225   END SUBROUTINE dia_hsb 
    188226 
    189  
    190    SUBROUTINE dia_hsb_init 
    191       !!--------------------------------------------------------------------------- 
    192       !!                  ***  ROUTINE dia_hsb  *** 
    193       !!      
    194       !! ** Purpose: Initialization for the heat salt volume budgets 
    195       !!  
    196       !! ** Method : Compute initial heat content, salt content and volume 
    197       !! 
    198       !! ** Action : - Compute initial heat content, salt content and volume 
    199       !!             - Initialize forcing trends 
    200       !!             - Compute coefficients for conversion 
    201       !!--------------------------------------------------------------------------- 
    202       INTEGER            ::   jk       ! dummy loop indice 
    203       INTEGER            ::   ierror   ! local integer 
    204       !! 
    205       NAMELIST/namhsb/ ln_diahsb 
    206       ! 
    207       INTEGER  ::   ios 
    208       !!---------------------------------------------------------------------- 
    209  
    210       IF(lwp) THEN 
    211          WRITE(numout,*) 
    212          WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
    213          WRITE(numout,*) '~~~~~~~~ ' 
    214       ENDIF 
    215  
    216       REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
    217       READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
    218 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
    219  
    220       REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist 
    221       READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    222 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
    223       IF(lwm) WRITE ( numond, namhsb ) 
    224  
    225       ! 
    226       IF(lwp) THEN                   ! Control print 
    227          WRITE(numout,*) 
    228          WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
    229          WRITE(numout,*) '~~~~~~~~~~~~' 
    230          WRITE(numout,*) '   Namelist namhsb : set hsb parameters' 
    231          WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb 
    232          WRITE(numout,*) 
    233       ENDIF 
    234  
    235       IF( .NOT. ln_diahsb )   RETURN 
    236 !      IF( .NOT. lk_mpp_rep ) & 
    237 !        CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 
    238 !             &         ' whereas the global sum to be precise must be done in double precision ',& 
    239 !             &         ' please add key_mpp_rep') 
    240  
    241       ! ------------------- ! 
    242       ! 1 - Allocate memory ! 
    243       ! ------------------- ! 
    244       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 
    245          &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror ) 
    246       IF( ierror > 0 ) THEN 
    247          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
    248       ENDIF 
    249  
    250       IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
    251       IF( ierror > 0 ) THEN 
    252          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
    253       ENDIF 
    254  
    255       ! ----------------------------------------------- ! 
    256       ! 2 - Time independant variables and file opening ! 
    257       ! ----------------------------------------------- ! 
    258       IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    259       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    260       surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
    261       surf_tot  = glob_sum( surf(:,:) )                                       ! total ocean surface area 
    262  
    263       IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    264       ! 
    265       ! ---------------------------------- ! 
    266       ! 4 - initial conservation variables ! 
    267       ! ---------------------------------- ! 
    268       CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files 
    269       ! 
    270    END SUBROUTINE dia_hsb_init 
    271227 
    272228   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
    … …  
    281237     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    282238     ! 
    283      INTEGER ::   jk   !  
    284      INTEGER ::   id1   ! local integers 
     239     INTEGER ::   ji, jj, jk   ! dummy loop indices 
     240     INTEGER ::   id1          ! local integers 
    285241     !!---------------------------------------------------------------------- 
    286242     ! 
    … …  
    317273             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
    318274          END DO 
    319           frc_v = 0.d0                                           ! volume       trend due to forcing 
    320           frc_t = 0.d0                                           ! heat content   -    -   -    -    
    321           frc_s = 0.d0                                           ! salt content   -    -   -    -         
     275          frc_v = 0._wp                                           ! volume       trend due to forcing 
     276          frc_t = 0._wp                                           ! heat content   -    -   -    -    
     277          frc_s = 0._wp                                           ! salt content   -    -   -    -         
    322278          IF( .NOT. lk_vvl ) THEN 
    323              ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
    324              ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
    325              frc_wn_t = 0.d0                                       ! initial heat content misfit due to free surface 
    326              frc_wn_s = 0.d0                                       ! initial salt content misfit due to free surface 
     279             DO ji=1,jpi 
     280                DO jj=1,jpj 
     281                   ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
     282                   ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
     283                ENDDO 
     284             ENDDO 
     285             frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
     286             frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface 
    327287          ENDIF 
    328288       ENDIF 
    … …  
    354314   END SUBROUTINE dia_hsb_rst 
    355315 
     316 
     317   SUBROUTINE dia_hsb_init 
     318      !!--------------------------------------------------------------------------- 
     319      !!                  ***  ROUTINE dia_hsb  *** 
     320      !!      
     321      !! ** Purpose: Initialization for the heat salt volume budgets 
     322      !!  
     323      !! ** Method : Compute initial heat content, salt content and volume 
     324      !! 
     325      !! ** Action : - Compute initial heat content, salt content and volume 
     326      !!             - Initialize forcing trends 
     327      !!             - Compute coefficients for conversion 
     328      !!--------------------------------------------------------------------------- 
     329      INTEGER ::   jk       ! dummy loop indice 
     330      INTEGER ::   ierror   ! local integer 
     331      INTEGER ::   ios 
     332      ! 
     333      NAMELIST/namhsb/ ln_diahsb 
     334      !!---------------------------------------------------------------------- 
     335 
     336      IF(lwp) THEN 
     337         WRITE(numout,*) 
     338         WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
     339         WRITE(numout,*) '~~~~~~~~ ' 
     340      ENDIF 
     341 
     342      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist 
     343      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 
     344901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 
     345 
     346      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist 
     347      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
     348902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
     349      IF(lwm) WRITE ( numond, namhsb ) 
     350 
     351      ! 
     352      IF(lwp) THEN                   ! Control print 
     353         WRITE(numout,*) 
     354         WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 
     355         WRITE(numout,*) '~~~~~~~~~~~~' 
     356         WRITE(numout,*) '   Namelist namhsb : set hsb parameters' 
     357         WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb 
     358         WRITE(numout,*) 
     359      ENDIF 
     360 
     361      IF( .NOT. ln_diahsb )   RETURN 
     362         !      IF( .NOT. lk_mpp_rep ) & 
     363         !        CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 
     364         !             &         ' whereas the global sum to be precise must be done in double precision ',& 
     365         !             &         ' please add key_mpp_rep') 
     366 
     367      ! ------------------- ! 
     368      ! 1 - Allocate memory ! 
     369      ! ------------------- ! 
     370      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 
     371         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror ) 
     372      IF( ierror > 0 ) THEN 
     373         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     374      ENDIF 
     375 
     376      IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
     377      IF( ierror > 0 ) THEN 
     378         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     379      ENDIF 
     380 
     381      ! ----------------------------------------------- ! 
     382      ! 2 - Time independant variables and file opening ! 
     383      ! ----------------------------------------------- ! 
     384      IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
     385      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     386      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area 
     387      surf_tot  = glob_sum( surf(:,:) )                                       ! total ocean surface area 
     388 
     389      IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
     390      ! 
     391      ! ---------------------------------- ! 
     392      ! 4 - initial conservation variables ! 
     393      ! ---------------------------------- ! 
     394      CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files 
     395      ! 
     396   END SUBROUTINE dia_hsb_init 
     397 
    356398   !!====================================================================== 
    357399END MODULE diahsb 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r4624 r4990  
    505505            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
    506506            WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean 
    507             ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1) 
     507            ELSE WHERE                     ;   btm30(:,:) = ssmask(:,:) 
    508508            END WHERE 
    509509         ENDIF 
    … …  
    573573      !!--------------------------------------------------------------------  
    574574      ! 
    575       CALL wrk_alloc( jpj      , zphi , zfoo ) 
    576       CALL wrk_alloc( jpj , jpk, z_1 ) 
     575      CALL wrk_alloc( jpj       , zphi , zfoo ) 
     576      CALL wrk_alloc( jpj , jpk , z_1 ) 
    577577 
    578578      ! define time axis 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4840 r4990  
    4444   USE in_out_manager  ! I/O manager 
    4545   USE diadimg         ! dimg direct access file format output 
    46    USE diaar5, ONLY :   lk_diaar5 
    4746   USE iom 
    4847   USE ioipsl 
    … …  
    8887      INTEGER, DIMENSION(2) :: ierr 
    8988      !!---------------------------------------------------------------------- 
    90       ! 
    9189      ierr = 0 
    92       ! 
    9390      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    9491         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
    … …  
    131128      !! 
    132129      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
    133       REAL(wp), POINTER, DIMENSION(:,:)   :: z2ds     ! 2D workspace 
    134130      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
    135131      !!---------------------------------------------------------------------- 
    … …  
    137133      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    138134      !  
    139       CALL wrk_alloc( jpi , jpj      , z2d , z2ds ) 
     135      CALL wrk_alloc( jpi , jpj      , z2d ) 
    140136      CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    141137      ! 
    … …  
    149145         z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) 
    150146         CALL iom_put( "toce" , z3d                        )   ! heat content 
    151          CALL iom_put( "sst"  , z3d(:,:,1)                 )   ! sea surface heat content 
    152          z3d(:,:,1) = tsn(:,:,1,jp_tem) * z3d(:,:,1) 
    153          CALL iom_put( "sst2" , z3d(:,:,1)                 )   ! sea surface content of squared temperature 
     147         DO jj = 1, jpj 
     148            DO ji = 1, jpi 
     149               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * fse3t_n(ji,jj,mikt(ji,jj)) 
     150            END DO 
     151         END DO   
     152         CALL iom_put( "sst"  , z2d(:,:)                 )   ! sea surface heat content       
     153         DO jj = 1, jpj 
     154            DO ji = 1, jpi 
     155               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 
     156            END DO 
     157         END DO   
     158         CALL iom_put( "sst2" , z2d(:,:)      )   ! sea surface content of squared temperature 
    154159         z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:)             
    155160         CALL iom_put( "soce" , z3d                        )   ! salinity content 
    156          CALL iom_put( "sss"  , z3d(:,:,1)                 )   ! sea surface salinity content 
    157          z3d(:,:,1) = tsn(:,:,1,jp_sal) * z3d(:,:,1) 
    158          CALL iom_put( "sss2" , z3d(:,:,1)                 )   ! sea surface content of squared salinity 
     161         DO jj = 1, jpj 
     162            DO ji = 1, jpi 
     163               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * fse3t_n(ji,jj,mikt(ji,jj)) 
     164            END DO 
     165         END DO   
     166         CALL iom_put( "sss"  , z2d(:,:)                 )   ! sea surface salinity content 
     167         DO jj = 1, jpj 
     168            DO ji = 1, jpi 
     169               z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 
     170            END DO 
     171         END DO   
     172         CALL iom_put( "sss2" , z2d(:,:)                 )   ! sea surface content of squared salinity 
    159173      ELSE 
    160          CALL iom_put( "toce" , tsn(:,:,:,jp_tem)          )   ! temperature 
    161          CALL iom_put( "sst"  , tsn(:,:,1,jp_tem)          )   ! sea surface temperature 
    162          CALL iom_put( "sst2" , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) ) ! square of sea surface temperature 
     174         CALL iom_put( "toce" , tsn(:,:,:,jp_tem)        )   ! temperature 
     175         IF ( iom_use("sst") ) THEN 
     176            DO jj = 1, jpj 
     177               DO ji = 1, jpi 
     178                  z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
     179               END DO 
     180            END DO 
     181            CALL iom_put( "sst"  , z2d(:,:)            ) ! sea surface temperature 
     182         ENDIF 
     183         IF ( iom_use("sst2") )   CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature 
    163184         CALL iom_put( "soce" , tsn(:,:,:,jp_sal)          )   ! salinity 
    164          CALL iom_put( "sss"  , tsn(:,:,1,jp_sal)          )   ! sea surface salinity 
    165          CALL iom_put( "sss2" , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) ) ! square of sea surface salinity 
     185         IF ( iom_use("sss") ) THEN 
     186            DO jj = 1, jpj 
     187               DO ji = 1, jpi 
     188                  z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
     189               END DO 
     190            END DO 
     191            CALL iom_put( "sss"  , z2d(:,:)            ) ! sea surface salinity 
     192         ENDIF 
     193         CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity 
    166194      END IF 
    167195      IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 
    168          CALL iom_put( "uoce" , un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport 
    169          CALL iom_put( "voce" , vn(:,:,:) * fse3v_n(:,:,:) )    ! j-transport 
     196         CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport 
     197         CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) * fse3v_n(:,:,:) )    ! j-transport 
    170198      ELSE 
    171          CALL iom_put( "uoce" , un                         )    ! i-current 
    172          CALL iom_put( "voce" , vn                         )    ! j-current 
    173       END IF 
     199         CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:)                  )    ! i-current 
     200         CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:)                  )    ! j-current 
     201         IF ( iom_use("ssu") ) THEN 
     202            DO jj = 1, jpj 
     203               DO ji = 1, jpi 
     204                  z2d(ji,jj) = un(ji,jj,miku(ji,jj)) 
     205               END DO 
     206            END DO 
     207            CALL iom_put( "ssu"   , z2d                                    )    ! i-current 
     208         ENDIF 
     209         IF ( iom_use("ssv") ) THEN 
     210            DO jj = 1, jpj 
     211               DO ji = 1, jpi 
     212                  z2d(ji,jj) = vn(ji,jj,mikv(ji,jj)) 
     213               END DO 
     214            END DO 
     215            CALL iom_put( "ssv"   , z2d                                    )    ! j-current 
     216         ENDIF 
     217      ENDIF 
    174218      CALL iom_put(    "avt"  , avt                        )    ! T vert. eddy diff. coef. 
    175219      CALL iom_put(    "avm"  , avmu                       )    ! T vert. eddy visc. coef. 
    … …  
    178222      ENDIF 
    179223 
    180       DO jj = 2, jpjm1                                    ! sst gradient 
    181          DO ji = fs_2, fs_jpim1   ! vector opt. 
    182             zztmp      = tsn(ji,jj,1,jp_tem) 
    183             zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
    184             zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
    185             z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    186                &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    187          END DO 
    188       END DO 
    189       CALL lbc_lnk( z2d, 'T', 1. ) 
    190       CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    191 !CDIR NOVERRCHK 
    192       z2d(:,:) = SQRT( z2d(:,:) ) 
    193       CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    194  
     224      IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN 
     225         DO jj = 2, jpjm1                                    ! sst gradient 
     226            DO ji = fs_2, fs_jpim1   ! vector opt. 
     227               zztmp      = tsn(ji,jj,1,jp_tem) 
     228               zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
     229               zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
     230               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
     231                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
     232            END DO 
     233         END DO 
     234         CALL lbc_lnk( z2d, 'T', 1. ) 
     235         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
     236         !CDIR NOVERRCHK< 
     237         z2d(:,:) = SQRT( z2d(:,:) ) 
     238         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
     239      ENDIF 
     240          
    195241      ! clem: heat and salt content 
    196       z2d(:,:)  = 0._wp  
    197       z2ds(:,:) = 0._wp  
    198       DO jk = 1, jpkm1 
    199          DO jj = 2, jpjm1 
    200             DO ji = fs_2, fs_jpim1   ! vector opt. 
    201                z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    202                z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    203             END DO 
    204          END DO 
    205       END DO 
    206       CALL lbc_lnk( z2d, 'T', 1. ) 
    207       CALL lbc_lnk( z2ds, 'T', 1. ) 
    208       CALL iom_put( "heatc", z2d )    ! vertically integrated heat content (J/m2) 
    209       CALL iom_put( "saltc", z2ds )   ! vertically integrated salt content (PSU*kg/m2) 
    210    
    211       ! 
    212       rke(:,:,jk) = 0._wp                               !      kinetic energy  
    213       DO jk = 1, jpkm1 
    214          DO jj = 2, jpjm1 
    215             DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    217                zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    & 
    218                   &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  & 
    219                   &          *  zztmp  
    220                ! 
    221                zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    & 
    222                   &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  & 
    223                   &          *  zztmp  
    224                ! 
    225                rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 
    226                ! 
     242      IF( iom_use("heatc") ) THEN 
     243         z2d(:,:)  = 0._wp  
     244         DO jk = 1, jpkm1 
     245            DO jj = 2, jpjm1 
     246               DO ji = fs_2, fs_jpim1   ! vector opt. 
     247                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     248               END DO 
     249            END DO 
     250         END DO 
     251         CALL lbc_lnk( z2d, 'T', 1. ) 
     252         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
     253      ENDIF 
     254 
     255      IF( iom_use("saltc") ) THEN 
     256         z2d(:,:)  = 0._wp  
     257         DO jk = 1, jpkm1 
     258            DO jj = 2, jpjm1 
     259               DO ji = fs_2, fs_jpim1   ! vector opt. 
     260                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     261               END DO 
     262            END DO 
     263         END DO 
     264         CALL lbc_lnk( z2d, 'T', 1. ) 
     265         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
     266      ENDIF 
     267      ! 
     268      IF ( iom_use("eken") ) THEN 
     269         rke(:,:,jk) = 0._wp                               !      kinetic energy  
     270         DO jk = 1, jpkm1 
     271            DO jj = 2, jpjm1 
     272               DO ji = fs_2, fs_jpim1   ! vector opt. 
     273                  zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     274                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    & 
     275                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  & 
     276                     &          *  zztmp  
     277                  ! 
     278                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    & 
     279                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  & 
     280                     &          *  zztmp  
     281                  ! 
     282                  rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 
     283                  ! 
     284               ENDDO 
    227285            ENDDO 
    228286         ENDDO 
    229       ENDDO 
    230       CALL lbc_lnk( rke, 'T', 1. ) 
    231       CALL iom_put( "eken", rke )            
    232  
    233       IF( lk_diaar5 ) THEN 
     287         CALL lbc_lnk( rke, 'T', 1. ) 
     288         CALL iom_put( "eken", rke )            
     289      ENDIF 
     290          
     291      IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    234292         z3d(:,:,jpk) = 0.e0 
    235293         DO jk = 1, jpkm1 
    … …  
    237295         END DO 
    238296         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    239  
    240          zztmp = 0.5 * rcp 
     297      ENDIF 
     298       
     299      IF( iom_use("u_heattr") ) THEN 
    241300         z2d(:,:) = 0.e0  
    242          z2ds(:,:) = 0.e0  
    243301         DO jk = 1, jpkm1 
    244302            DO jj = 2, jpjm1 
    245303               DO ji = fs_2, fs_jpim1   ! vector opt. 
    246                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    247                   z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     304                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    248305               END DO 
    249306            END DO 
    250307         END DO 
    251308         CALL lbc_lnk( z2d, 'U', -1. ) 
    252          CALL lbc_lnk( z2ds, 'U', -1. ) 
    253          CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
    254          CALL iom_put( "u_salttr", z2ds )                 ! salt transport in i-direction 
    255  
     309         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
     310      ENDIF 
     311 
     312      IF( iom_use("u_salttr") ) THEN 
     313         z2d(:,:) = 0.e0  
     314         DO jk = 1, jpkm1 
     315            DO jj = 2, jpjm1 
     316               DO ji = fs_2, fs_jpim1   ! vector opt. 
     317                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     318               END DO 
     319            END DO 
     320         END DO 
     321         CALL lbc_lnk( z2d, 'U', -1. ) 
     322         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
     323      ENDIF 
     324 
     325       
     326      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    256327         z3d(:,:,jpk) = 0.e0 
    257328         DO jk = 1, jpkm1 
    … …  
    259330         END DO 
    260331         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
    261  
     332      ENDIF 
     333       
     334      IF( iom_use("v_heattr") ) THEN 
    262335         z2d(:,:) = 0.e0  
    263          z2ds(:,:) = 0.e0  
    264336         DO jk = 1, jpkm1 
    265337            DO jj = 2, jpjm1 
    266338               DO ji = fs_2, fs_jpim1   ! vector opt. 
    267                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    268                   z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     339                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    269340               END DO 
    270341            END DO 
    271342         END DO 
    272343         CALL lbc_lnk( z2d, 'V', -1. ) 
    273          CALL lbc_lnk( z2ds, 'V', -1. ) 
    274          CALL iom_put( "v_heattr", z2d )                  !  heat transport in j-direction 
    275          CALL iom_put( "v_salttr", z2ds )                 !  salt transport in j-direction 
    276       ENDIF 
    277       ! 
    278       CALL wrk_dealloc( jpi , jpj      , z2d , z2ds ) 
     344         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
     345      ENDIF 
     346 
     347      IF( iom_use("v_salttr") ) THEN 
     348         z2d(:,:) = 0.e0  
     349         DO jk = 1, jpkm1 
     350            DO jj = 2, jpjm1 
     351               DO ji = fs_2, fs_jpim1   ! vector opt. 
     352                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     353               END DO 
     354            END DO 
     355         END DO 
     356         CALL lbc_lnk( z2d, 'V', -1. ) 
     357         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
     358      ENDIF 
     359      ! 
     360      CALL wrk_dealloc( jpi , jpj      , z2d ) 
    279361      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    280362      ! 
    … …  
    539621         ENDIF 
    540622 
    541 #if ! defined key_coupled  
    542          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    543             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    544          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    545             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    546          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    547             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    548 #endif 
    549  
    550  
    551  
    552 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    553          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    554             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    555          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    556             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    557          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    558             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    559 #endif 
     623         IF( .NOT. lk_cpl ) THEN 
     624            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     625               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     626            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     627               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     628            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
     629               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     630         ENDIF 
     631 
     632         IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     633            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     634               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     635            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     636               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     637            CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
     638               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     639         ENDIF 
     640          
    560641         clmx ="l_max(only(x))"    ! max index on a period 
    561642         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    … …  
    572653#endif 
    573654 
    574 #if defined key_coupled  
    575 # if defined key_lim3 
    576          Must be adapted to LIM3 
    577 # endif  
    578 # if defined key_lim2 
    579          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    580             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    581          CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    582             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    583 # endif  
    584 #endif  
     655         IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     656            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
     657               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     658            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
     659               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     660         ENDIF 
    585661 
    586662         CALL histend( nid_T, snc4chunks=snc4set ) 
    … …  
    673749      ENDIF 
    674750 
    675       ! Write fields on T grid 
    676751      IF( lk_vvl ) THEN 
    677752         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    … …  
    684759         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature 
    685760         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity 
    686  
    687761      ENDIF 
    688762      IF( lk_vvl ) THEN 
    … …  
    734808      ENDIF 
    735809 
    736 #if ! defined key_coupled 
    737       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    738       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    739       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    740       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    741 #endif 
    742 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    743       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    744       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     810      IF( .NOT. lk_cpl ) THEN 
     811         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     812         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    745813         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    746       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    747 #endif 
    748       zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    749       CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
     814         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     815      ENDIF 
     816      IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     817         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     818         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     819         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     820         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     821      ENDIF 
     822!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
     823!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
    750824 
    751825#if defined key_diahth 
    … …  
    756830#endif 
    757831 
    758 #if defined key_coupled  
    759 # if defined key_lim3 
    760       Must be adapted for LIM3 
    761       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    762       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    763 # endif 
    764 # if defined key_lim2 
    765       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    766       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    767 # endif 
    768 #endif 
    769          ! Write fields on U grid 
     832      IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     833         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
     834         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
     835      ENDIF 
     836 
    770837      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    771838      IF( ln_traldf_gdia ) THEN 
    … …  
    789856      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    790857 
    791          ! Write fields on V grid 
    792858      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
    793859      IF( ln_traldf_gdia ) THEN 
    … …  
    804870      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    805871 
    806          ! Write fields on W grid 
    807872      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    808873      IF( ln_traldf_gdia ) THEN 
Note: See TracChangeset for help on using the changeset viewer.