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 7352 – NEMO

Changeset 7352


Ignore:
Timestamp:
2016-11-28T17:52:03+01:00 (7 years ago)
Author:
timgraham
Message:

Changes suggested byt reviewer

Location:
branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7238 r7352  
    66   !! History :  3.2  !  2009-11  (S. Masson)  Original code 
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_diaar5 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_diaar5'  :                           activate ar5 diagnotics 
    128   !!---------------------------------------------------------------------- 
    139   !!   dia_ar5       : AR5 diagnostics 
    … …  
    3127 
    3228   PUBLIC   dia_ar5        ! routine called in step.F90 module 
    33    PUBLIC   dia_ar5_init   ! routine called in opa.F90 module 
    3429   PUBLIC   dia_ar5_alloc  ! routine called in nemogcm.F90 module 
    35  
    36    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag 
     30   PUBLIC   dia_ar5_hst    ! heat/salt transport 
    3731 
    3832   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
    … …  
    4135   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    4236   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
     37 
     38   LOGICAL  :: l_ar5 
    4339       
    4440   !! * Substitutions 
    4541#  include "zdfddm_substitute.h90" 
     42#  include "vectopt_loop_substitute.h90" 
    4643   !!---------------------------------------------------------------------- 
    4744   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    8077      ! 
    8178      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    82       REAL(wp), POINTER, DIMENSION(:,:)     :: pe                         ! 2D workspace  
     79      REAL(wp), POINTER, DIMENSION(:,:)     :: zpe                         ! 2D workspace  
    8380      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace 
    8481      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    … …  
    8683      IF( nn_timing == 1 )   CALL timing_start('dia_ar5') 
    8784  
    88       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    89       CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    90       CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    91  
    92       zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
    93  
    94       !                                         ! total volume of liquid seawater 
    95       zvolssh = SUM( zarea_ssh(:,:) )  
    96       IF( lk_mpp )   CALL mpp_sum( zvolssh ) 
    97       zvol = vol0 + zvolssh 
     85      IF( kt == nit000 )     CALL dia_ar5_init 
     86 
     87      IF( l_ar5 ) THEN 
     88         CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     89         CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
     90         CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     91         zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
     92      ENDIF 
     93      ! 
     94      IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' )  .OR. iom_use( 'sshdyn' )  ) THEN     
     95         !                                         ! total volume of liquid seawater 
     96         zvolssh = SUM( zarea_ssh(:,:) )  
     97         IF( lk_mpp )   CALL mpp_sum( zvolssh ) 
     98         zvol = vol0 + zvolssh 
    9899       
    99       CALL iom_put( 'voltot', zvol               ) 
    100       CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    101       CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
    102  
    103       !                      
    104       ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    105       ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    106       CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    107       ! 
    108       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    109       DO jk = 1, jpkm1 
    110          zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    111       END DO 
    112       IF( ln_linssh ) THEN 
    113          IF( ln_isfcav ) THEN 
    114             DO ji=1,jpi 
    115                DO jj=1,jpj 
    116                   zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
    117                END DO 
    118             END DO 
    119          ELSE 
    120             zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
    121          END IF 
     100         CALL iom_put( 'voltot', zvol               ) 
     101         CALL iom_put( 'sshtot', zvolssh / area_tot ) 
     102         CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
     103         ! 
     104      ENDIF 
     105 
     106      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
     107         !                      
     108         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     109         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
     110         CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     111         ! 
     112         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     113         DO jk = 1, jpkm1 
     114            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     115         END DO 
     116         IF( ln_linssh ) THEN 
     117            IF( ln_isfcav ) THEN 
     118               DO ji = 1, jpi 
     119                  DO jj = 1, jpj 
     120                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     121                  END DO 
     122               END DO 
     123            ELSE 
     124               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     125            END IF 
    122126!!gm 
    123127!!gm   riceload should be added in both ln_linssh=T or F, no? 
    124128!!gm 
    125       END IF 
    126       !                                          
    127       zarho = SUM( area(:,:) * zbotpres(:,:) )  
    128       IF( lk_mpp )   CALL mpp_sum( zarho ) 
    129       zssh_steric = - zarho / area_tot 
    130       CALL iom_put( 'sshthster', zssh_steric ) 
     129         END IF 
     130         !                                          
     131         zarho = SUM( area(:,:) * zbotpres(:,:) )  
     132         IF( lk_mpp )   CALL mpp_sum( zarho ) 
     133         zssh_steric = - zarho / area_tot 
     134         CALL iom_put( 'sshthster', zssh_steric ) 
    131135       
    132       !                                         ! steric sea surface height 
    133       CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
    134       zrhop(:,:,jpk) = 0._wp 
    135       CALL iom_put( 'rhop', zrhop ) 
    136       ! 
    137       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    138       DO jk = 1, jpkm1 
    139          zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    140       END DO 
    141       IF( ln_linssh ) THEN 
    142          IF ( ln_isfcav ) THEN 
    143             DO ji=1,jpi 
    144                DO jj=1,jpj 
    145                   zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     136         !                                         ! steric sea surface height 
     137         CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
     138         zrhop(:,:,jpk) = 0._wp 
     139         CALL iom_put( 'rhop', zrhop ) 
     140         ! 
     141         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     142         DO jk = 1, jpkm1 
     143            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     144         END DO 
     145         IF( ln_linssh ) THEN 
     146            IF ( ln_isfcav ) THEN 
     147               DO ji = 1,jpi 
     148                  DO jj = 1,jpj 
     149                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     150                  END DO 
     151               END DO 
     152            ELSE 
     153               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     154            END IF 
     155         END IF 
     156         !     
     157         zarho = SUM( area(:,:) * zbotpres(:,:) )  
     158         IF( lk_mpp )   CALL mpp_sum( zarho ) 
     159         zssh_steric = - zarho / area_tot 
     160         CALL iom_put( 'sshsteric', zssh_steric ) 
     161       
     162         !                                         ! ocean bottom pressure 
     163         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
     164         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
     165         CALL iom_put( 'botpres', zbotpres ) 
     166         ! 
     167      ENDIF 
     168 
     169      IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' )  .OR. iom_use( 'saltot' )  ) THEN     
     170         !                                         ! Mean density anomalie, temperature and salinity 
     171         ztemp = 0._wp 
     172         zsal  = 0._wp 
     173         DO jk = 1, jpkm1 
     174            DO jj = 1, jpj 
     175               DO ji = 1, jpi 
     176                  zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 
     177                  ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
     178                  zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
    146179               END DO 
    147180            END DO 
    148          ELSE 
    149             zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     181         END DO 
     182         IF( ln_linssh ) THEN 
     183            IF( ln_isfcav ) THEN 
     184               DO ji = 1, jpi 
     185                  DO jj = 1, jpj 
     186                     ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)  
     187                     zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)  
     188                  END DO 
     189               END DO 
     190            ELSE 
     191               ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
     192               zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
     193            END IF 
     194         ENDIF 
     195         IF( lk_mpp ) THEN   
     196            CALL mpp_sum( ztemp ) 
     197            CALL mpp_sum( zsal  ) 
    150198         END IF 
    151       END IF 
    152       !     
    153       zarho = SUM( area(:,:) * zbotpres(:,:) )  
    154       IF( lk_mpp )   CALL mpp_sum( zarho ) 
    155       zssh_steric = - zarho / area_tot 
    156       CALL iom_put( 'sshsteric', zssh_steric ) 
    157        
    158       !                                         ! ocean bottom pressure 
    159       zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    160       zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
    161       CALL iom_put( 'botpres', zbotpres ) 
    162  
    163       !                                         ! Mean density anomalie, temperature and salinity 
    164       ztemp = 0._wp 
    165       zsal  = 0._wp 
    166       DO jk = 1, jpkm1 
    167          DO jj = 1, jpj 
    168             DO ji = 1, jpi 
    169                zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 
    170                ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
    171                zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
    172             END DO 
    173          END DO 
    174       END DO 
    175       IF( ln_linssh ) THEN 
    176          IF( ln_isfcav ) THEN 
    177             DO ji=1,jpi 
    178                DO jj=1,jpj 
    179                   ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)  
    180                   zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)  
    181                END DO 
    182             END DO 
    183          ELSE 
    184             ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
    185             zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
    186          END IF 
    187       ENDIF 
    188       IF( lk_mpp ) THEN   
    189          CALL mpp_sum( ztemp ) 
    190          CALL mpp_sum( zsal  ) 
    191       END IF 
    192       ! 
    193       zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater 
    194       ztemp = ztemp / zvol                            ! potential temperature in liquid seawater 
    195       zsal  = zsal  / zvol                            ! Salinity of liquid seawater 
    196       ! 
    197       CALL iom_put( 'masstot', zmass ) 
    198       CALL iom_put( 'temptot', ztemp ) 
    199       CALL iom_put( 'saltot' , zsal  ) 
     199         ! 
     200         zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater 
     201         ztemp = ztemp / zvol                            ! potential temperature in liquid seawater 
     202         zsal  = zsal  / zvol                            ! Salinity of liquid seawater 
     203         ! 
     204         CALL iom_put( 'masstot', zmass ) 
     205         CALL iom_put( 'temptot', ztemp ) 
     206         CALL iom_put( 'saltot' , zsal  ) 
     207         ! 
     208      ENDIF 
    200209 
    201210      IF( iom_use( 'tnpeo' )) THEN     
    … …  
    203212      ! Exclude points where rn2 is negative as convection kicks in here and 
    204213      ! work is not being done against stratification 
    205           pe(:,:) = 0._wp 
     214          CALL wrk_alloc( jpi, jpj, zpe ) 
     215          zpe(:,:) = 0._wp 
    206216          IF( lk_zdfddm ) THEN 
    207217             DO ji=1,jpi 
    … …  
    214224                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
    215225                      ! 
    216                       pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
     226                      zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
    217227                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
    218228                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
    … …  
    222232             ENDDO 
    223233          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) 
     234             DO ji = 1, jpi 
     235                DO jj = 1, jpj 
     236                   DO jk = 1, jpk 
     237                       zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
    228238                   ENDDO 
    229239                ENDDO 
    230240             ENDDO 
    231241          ENDIF 
    232           CALL lbc_lnk(pe, 'T', 1._wp)          
    233           CALL iom_put( 'tnpeo', pe ) 
    234       ENDIF 
    235       ! 
    236       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    237       CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    238       CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     242          CALL lbc_lnk( zpe, 'T', 1._wp)          
     243          CALL iom_put( 'tnpeo', zpe ) 
     244          CALL wrk_dealloc( jpi, jpj, zpe ) 
     245      ENDIF 
     246      ! 
     247      IF( l_ar5 ) THEN 
     248        CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     249        CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
     250        CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     251      ENDIF 
    239252      ! 
    240253      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5') 
    241254      ! 
    242255   END SUBROUTINE dia_ar5 
     256 
     257   SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva )  
     258      !!---------------------------------------------------------------------- 
     259      !!                    ***  ROUTINE dia_ar5_htr *** 
     260      !!---------------------------------------------------------------------- 
     261      !! Wrapper for heat transport calculations 
     262      !! Called from all advection and/or diffusion routines 
     263      !!---------------------------------------------------------------------- 
     264      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
     265      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
     266      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pua   ! 3D input array of advection/diffusion 
     267      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     268      ! 
     269      INTEGER    ::  ji, jj, jk 
     270      REAL(wp), POINTER, DIMENSION(:,:)  :: z2d 
     271 
     272     
     273 
     274      CALL wrk_alloc( jpi, jpj, z2d ) 
     275      z2d(:,:) = pua(:,:,1)  
     276      DO jk = 1, jpkm1 
     277         DO jj = 2, jpjm1 
     278            DO ji = fs_2, fs_jpim1   ! vector opt. 
     279               z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk)  
     280            END DO 
     281         END DO 
     282       END DO 
     283       CALL lbc_lnk( z2d, 'U', -1. ) 
     284       IF( cptr == 'adv' ) THEN 
     285          IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in i-direction 
     286          IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0     * z2d )  ! advective salt transport in i-direction 
     287       ENDIF 
     288       IF( cptr == 'ldf' ) THEN 
     289          IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 
     290          IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0     * z2d ) ! diffusive salt transport in i-direction 
     291       ENDIF 
     292       ! 
     293       z2d(:,:) = pva(:,:,1)  
     294       DO jk = 1, jpkm1 
     295          DO jj = 2, jpjm1 
     296             DO ji = fs_2, fs_jpim1   ! vector opt. 
     297                z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk)  
     298             END DO 
     299          END DO 
     300       END DO 
     301       CALL lbc_lnk( z2d, 'V', -1. ) 
     302       IF( cptr == 'adv' ) THEN 
     303          IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in j-direction 
     304          IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0     * z2d )  ! advective salt transport in j-direction 
     305       ENDIF 
     306       IF( cptr == 'ldf' ) THEN 
     307          IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 
     308          IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0     * z2d ) ! diffusive salt transport in j-direction 
     309       ENDIF 
     310           
     311       CALL wrk_dealloc( jpi, jpj, z2d ) 
     312 
     313   END SUBROUTINE dia_ar5_hst 
    243314 
    244315 
    … …  
    259330      IF( nn_timing == 1 )   CALL timing_start('dia_ar5_init') 
    260331      ! 
    261       CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 
    262       !                                      ! allocate dia_ar5 arrays 
    263       IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    264  
    265       area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    266  
    267       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
    268  
    269       vol0        = 0._wp 
    270       thick0(:,:) = 0._wp 
    271       DO jk = 1, jpkm1 
    272          vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 
    273          thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 
    274       END DO 
    275       IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    276  
    277  
    278       CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
    279       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
    280       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
    281       CALL iom_close( inum ) 
    282  
    283       sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    284       sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    285       IF( ln_zps ) THEN               ! z-coord. partial steps 
    286          DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    287             DO ji = 1, jpi 
    288                ik = mbkt(ji,jj) 
    289                IF( ik > 1 ) THEN 
    290                   zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    291                   sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    292                ENDIF 
     332      l_ar5 = .FALSE. 
     333      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
     334         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
     335         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     336   
     337      IF( l_ar5 ) THEN 
     338         ! 
     339         CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 
     340         !                                      ! allocate dia_ar5 arrays 
     341         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
     342 
     343         area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
     344 
     345         area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
     346 
     347         vol0        = 0._wp 
     348         thick0(:,:) = 0._wp 
     349         DO jk = 1, jpkm1 
     350            vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 
     351            thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 
     352         END DO 
     353         IF( lk_mpp )   CALL mpp_sum( vol0 ) 
     354 
     355 
     356         CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
     357         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     358         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
     359         CALL iom_close( inum ) 
     360 
     361         sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     362         sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     363         IF( ln_zps ) THEN               ! z-coord. partial steps 
     364            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     365               DO ji = 1, jpi 
     366                  ik = mbkt(ji,jj) 
     367                  IF( ik > 1 ) THEN 
     368                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     369                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     370                  ENDIF 
     371               END DO 
    293372            END DO 
    294          END DO 
    295       ENDIF 
    296       ! 
    297       CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 
     373         ENDIF 
     374         ! 
     375         CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 
     376         ! 
     377      ENDIF 
    298378      ! 
    299379      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init') 
    300380      ! 
    301381   END SUBROUTINE dia_ar5_init 
    302  
    303 #else 
    304    !!---------------------------------------------------------------------- 
    305    !!   Default option :                                         NO diaar5 
    306    !!---------------------------------------------------------------------- 
    307    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE.   ! coupled flag 
    308 CONTAINS 
    309    SUBROUTINE dia_ar5_init    ! Dummy routine 
    310    END SUBROUTINE dia_ar5_init 
    311    SUBROUTINE dia_ar5( kt )   ! Empty routine 
    312       INTEGER ::   kt 
    313       WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt 
    314    END SUBROUTINE dia_ar5 
    315 #endif 
    316382 
    317383   !!====================================================================== 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r7330 r7352  
    3939   PUBLIC   dia_ptr_init   ! call in step module 
    4040   PUBLIC   dia_ptr        ! call in step module 
    41    PUBLIC   dia_ptr_ohst_components        ! called from tra_ldf/tra_adv routines 
     41   PUBLIC   dia_ptr_hst    ! called from tra_ldf/tra_adv routines 
    4242 
    4343   !                                  !!** namelist  namptr  ** 
    44    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv, htr_vt   !: Heat TRansports (adv, diff, Bolus.) 
    45    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv, str_vs   !: Salt TRansports (adv, diff, Bolus.) 
     44   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv   !: Heat TRansports (adv, diff, Bolus.) 
     45   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv   !: Salt TRansports (adv, diff, Bolus.) 
    4646   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.) 
    4747   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic ) 
    … …  
    340340         ENDIF 
    341341 
    342          IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN    
    343             z2d(1,:) = htr_vt(:,1) * rc_pwatt        !  (conversion in PW)  
    344             DO ji = 1, jpi 
    345                z2d(ji,:) = z2d(1,:) 
    346             ENDDO 
    347             cl1 = 'sopht_vt' 
    348             CALL iom_put( TRIM(cl1), z2d ) 
    349             z2d(1,:) = str_vs(:,1) * rc_ggram        !  (conversion in Gg) 
    350             DO ji = 1, jpi 
    351                z2d(ji,:) = z2d(1,:) 
    352             ENDDO 
    353             cl1 = 'sopst_vs' 
    354             CALL iom_put( TRIM(cl1), z2d ) 
    355             IF( ln_subbas ) THEN 
    356               DO jn=2,nptr 
    357                z2d(1,:) = htr_vt(:,jn) * rc_pwatt        !  (conversion in PW) 
    358                DO ji = 1, jpi 
    359                  z2d(ji,:) = z2d(1,:) 
    360                ENDDO 
    361                cl1 = TRIM('sopht_vt_'//clsubb(jn))                  
    362                CALL iom_put( cl1, z2d ) 
    363                z2d(1,:) = str_vs(:,jn) * rc_ggram        ! (conversion in Gg) 
    364                DO ji = 1, jpi 
    365                   z2d(ji,:) = z2d(1,:) 
    366                ENDDO 
    367                cl1 = TRIM('sopst_vs_'//clsubb(jn))                  
    368                CALL iom_put( cl1, z2d )               
    369               ENDDO 
    370             ENDIF 
    371          ENDIF 
    372  
    373342         IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
    374343            z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
    … …  
    482451         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
    483452         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
    484          htr_vt(:,:) = 0._wp  ;   str_vs(:,:) =  0._wp 
    485453         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
    486454         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
    … …  
    490458   END SUBROUTINE dia_ptr_init 
    491459 
    492    SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva )  
    493       !!---------------------------------------------------------------------- 
    494       !!                    ***  ROUTINE dia_ptr_ohst_components *** 
     460   SUBROUTINE dia_ptr_hst( ktra, cptr, pva )  
     461      !!---------------------------------------------------------------------- 
     462      !!                    ***  ROUTINE dia_ptr_hst *** 
    495463      !!---------------------------------------------------------------------- 
    496464      !! Wrapper for heat and salt transport calculations to calculate them for each basin 
    … …  
    514482         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
    515483      ENDIF 
    516       IF( cptr == 'vts' ) THEN 
    517          IF( ktra == jp_tem )  htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 
    518          IF( ktra == jp_sal )  str_vs(:,1) = ptr_sj( pva(:,:,:) ) 
    519       ENDIF 
    520484      ! 
    521485      IF( ln_subbas ) THEN 
    … …  
    557521             ENDIF 
    558522         ENDIF 
    559          IF( cptr == 'vts' ) THEN 
    560              IF( ktra == jp_tem ) THEN  
    561                 DO jn = 2, nptr 
    562                     htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    563                  END DO 
    564              ENDIF 
    565              IF( ktra == jp_sal ) THEN  
    566                 DO jn = 2, nptr 
    567                    str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    568                 END DO 
    569              ENDIF 
    570          ENDIF 
    571523         ! 
    572524      ENDIF 
    573    END SUBROUTINE dia_ptr_ohst_components 
     525   END SUBROUTINE dia_ptr_hst 
    574526 
    575527 
    … …  
    586538         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
    587539         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
    588          &      htr_vt(jpj,nptr)  , str_vs(jpj,nptr)  ,   & 
    589540         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   & 
    590541         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   & 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7330 r7352  
    1717   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1818   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri 
    19    !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
    20    !!                 !                     change name of output variables in dia_wri_state 
    2119   !!---------------------------------------------------------------------- 
    2220 
    … …  
    2725   USE oce             ! ocean dynamics and tracers  
    2826   USE dom_oce         ! ocean space and time domain 
    29    USE dynadv, ONLY: ln_dynadv_vec 
    3027   USE zdf_oce         ! ocean vertical physics 
    31    USE ldftra          ! lateral physics: eddy diffusivity coef. 
    32    USE ldfdyn          ! lateral physics: eddy viscosity   coef. 
    3328   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3429   USE sbc_ice         ! Surface boundary condition: ice fields 
    35    USE icb_oce         ! Icebergs 
    36    USE icbdia          ! Iceberg budgets 
    3730   USE sbcssr          ! restoring term toward SST/SSS climatology 
    3831   USE phycst          ! physical constants 
    … …  
    4134   USE zdfddm          ! vertical  physics: double diffusion 
    4235   USE diahth          ! thermocline diagnostics 
    43    ! 
    4436   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4537   USE in_out_manager  ! I/O manager 
    46    USE diatmb          ! Top,middle,bottom output 
    47    USE dia25h          ! 25h Mean output 
    4838   USE iom 
    4939   USE ioipsl 
    50  
    5140#if defined key_lim2 
    5241   USE limwri_2  
    53 #elif defined key_lim3 
    54    USE limwri  
    5542#endif 
    5643   USE lib_mpp         ! MPP library 
    5744   USE timing          ! preformance summary 
    58    USE diurnal_bulk    ! diurnal warm layer 
    59    USE cool_skin       ! Cool skin 
    6045   USE wrk_nemo        ! working array 
    6146 
    … …  
    6853 
    6954   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    70    INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
    7155   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    7256   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
    73    INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
    7457   INTEGER ::   ndex(1)                              ! ??? 
    7558   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
    76    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    77    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
    7859 
    7960   !! * Substitutions 
    80 #  include "zdfddm_substitute.h90" 
    8161#  include "vectopt_loop_substitute.h90" 
    8262   !!---------------------------------------------------------------------- 
    … …  
    8969   INTEGER FUNCTION dia_wri_alloc() 
    9070      !!---------------------------------------------------------------------- 
    91       INTEGER, DIMENSION(2) :: ierr 
    92       !!---------------------------------------------------------------------- 
    93       ierr = 0 
    94       ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    95          &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
    96          &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
    97          ! 
    98       dia_wri_alloc = MAXVAL(ierr) 
     71      INTEGER :: ierr 
     72      !!---------------------------------------------------------------------- 
     73      ! 
     74      ALLOCATE( ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc ) 
    9975      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc ) 
    10076      ! 
    … …  
    11591      !! ** Purpose :   Standard output of opa: dynamics and tracer fields  
    11692      !!      NETCDF format is used by default  
     93      !!      Standalone surface scheme  
    11794      !! 
    11895      !! ** Method  :  use iom_put 
    11996      !!---------------------------------------------------------------------- 
    120       !! 
    121       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    122       !! 
    123       INTEGER                      ::   ji, jj, jk              ! dummy loop indices 
    124       INTEGER                      ::   jkbot                   ! 
    125       REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    126       !! 
    127       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
    128       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
     97      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    12998      !!---------------------------------------------------------------------- 
    13099      !  
    131       IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    132       !  
    133       CALL wrk_alloc( jpi , jpj      , z2d ) 
    134       CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    135       ! 
    136       ! Output the initial state and forcings 
    137       IF( ninist == 1 ) THEN                        
    138          CALL dia_wri_state( 'output.init', kt ) 
    139          ninist = 0 
    140       ENDIF 
    141  
    142       ! Output of initial vertical scale factor 
    143       CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
    144       CALL iom_put("e3u_0", e3t_0(:,:,:) ) 
    145       CALL iom_put("e3v_0", e3t_0(:,:,:) ) 
    146       ! 
    147       CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
    148       CALL iom_put( "e3u" , e3u_n(:,:,:) ) 
    149       CALL iom_put( "e3v" , e3v_n(:,:,:) ) 
    150       CALL iom_put( "e3w" , e3w_n(:,:,:) ) 
    151       IF( iom_use("e3tdef") )   & 
    152          CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
    153  
    154       CALL iom_put( "ssh" , sshn )                 ! sea surface height 
    155        
    156       CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
    157       CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    158       IF ( iom_use("sbt") ) THEN 
    159          DO jj = 1, jpj 
    160             DO ji = 1, jpi 
    161                jkbot = mbkt(ji,jj) 
    162                z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem) 
    163             END DO 
    164          END DO 
    165          CALL iom_put( "sbt", z2d )                ! bottom temperature 
    166       ENDIF 
    167        
    168       CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity 
    169       CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    170       IF ( iom_use("sbs") ) THEN 
    171          DO jj = 1, jpj 
    172             DO ji = 1, jpi 
    173                jkbot = mbkt(ji,jj) 
    174                z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal) 
    175             END DO 
    176          END DO 
    177          CALL iom_put( "sbs", z2d )                ! bottom salinity 
    178       ENDIF 
    179  
    180       IF ( iom_use("taubot") ) THEN                ! bottom stress 
    181          z2d(:,:) = 0._wp 
    182          DO jj = 2, jpjm1 
    183             DO ji = fs_2, fs_jpim1   ! vector opt. 
    184                zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  & 
    185                       &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )       
    186                zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  & 
    187                       &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  )  
    188                z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)  
    189                ! 
    190             ENDDO 
    191          ENDDO 
    192          CALL lbc_lnk( z2d, 'T', 1. ) 
    193          CALL iom_put( "taubot", z2d )            
    194       ENDIF 
    195           
    196       CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current 
    197       CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    198       IF ( iom_use("sbu") ) THEN 
    199          DO jj = 1, jpj 
    200             DO ji = 1, jpi 
    201                jkbot = mbku(ji,jj) 
    202                z2d(ji,jj) = un(ji,jj,jkbot) 
    203             END DO 
    204          END DO 
    205          CALL iom_put( "sbu", z2d )                ! bottom i-current 
    206       ENDIF 
    207        
    208       CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current 
    209       CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    210       IF ( iom_use("sbv") ) THEN 
    211          DO jj = 1, jpj 
    212             DO ji = 1, jpi 
    213                jkbot = mbkv(ji,jj) 
    214                z2d(ji,jj) = vn(ji,jj,jkbot) 
    215             END DO 
    216          END DO 
    217          CALL iom_put( "sbv", z2d )                ! bottom j-current 
    218       ENDIF 
    219  
    220       CALL iom_put( "woce", wn )                   ! vertical velocity 
    221       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    222          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    223          z2d(:,:) = rau0 * e1e2t(:,:) 
    224          DO jk = 1, jpk 
    225             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    226          END DO 
    227          CALL iom_put( "w_masstr" , z3d )   
    228          IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    229       ENDIF 
    230  
    231       CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef. 
    232       CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef. 
    233       CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm) 
    234  
    235       IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) ) 
    236       IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) ) 
    237  
    238       IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    239          DO jj = 2, jpjm1                                    ! sst gradient 
    240             DO ji = fs_2, fs_jpim1   ! vector opt. 
    241                zztmp  = tsn(ji,jj,1,jp_tem) 
    242                zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj) 
    243                zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1) 
    244                z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    245                   &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    246             END DO 
    247          END DO 
    248          CALL lbc_lnk( z2d, 'T', 1. ) 
    249          CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    250          z2d(:,:) = SQRT( z2d(:,:) ) 
    251          CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    252       ENDIF 
    253           
    254       ! clem: heat and salt content 
    255       IF( iom_use("heatc") ) THEN 
    256          z2d(:,:)  = 0._wp  
    257          DO jk = 1, jpkm1 
    258             DO jj = 1, jpj 
    259                DO ji = 1, jpi 
    260                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    261                END DO 
    262             END DO 
    263          END DO 
    264          CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
    265       ENDIF 
    266  
    267       IF( iom_use("saltc") ) THEN 
    268          z2d(:,:)  = 0._wp  
    269          DO jk = 1, jpkm1 
    270             DO jj = 1, jpj 
    271                DO ji = 1, jpi 
    272                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    273                END DO 
    274             END DO 
    275          END DO 
    276          CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
    277       ENDIF 
    278       ! 
    279       IF ( iom_use("eken") ) THEN 
    280          rke(:,:,jk) = 0._wp                               !      kinetic energy  
    281          DO jk = 1, jpkm1 
    282             DO jj = 2, jpjm1 
    283                DO ji = fs_2, fs_jpim1   ! vector opt. 
    284                   zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    285                   zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    & 
    286                      &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  & 
    287                      &          *  zztmp  
    288                   ! 
    289                   zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    & 
    290                      &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  & 
    291                      &          *  zztmp  
    292                   ! 
    293                   rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 
    294                   ! 
    295                ENDDO 
    296             ENDDO 
    297          ENDDO 
    298          CALL lbc_lnk( rke, 'T', 1. ) 
    299          CALL iom_put( "eken", rke )            
    300       ENDIF 
    301       ! 
    302       CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
    303       ! 
    304       IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    305          z3d(:,:,jpk) = 0.e0 
    306          z2d(:,:) = 0.e0 
    307          DO jk = 1, jpkm1 
    308             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
    309             z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    310          END DO 
    311          CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    312          CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    313       ENDIF 
    314        
    315       IF( iom_use("u_heattr") ) THEN 
    316          z2d(:,:) = 0.e0  
    317          DO jk = 1, jpkm1 
    318             DO jj = 2, jpjm1 
    319                DO ji = fs_2, fs_jpim1   ! vector opt. 
    320                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    321                END DO 
    322             END DO 
    323          END DO 
    324          CALL lbc_lnk( z2d, 'U', -1. ) 
    325          CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
    326       ENDIF 
    327  
    328       IF( iom_use("u_salttr") ) THEN 
    329          z2d(:,:) = 0.e0  
    330          DO jk = 1, jpkm1 
    331             DO jj = 2, jpjm1 
    332                DO ji = fs_2, fs_jpim1   ! vector opt. 
    333                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    334                END DO 
    335             END DO 
    336          END DO 
    337          CALL lbc_lnk( z2d, 'U', -1. ) 
    338          CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
    339       ENDIF 
    340  
    341        
    342       IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    343          z3d(:,:,jpk) = 0.e0 
    344          DO jk = 1, jpkm1 
    345             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
    346          END DO 
    347          CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
    348       ENDIF 
    349        
    350       IF( iom_use("v_heattr") ) THEN 
    351          z2d(:,:) = 0.e0  
    352          DO jk = 1, jpkm1 
    353             DO jj = 2, jpjm1 
    354                DO ji = fs_2, fs_jpim1   ! vector opt. 
    355                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    356                END DO 
    357             END DO 
    358          END DO 
    359          CALL lbc_lnk( z2d, 'V', -1. ) 
    360          CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
    361       ENDIF 
    362  
    363       IF( iom_use("v_salttr") ) THEN 
    364          z2d(:,:) = 0.e0  
    365          DO jk = 1, jpkm1 
    366             DO jj = 2, jpjm1 
    367                DO ji = fs_2, fs_jpim1   ! vector opt. 
    368                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
    369                END DO 
    370             END DO 
    371          END DO 
    372          CALL lbc_lnk( z2d, 'V', -1. ) 
    373          CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    374       ENDIF 
    375  
    376       ! Vertical integral of temperature 
    377       IF( iom_use("tosmint") ) THEN 
    378          z2d(:,:)=0._wp 
    379          DO jk = 1, jpkm1 
    380             DO jj = 2, jpjm1 
    381                DO ji = fs_2, fs_jpim1   ! vector opt. 
    382                   z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
    383                END DO 
    384             END DO 
    385          END DO 
    386          CALL lbc_lnk( z2d, 'T', -1. ) 
    387          CALL iom_put( "tosmint", z2d )  
    388       ENDIF 
    389  
    390       ! Vertical integral of salinity 
    391       IF( iom_use("somint") ) THEN 
    392          z2d(:,:)=0._wp 
    393          DO jk = 1, jpkm1 
    394             DO jj = 2, jpjm1 
    395                DO ji = fs_2, fs_jpim1   ! vector opt. 
    396                   z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
    397                END DO 
    398             END DO 
    399          END DO 
    400          CALL lbc_lnk( z2d, 'T', -1. ) 
    401          CALL iom_put( "somint", z2d )  
    402       ENDIF 
    403  
    404       CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2) 
    405       ! 
    406       CALL wrk_dealloc( jpi , jpj      , z2d ) 
    407       CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    408       ! 
    409       ! If we want tmb values  
    410  
    411       IF (ln_diatmb) THEN 
    412          CALL dia_tmb  
    413       ENDIF  
    414       IF (ln_dia25h) THEN 
    415          CALL dia_25h( kt ) 
    416       ENDIF  
    417  
    418       IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
     100      !! no relevant 2D arrays to write in iomput case 
    419101      ! 
    420102   END SUBROUTINE dia_wri 
    … …  
    437119      !!      Each nwrite time step, output the instantaneous or mean fields 
    438120      !!---------------------------------------------------------------------- 
    439       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    440       ! 
     121      !! 
     122      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     123      !! 
    441124      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    442125      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names 
    … …  
    445128      INTEGER  ::   ierr                                     ! error code return from allocation 
    446129      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
    447       INTEGER  ::   jn, ierror                               ! local integers 
    448130      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
    449       ! 
    450       REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace 
    451       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace 
    452131      !!---------------------------------------------------------------------- 
    453132      !  
    454133      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    455       ! 
    456                              CALL wrk_alloc( jpi,jpj      , zw2d ) 
    457       IF( .NOT.ln_linssh )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d ) 
    458134      ! 
    459135      ! Output the initial state and forcings 
    … …  
    471147 
    472148      ! Define frequency of output and means 
    473       clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes) 
     149      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
     150      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
     151      ENDIF 
    474152#if defined key_diainstant 
    475153      zsto = nwrite * rdt 
    … …  
    526204            &           "m", ipk, gdept_1d, nz_T, "down" ) 
    527205         !                                                            ! Index of ocean points 
    528          CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume 
    529206         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface 
    530          ! 
    531          IF( ln_icebergs ) THEN 
    532             ! 
    533             !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after  
    534             !! that routine is called from nemogcm, so do it here immediately before its needed 
    535             ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 
    536             IF( lk_mpp )   CALL mpp_sum( ierror ) 
    537             IF( ierror /= 0 ) THEN 
    538                CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') 
    539                RETURN 
    540             ENDIF 
    541             ! 
    542             !! iceberg vertical coordinate is class number 
    543             CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class 
    544                &           "number", nclasses, class_num, nb_T ) 
    545             ! 
    546             !! each class just needs the surface index pattern 
    547             ndim_bT = 3 
    548             DO jn = 1,nclasses 
    549                ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj) 
    550             ENDDO 
    551             ! 
    552          ENDIF 
    553207 
    554208         ! Define the U grid FILE ( nid_U ) 
    … …  
    562216            &           "m", ipk, gdept_1d, nz_U, "down" ) 
    563217         !                                                            ! Index of ocean points 
    564          CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume 
    565218         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface 
    566219 
    … …  
    575228            &          "m", ipk, gdept_1d, nz_V, "down" ) 
    576229         !                                                            ! Index of ocean points 
    577          CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume 
    578230         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface 
    579231 
    580          ! Define the W grid FILE ( nid_W ) 
    581  
    582          CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename 
    583          IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 
    584          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    585             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    586             &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 
    587          CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw 
    588             &          "m", ipk, gdepw_1d, nz_W, "down" ) 
    589  
     232         ! No W grid FILE 
    590233 
    591234         ! Declare all the output fields as NETCDF variables 
    592235 
    593236         !                                                                                      !!! nid_T : 3D 
    594          CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn 
    595             &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    596          CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn 
    597             &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    598          IF(  .NOT.ln_linssh  ) THEN 
    599             CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n 
    600             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    601             CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n 
    602             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    603             CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n 
    604             &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 
    605          ENDIF 
    606          !                                                                                      !!! nid_T : 2D 
    607          CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst 
    608             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    609          CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss 
    610             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    611          CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh 
     237         CALL histdef( nid_T, "sst_m", "Sea Surface temperature"            , "C"      ,   &  ! sst 
     238            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     239         CALL histdef( nid_T, "sss_m", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss 
    612240            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    613241         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf) 
    614242            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    615          CALL histdef( nid_T, "sorunoff", "River runoffs"                      , "Kg/m2/s",   &  ! runoffs 
    616             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    617          CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx 
    618             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    619          IF(  ln_linssh  ) THEN 
    620             CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem) 
    621             &                                                                  , "KgC/m2/s",  &  ! sosst_cd 
    622             &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    623             CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * tsn(:,:,1,jp_sal) 
    624             &                                                                  , "KgPSU/m2/s",&  ! sosss_cd 
    625             &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    626          ENDIF 
     243         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! (sfx) 
     244             &         jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    627245         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr 
    628246            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    629247         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr 
    630248            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    631          CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld 
    632             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    633          CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp 
    634             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    635249         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i 
    636250            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    637251         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    638252            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    639 ! 
    640          IF( ln_icebergs ) THEN 
    641             CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , & 
    642                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    643             CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , & 
    644                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    645             CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", & 
    646                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    647             CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , & 
    648                &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout ) 
    649             IF( ln_bergdia ) THEN 
    650                CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", & 
    651                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    652                CALL histdef( nid_T, "berg_buoy_melt"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", & 
    653                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    654                CALL histdef( nid_T, "berg_eros_melt"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", & 
    655                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    656                CALL histdef( nid_T, "berg_conv_melt"      , "Convective component of iceberg melt rate", "kg/m2/s", & 
    657                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    658                CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , & 
    659                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    660                CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", & 
    661                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    662                CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", & 
    663                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    664                CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , & 
    665                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    666                CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , & 
    667                   &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    668                CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , & 
    669                   &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout ) 
    670             ENDIF 
    671          ENDIF 
    672  
    673          IF( .NOT. ln_cpl ) THEN 
    674             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    675                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    676             CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    677                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    678             CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    679                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    680          ENDIF 
    681  
    682          IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    683             CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    684                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    685             CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    686                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    687             CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    688                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    689          ENDIF 
    690           
    691          clmx ="l_max(only(x))"    ! max index on a period 
    692 !         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    693 !            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) 
    694 #if defined key_diahth 
    695          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth 
    696             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    697          CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20 
    698             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    699          CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28 
    700             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    701          CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3 
    702             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    703 #endif 
    704  
    705          IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    706             CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    707                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    708             CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    709                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    710          ENDIF 
    711253 
    712254         CALL histend( nid_T, snc4chunks=snc4set ) 
    713255 
    714256         !                                                                                      !!! nid_U : 3D 
    715          CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
    716             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    717          !                                                                                      !!! nid_U : 2D 
     257         CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s"   ,         &  ! ssu 
     258            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    718259         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
    719260            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    … …  
    722263 
    723264         !                                                                                      !!! nid_V : 3D 
    724          CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
    725             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    726          !                                                                                      !!! nid_V : 2D 
     265         CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s",            &  ! ssv_m 
     266            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    727267         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
    728268            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    729269 
    730270         CALL histend( nid_V, snc4chunks=snc4set ) 
    731  
    732          !                                                                                      !!! nid_W : 3D 
    733          CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
    734             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    735          CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    736             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    737          CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avmu 
    738             &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    739  
    740          IF( lk_zdfddm ) THEN 
    741             CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs 
    742                &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    743          ENDIF 
    744          !                                                                                      !!! nid_W : 2D 
    745          CALL histend( nid_W, snc4chunks=snc4set ) 
    746271 
    747272         IF(lwp) WRITE(numout,*) 
    … …  
    754279      ! --------------------- 
    755280 
    756       ! ndex(1) est utilise ssi l'avant dernier argument est different de  
     281      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de  
    757282      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 
    758283      ! donne le nombre d'elements, et ndex la liste des indices a sortir 
    … …  
    763288      ENDIF 
    764289 
    765       IF( .NOT.ln_linssh ) THEN 
    766          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
    767          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content 
    768          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content 
    769          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content 
    770       ELSE 
    771          CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature 
    772          CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity 
    773          CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature 
    774          CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity 
    775       ENDIF 
    776       IF( .NOT.ln_linssh ) THEN 
    777          zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    778          CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    779          CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
    780          CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation 
    781       ENDIF 
    782       CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    783       CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux 
    784       CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs 
     290      ! Write fields on T grid 
     291      CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT )   ! sea surface temperature 
     292      CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT )   ! sea surface salinity 
     293      CALL histwrite( nid_T, "sowaflup", it, (emp - rnf )  , ndim_hT, ndex_hT )   ! upward water flux 
    785294      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux  
    786295                                                                                  ! (includes virtual salt flux beneath ice  
    787296                                                                                  ! in linear free surface case) 
    788       IF( ln_linssh ) THEN 
    789          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
    790          CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    791          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
    792          CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    793       ENDIF 
     297 
    794298      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    795299      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux 
    796       CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth 
    797       CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth 
    798300      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    799301      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
    800 ! 
    801       IF( ln_icebergs ) THEN 
    802          ! 
    803          CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT )   
    804          CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )          
    805          CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT )   
    806          ! 
    807          CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT ) 
    808          ! 
    809          IF( ln_bergdia ) THEN 
    810             CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   )   
    811             CALL histwrite( nid_T, "berg_buoy_melt"      , it, buoy_melt        , ndim_hT, ndex_hT   )   
    812             CALL histwrite( nid_T, "berg_eros_melt"      , it, eros_melt        , ndim_hT, ndex_hT   )   
    813             CALL histwrite( nid_T, "berg_conv_melt"      , it, conv_melt        , ndim_hT, ndex_hT   )   
    814             CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   )   
    815             CALL histwrite( nid_T, "bits_src"            , it, bits_src         , ndim_hT, ndex_hT   )   
    816             CALL histwrite( nid_T, "bits_melt"           , it, bits_melt        , ndim_hT, ndex_hT   )   
    817             CALL histwrite( nid_T, "bits_mass"           , it, bits_mass        , ndim_hT, ndex_hT   )   
    818             CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   )   
    819             ! 
    820             CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   ) 
    821          ENDIF 
    822       ENDIF 
    823  
    824       IF( .NOT. ln_cpl ) THEN 
    825          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    826          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    827          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    828          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    829       ENDIF 
    830       IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    831          CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    832          CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    833          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    834          CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    835       ENDIF 
    836 !      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    837 !      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
    838  
    839 #if defined key_diahth 
    840       CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline 
    841       CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm 
    842       CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm 
    843       CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content 
    844 #endif 
    845  
    846       IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    847          CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    848          CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    849       ENDIF 
    850  
    851       CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
     302 
     303         ! Write fields on U grid 
     304      CALL histwrite( nid_U, "ssu_m"   , it, ssu_m         , ndim_hU, ndex_hU )   ! i-current speed 
    852305      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    853306 
    854       CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
     307         ! Write fields on V grid 
     308      CALL histwrite( nid_V, "ssv_m"   , it, ssv_m         , ndim_hV, ndex_hV )   ! j-current speed 
    855309      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    856  
    857       CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    858       CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    859       CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
    860       IF( lk_zdfddm ) THEN 
    861          CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef. 
    862       ENDIF 
    863310 
    864311      ! 3. Close all files 
    … …  
    868315         CALL histclo( nid_U ) 
    869316         CALL histclo( nid_V ) 
    870          CALL histclo( nid_W ) 
    871       ENDIF 
    872       ! 
    873                              CALL wrk_dealloc( jpi , jpj        , zw2d ) 
    874       IF( .NOT.ln_linssh )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     317      ENDIF 
    875318      ! 
    876319      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
    … …  
    902345      !!---------------------------------------------------------------------- 
    903346      !  
     347      IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') 
     348 
    904349      ! 0. Initialisation 
    905350      ! ----------------- 
    … …  
    932377      ! Declare all the output fields as NetCDF variables 
    933378 
    934       CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity 
    935          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    936       CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature 
    937          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    938       CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh 
    939          &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout ) 
    940       CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current 
    941          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    942       CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current 
    943          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    944       CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current 
    945          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    946          ! 
    947       CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current 
    948          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    949       CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current 
    950          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    951       CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current 
    952          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    953       CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current 
    954          &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )  
    955          ! 
    956379      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    957380         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    966389      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress 
    967390         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    968       IF( .NOT.ln_linssh ) THEN 
    969          CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth 
    970             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    971          CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth 
    972             &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    973       ENDIF 
    974391 
    975392#if defined key_lim2 
    976393      CALL lim_wri_state_2( kt, id_i, nh_i ) 
    977 #elif defined key_lim3 
    978       CALL lim_wri_state( kt, id_i, nh_i ) 
    979394#else 
    980395      CALL histend( id_i, snc4chunks=snc4set ) 
    … …  
    989404 
    990405      ! Write all fields on T grid 
    991       CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
    992       CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
    993       CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
    994       CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
    995       CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
    996       CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    997       ! 
    998       CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point 
    999       CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point 
    1000       CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point 
    1001       CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point 
    1002       ! 
    1003       CALL histwrite( id_i, "sowaflup", kt, emp-rnf          , jpi*jpj    , idex )    ! freshwater budget 
     406      CALL histwrite( id_i, "sowaflup", kt, emp              , jpi*jpj    , idex )    ! freshwater budget 
    1004407      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    1005408      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
    … …  
    1008411      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    1009412 
    1010       IF(  .NOT.ln_linssh  ) THEN              
    1011          CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth  
    1012          CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness   
    1013       END IF  
    1014413      ! 3. Close the file 
    1015414      ! ----------------- 
    … …  
    1020419         CALL histclo( nid_U ) 
    1021420         CALL histclo( nid_V ) 
    1022          CALL histclo( nid_W ) 
    1023421      ENDIF 
    1024422#endif 
     423        
     424      IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') 
    1025425      !  
     426 
    1026427   END SUBROUTINE dia_wri_state 
    1027  
    1028428   !!====================================================================== 
    1029429END MODULE diawri 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r7330 r7352  
    2424   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces 
    2525   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases  
    26    USE diaar5, ONLY:   lk_diaar5 
    2726   USE diaptr 
    2827   ! 
    … …  
    733732      !       
    734733      ! 
    735       IF( lk_diaar5 .OR. ln_diaptr ) THEN                     !==  eiv heat transport: calculate and output  ==! 
    736          CALL wrk_alloc( jpi,jpj,   zw2d ) 
    737          ! 
    738          zztmp = 0.5_wp * rau0 * rcp  
    739          IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d')) THEN 
    740            zw2d(:,:) = 0._wp  
    741            zw3d(:,:,:) = 0._wp  
    742            DO jk = 1, jpkm1 
    743               DO jj = 2, jpjm1 
    744                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    745                     zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    746                        &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
    747                     zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    748                  END DO 
     734      CALL wrk_alloc( jpi,jpj,   zw2d ) 
     735      ! 
     736      zztmp = 0.5_wp * rau0 * rcp  
     737      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
     738        zw2d(:,:)   = 0._wp  
     739        zw3d(:,:,:) = 0._wp  
     740        DO jk = 1, jpkm1 
     741           DO jj = 2, jpjm1 
     742              DO ji = fs_2, fs_jpim1   ! vector opt. 
     743                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     744                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     745                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    749746              END DO 
    750747           END DO 
    751            CALL lbc_lnk( zw2d, 'U', -1. ) 
    752            CALL lbc_lnk( zw3d, 'U', -1. ) 
    753            CALL iom_put( "ueiv_heattr", zztmp * zw2d )                  ! heat transport in i-direction 
    754            CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
    755          ENDIF 
    756          zw2d(:,:) = 0._wp  
    757          zw3d(:,:,:) = 0._wp  
    758          DO jk = 1, jpkm1 
    759             DO jj = 2, jpjm1 
    760                DO ji = fs_2, fs_jpim1   ! vector opt. 
    761                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
    762                      &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) )  
    763                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    764                END DO 
    765             END DO 
    766          END DO 
    767          CALL lbc_lnk( zw2d, 'V', -1. ) 
    768          CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in i-direction 
    769          CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in i-direction 
    770          CALL dia_ptr_ohst_components( jp_tem, 'eiv', 0.5 * zw3d ) 
    771          ! 
    772          zztmp = 0.5_wp * 0.5 
    773          IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
    774            zw2d(:,:) = 0._wp  
    775            zw3d(:,:,:) = 0._wp  
    776            DO jk = 1, jpkm1 
    777               DO jj = 2, jpjm1 
    778                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    779                     zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    780                        &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
    781                     zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    782                  END DO 
     748        END DO 
     749        CALL lbc_lnk( zw2d, 'U', -1. ) 
     750        CALL lbc_lnk( zw3d, 'U', -1. ) 
     751        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
     752        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
     753      ENDIF 
     754      zw2d(:,:)   = 0._wp  
     755      zw3d(:,:,:) = 0._wp  
     756      DO jk = 1, jpkm1 
     757         DO jj = 2, jpjm1 
     758            DO ji = fs_2, fs_jpim1   ! vector opt. 
     759               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
     760                  &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) )  
     761               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     762            END DO 
     763         END DO 
     764      END DO 
     765      CALL lbc_lnk( zw2d, 'V', -1. ) 
     766      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
     767      CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction 
     768      ! 
     769      IF( ln_diaptr )  CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) 
     770      ! 
     771      zztmp = 0.5_wp * 0.5 
     772      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
     773        zw2d(:,:) = 0._wp  
     774        zw3d(:,:,:) = 0._wp  
     775        DO jk = 1, jpkm1 
     776           DO jj = 2, jpjm1 
     777              DO ji = fs_2, fs_jpim1   ! vector opt. 
     778                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     779                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
     780                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    783781              END DO 
    784782           END DO 
    785            CALL lbc_lnk( zw2d, 'U', -1. ) 
    786            CALL lbc_lnk( zw3d, 'U', -1. ) 
    787            CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    788            CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
    789          ENDIF 
    790          zw2d(:,:) = 0._wp  
    791          zw3d(:,:,:) = 0._wp  
    792          DO jk = 1, jpkm1 
    793             DO jj = 2, jpjm1 
    794                DO ji = fs_2, fs_jpim1   ! vector opt. 
    795                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
    796                      &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) )  
    797                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    798                END DO 
    799             END DO 
    800          END DO 
    801          CALL lbc_lnk( zw2d, 'V', -1. ) 
    802          CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 
    803          CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction 
    804          CALL dia_ptr_ohst_components( jp_sal, 'eiv', 0.5 * zw3d ) 
    805  
    806          CALL wrk_dealloc( jpi,jpj,   zw2d ) 
    807       ENDIF 
     783        END DO 
     784        CALL lbc_lnk( zw2d, 'U', -1. ) 
     785        CALL lbc_lnk( zw3d, 'U', -1. ) 
     786        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
     787        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
     788      ENDIF 
     789      zw2d(:,:) = 0._wp  
     790      zw3d(:,:,:) = 0._wp  
     791      DO jk = 1, jpkm1 
     792         DO jj = 2, jpjm1 
     793            DO ji = fs_2, fs_jpim1   ! vector opt. 
     794               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
     795                  &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) )  
     796               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     797            END DO 
     798         END DO 
     799      END DO 
     800      CALL lbc_lnk( zw2d, 'V', -1. ) 
     801      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 
     802      CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction 
     803      ! 
     804      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
     805      ! 
     806      CALL wrk_dealloc( jpi,jpj,   zw2d ) 
    808807      CALL wrk_dealloc( jpi,jpj,jpk,   zw3d ) 
    809808      ! 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r7236 r7352  
    1818   USE trdtra         ! trends manager: tracers  
    1919   USE diaptr         ! poleward transport diagnostics 
     20   USE diaar5         ! AR5 diagnostics 
    2021   ! 
    2122   USE in_out_manager ! I/O manager 
    … …  
    3233    
    3334   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
     35 
     36   LOGICAL :: l_trd   ! flag to compute trends 
     37   LOGICAL :: l_ptr   ! flag to compute poleward transport 
     38   LOGICAL :: l_hst   ! flag to compute heat/salt transport 
    3439 
    3540   !! * Substitutions 
    … …  
    8893      ENDIF 
    8994      ! 
     95      l_trd = .FALSE. 
     96      l_hst = .FALSE. 
     97      l_ptr = .FALSE. 
     98      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )        l_trd = .TRUE. 
     99      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE.  
     100      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     101         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     102      ! 
    90103      !                     
    91104      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers 
    … …  
    184197         END DO 
    185198         !                             ! trend diagnostics 
    186          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 
     199         IF( l_trd ) THEN 
    187200            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    188201            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    189202            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    190203         END IF 
    191          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    192          IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
     204         !                                 ! "Poleward" heat and salt transports  
     205         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     206         !                                 !  heat and salt transport 
     207         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
    193208         ! 
    194209      END DO 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7330 r7352  
    2020   USE trdtra         ! tracers trends 
    2121   USE diaptr         ! poleward transport diagnostics 
     22   USE diaar5         ! AR5 diagnostics 
    2223   USE phycst, ONLY: rau0_rcp 
    2324   ! 
    … …  
    3839 
    3940   LOGICAL  ::   l_trd   ! flag to compute trends 
    40    LOGICAL  ::   l_trans   ! flag to output vertically integrated transports 
     41   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     42   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport 
    4143   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    4244 
    … …  
    98100      ! 
    99101      l_trd = .FALSE. 
    100       l_trans = .FALSE. 
    101       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    102       IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
    103       ! 
    104       IF( l_trd .OR. l_trans )  THEN 
     102      l_hst = .FALSE. 
     103      l_ptr = .FALSE. 
     104      IF( ( cdtype == 'TRA'   .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )     l_trd = .TRUE. 
     105      IF(   cdtype == 'TRA'   .AND. ln_diaptr )                                              l_ptr = .TRUE.  
     106      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     107         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     108      ! 
     109      IF( l_trd .OR. l_hst )  THEN 
    105110         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    106111         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
    107112      ENDIF 
    108113      ! 
    109       IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     114      IF( l_ptr ) THEN   
    110115         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
    111116         zptry(:,:,:) = 0._wp 
    … …  
    171176         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign) 
    172177         !                 
    173          IF( l_trd .OR. l_trans )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
     178         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    174179            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
    175180         END IF 
    176181         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    177          IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
     182         IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
    178183         ! 
    179184         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    299304         END DO 
    300305         ! 
    301          IF( l_trd .OR. l_trans ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
     306         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    302307            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    303308            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    … …  
    311316            ! 
    312317         END IF 
    313  
    314          IF( l_trans .AND. jn==jp_tem ) THEN 
    315             CALL wrk_alloc( jpi, jpj, z2d ) 
    316             z2d(:,:) = 0._wp  
    317             DO jk = 1, jpkm1 
    318                DO jj = 2, jpjm1 
    319                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    320                      z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
    321                   END DO 
    322                END DO 
    323             END DO 
    324             CALL lbc_lnk( z2d, 'U', -1. ) 
    325             CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
    326               ! 
    327             z2d(:,:) = 0._wp  
    328             DO jk = 1, jpkm1 
    329                DO jj = 2, jpjm1 
    330                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    331                      z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
    332                   END DO 
    333                END DO 
    334             END DO 
    335             CALL lbc_lnk( z2d, 'V', -1. ) 
    336             CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
    337             CALL wrk_dealloc( jpi, jpj, z2d ) 
     318         !                                !  heat/salt transport 
     319         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     320 
     321         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     322         IF( l_ptr ) THEN   
     323            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     324            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    338325         ENDIF 
    339          ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    340          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    341             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    342             CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    343          ENDIF 
    344326         ! 
    345327      END DO                     ! end of tracer loop 
    346328      ! 
    347       CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
    348       IF( l_trd .OR. l_trans )  THEN  
    349          CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    350       ENDIF 
    351       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
     329                              CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     330      IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     331      IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    352332      ! 
    353333      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct') 
    … …  
    412392      ! 
    413393      l_trd = .FALSE. 
    414       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    415       ! 
    416       IF( l_trd )  THEN 
     394      l_hst = .FALSE. 
     395      l_ptr = .FALSE. 
     396      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     397      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
     398      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     399         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
     400      ! 
     401      IF( l_trd .OR. l_hst )  THEN 
    417402         CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
    418403         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
    419404      ENDIF 
    420405      ! 
    421       IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     406      IF( l_ptr ) THEN   
    422407         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
    423408         zptry(:,:,:) = 0._wp 
    … …  
    488473         CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign) 
    489474         !                 
    490          IF( l_trd )  THEN                ! trend diagnostics (contribution of upstream fluxes) 
     475         IF( l_trd .OR. l_hst )  THEN                ! trend diagnostics (contribution of upstream fluxes) 
    491476            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    492477         END IF 
    493478         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    494          IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
     479         IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:) 
    495480 
    496481         ! 3. anti-diffusive flux : high order minus low order 
    … …  
    608593         END DO 
    609594 
    610          !                                 ! trend diagnostics (contribution of upstream fluxes) 
    611          IF( l_trd )  THEN  
     595        ! 
     596         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    612597            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    613598            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    614599            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    615             ! 
    616             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    617             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    618             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    619             ! 
    620             CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
     600         ENDIF 
     601            ! 
     602         IF( l_trd ) THEN  
     603            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     604            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     605            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
     606            ! 
    621607         END IF 
    622          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    623          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    624             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
    625             CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
     608         !                                             ! heat/salt transport 
     609         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     610 
     611         !                                            ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     612         IF( l_ptr ) THEN   
     613            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     614            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    626615         ENDIF 
    627616         ! 
    628617      END DO 
    629618      ! 
    630       CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    631       CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    632       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    633       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
     619                              CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
     620                              CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
     621                              CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
     622      IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     623      IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    634624      ! 
    635625      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts') 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r7236 r7352  
    2323   USE sbcrnf         ! river runoffs 
    2424   USE diaptr         ! poleward transport diagnostics 
     25   USE diaar5         ! AR5 diagnostics 
     26 
    2527   ! 
     28   USE iom 
    2629   USE wrk_nemo       ! Memory Allocation 
    2730   USE timing         ! Timing 
    … …  
    4043   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
    4144    
     45   LOGICAL  ::   l_trd   ! flag to compute trends 
     46   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     47   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport 
     48 
    4249   !! * Substitutions 
    4350#  include "vectopt_loop_substitute.h90" 
    … …  
    116123      ENDIF  
    117124      !       
     125      l_trd = .FALSE. 
     126      l_hst = .FALSE. 
     127      l_ptr = .FALSE. 
     128      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     129      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
     130      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     131         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
     132      ! 
    118133      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
    119134         ! 
    … …  
    192207         END DO         
    193208         !                                ! trend diagnostics 
    194          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   & 
    195             &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN 
     209         IF( l_trd )  THEN 
    196210            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 
    197211            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
    198212         END IF 
    199          !                                 ! "Poleward" heat and salt transports 
    200          IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    201          !                                ! "Poleward" heat and salt transports 
     213         !                                 ! "Poleward" heat and salt transports  
     214         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     215         !                                 !  heat transport 
     216         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
    202217         ! 
    203218         !                          !* Vertical advective fluxes 
    … …  
    260275         END DO 
    261276         !                                ! send trends for diagnostic 
    262          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     & 
    263             &( cdtype == 'TRC' .AND. l_trdtrc )      )   & 
    264             CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
     277         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
    265278         ! 
    266279      END DO                     ! end of tracer loop 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r7236 r7352  
    3434   PUBLIC   tra_adv_qck   ! routine called by step.F90 
    3535 
    36    LOGICAL  :: l_trd           ! flag to compute trends 
    3736   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio 
     37 
     38   LOGICAL  ::   l_trd   ! flag to compute trends 
     39   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     40 
    3841 
    3942   !! * Substitutions 
    … …  
    103106      ! 
    104107      l_trd = .FALSE. 
    105       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
     108      l_ptr = .FALSE. 
     109      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     110      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
     111      ! 
    106112      ! 
    107113      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    … …  
    224230         END DO 
    225231         !                                 ! trend diagnostics 
    226          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     232         IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    227233         ! 
    228234      END DO 
    … …  
    347353         END DO 
    348354         !                                 ! trend diagnostics 
    349          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     355         IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    350356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    351          IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
     357         IF( l_ptr )                     CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    352358         ! 
    353359      END DO 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r7236 r7352  
    1919   USE trdtra         ! trends manager: tracers  
    2020   USE diaptr         ! poleward transport diagnostics 
     21   USE diaar5         ! AR5 diagnostics 
     22 
    2123   ! 
     24   USE iom 
    2225   USE lib_mpp        ! I/O library 
    2326   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    … …  
    3235   PUBLIC   tra_adv_ubs   ! routine called by traadv module 
    3336 
    34    LOGICAL :: l_trd  ! flag to compute trends or not 
     37   LOGICAL :: l_trd   ! flag to compute trends 
     38   LOGICAL :: l_ptr   ! flag to compute poleward transport 
     39   LOGICAL :: l_hst   ! flag to compute heat transport 
     40 
    3541 
    3642   !! * Substitutions 
    … …  
    109115      ! 
    110116      l_trd = .FALSE. 
    111       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     117      l_hst = .FALSE. 
     118      l_ptr = .FALSE. 
     119      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     120      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
     121      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     122         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
    112123      ! 
    113124      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers 
    … …  
    176187             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 
    177188         END IF 
    178          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 
     189         !      
     190         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     191         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) ) 
     192         !                                !  heati/salt transport 
     193         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) ) 
     194         ! 
    180195         ! 
    181196         !                       !== vertical advective trend  ==! 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r7236 r7352  
    2424   USE ldfslp         ! iso-neutral slopes 
    2525   USE diaptr         ! poleward transport diagnostics 
     26   USE diaar5         ! AR5 diagnostics 
    2627   ! 
    2728   USE in_out_manager ! I/O manager 
    … …  
    3637 
    3738   PUBLIC   tra_ldf_iso   ! routine called by step.F90 
     39 
     40   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     41   LOGICAL  ::   l_hst   ! flag to compute heat transport 
    3842 
    3943   !! * Substitutions 
    … …  
    107111      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    108112      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
    109 #if defined key_diaar5 
    110       REAL(wp) ::   zztmp   ! local scalar 
    111 #endif 
    112113      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
    113114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    … …  
    127128         ah_wslp2(:,:,:) = 0._wp 
    128129      ENDIF 
    129       !                                               ! set time step size (Euler/Leapfrog) 
     130      !    
     131      l_hst = .FALSE. 
     132      l_ptr = .FALSE. 
     133      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE.  
     134      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     135         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     136      ! 
     137      !                                            ! set time step size (Euler/Leapfrog) 
    130138      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler) 
    131139      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog) 
    … …  
    369377            ! 
    370378            !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    371                ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    372             IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    373             ! 
    374             IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
    375               ! 
    376               IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    377                   z2d(:,:) = zftu(ji,jj,1)  
    378                   DO jk = 2, jpkm1 
    379                      DO jj = 2, jpjm1 
    380                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    381                            z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
    382                         END DO 
    383                      END DO 
    384                   END DO 
    385 !!gm CAUTION I think there is an error of sign when using BLP operator.... 
    386 !!gm         a multiplication by zsign is required (to be checked twice !) 
    387                   z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    388                   CALL lbc_lnk( z2d, 'U', -1. ) 
    389                   CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    390                   ! 
    391                   z2d(:,:) = zftv(ji,jj,1)  
    392                   DO jk = 2, jpkm1 
    393                      DO jj = 2, jpjm1 
    394                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    395                            z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
    396                         END DO 
    397                      END DO 
    398                   END DO 
    399                   z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    400                   CALL lbc_lnk( z2d, 'V', -1. ) 
    401                   CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    402                END IF 
    403                ! 
    404             ENDIF 
     379               ! note sign is reversed to give down-gradient diffusive transports ) 
     380            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:)  ) 
     381            !                          ! Diffusive heat transports 
     382            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 
    405383            ! 
    406384         ENDIF                                                    !== end pass selection  ==! 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90

    r7236 r7352  
    1717   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine) 
    1818   USE diaptr         ! poleward transport diagnostics 
     19   USE diaar5         ! AR5 diagnostics 
    1920   USE trc_oce        ! share passive tracers/Ocean variables 
    2021   USE zpshde         ! partial step: hor. derivative     (zps_hde routine) 
    … …  
    2526   USE timing         ! Timing 
    2627   USE wrk_nemo       ! Memory allocation 
     28   USE iom 
    2729 
    2830   IMPLICIT NONE 
    … …  
    3941   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator 
    4042   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator 
     43 
     44   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     45   LOGICAL  ::   l_hst   ! flag to compute heat transport 
    4146 
    4247   !! * Substitutions 
    … …  
    95100      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    96101      ! 
     102      l_hst = .FALSE. 
     103      l_ptr = .FALSE. 
     104      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE.  
     105      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     106         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     107      ! 
    97108      !                                !==  Initialization of metric arrays used for all tracers  ==! 
    98109      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    … …  
    150161         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==! 
    151162             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==! 
    152             IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', -ztv(:,:,:) ) 
     163 
     164            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:)  ) 
     165            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) ) 
    153166         ENDIF 
    154167         !                          ! ================== 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r7236 r7352  
    2020   USE traldf_iso     ! lateral diffusion (Madec operator)         (tra_ldf_iso routine) 
    2121   USE diaptr         ! poleward transport diagnostics 
     22   USE diaar5         ! AR5 diagnostics 
    2223   USE zpshde         ! partial step: hor. derivative     (zps_hde routine) 
    2324   ! 
    … …  
    3536 
    3637   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels 
     38 
     39   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
     40   LOGICAL  ::   l_hst   ! flag to compute heat transport 
     41 
    3742 
    3843   !! * Substitutions 
    … …  
    8994      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    9095      REAL(wp) ::   zah, zah_slp, zaei_slp 
    91 #if defined key_diaar5 
    92       REAL(wp) ::   zztmp              ! local scalar 
    93 #endif 
    9496      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace 
    9597      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    … …  
    112114         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    113115      ENDIF 
    114       !                                               ! set time step size (Euler/Leapfrog) 
     116      !    
     117      l_hst = .FALSE. 
     118      l_ptr = .FALSE. 
     119      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE.  
     120      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     121         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     122      ! 
     123      !                                                        ! set time step size (Euler/Leapfrog) 
    115124      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler) 
    116125      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog) 
    … …  
    416425            ! 
    417426            !                          ! "Poleward" diffusive heat or salt transports (T-S case only) 
    418             IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 
    419             ! 
    420             IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
    421               ! 
    422               IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    423                   z2d(:,:) = zftu(ji,jj,1)  
    424                   DO jk = 2, jpkm1 
    425                      DO jj = 2, jpjm1 
    426                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    427                            z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
    428                         END DO 
    429                      END DO 
    430                   END DO 
    431                   z2d(:,:) = rau0_rcp * z2d(:,:)  
    432                   CALL lbc_lnk( z2d, 'U', -1. ) 
    433                   CALL iom_put( "udiff_heattr", z2d )                  ! heat i-transport 
    434                   ! 
    435                   z2d(:,:) = zftv(ji,jj,1)  
    436                   DO jk = 2, jpkm1 
    437                      DO jj = 2, jpjm1 
    438                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    439                            z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
    440                         END DO 
    441                      END DO 
    442                   END DO 
    443                   z2d(:,:) = rau0_rcp * z2d(:,:)      
    444                   CALL lbc_lnk( z2d, 'V', -1. ) 
    445                   CALL iom_put( "vdiff_heattr", z2d )                  !  heat j-transport 
    446                ENDIF 
    447                ! 
    448             ENDIF 
     427            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:)  ) 
     428            !                          ! Diffusive heat transports 
     429            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) ) 
    449430            ! 
    450431         ENDIF                                                    !== end pass selection  ==! 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6152 r7352  
    490490      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    491491                            CALL dia_cfl_init   ! Initialise CFL diagnostics 
    492       IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    493492                            CALL dia_ptr_init   ! Poleward TRansports initialization 
    494493      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6464 r7352  
    234234      IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    235235      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    236       IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 
     236                         CALL dia_ar5( kstp )         ! ar5 diag 
    237237      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    238238                         CALL dia_wri( kstp )         ! ocean model: outputs 

  • branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5836 r7352  
    114114   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
    115115 
    116    USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5 
    117116#else 
    118117   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.