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

Changeset 1485


Ignore:
Timestamp:
2009-07-06T14:58:27+02:00 (15 years ago)
Author:
smasson
Message:

clean 20d, 28d and depth of the thermocline, see ticket:468

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DIA/diahth.F90

    r1484 r1485  
    44   !! Ocean diagnostics: thermocline and 20 degree depth 
    55   !!====================================================================== 
     6   !! History :  OPA  !  1994-09  (J.-P. Boulanger)  Original code 
     7   !!                 !  1996-11  (E. Guilyardi)  OPA8  
     8   !!                 !  1997-08  (G. Madec)  optimization 
     9   !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content  
     10   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module 
     11   !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning 
     12   !!---------------------------------------------------------------------- 
     13 
    614#if   defined key_diahth   ||   defined key_esopa 
    715   !!---------------------------------------------------------------------- 
     
    3442#  include "domzgr_substitute.h90" 
    3543   !!---------------------------------------------------------------------- 
    36    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     44   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    3745   !! $Id$  
    38    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3947   !!---------------------------------------------------------------------- 
    4048 
     
    5361      !! ** Method :  
    5462      !! 
    55       !! History : 
    56       !!        !  94-09  (J.-P. Boulanger)  Original code 
    57       !!        !  96-11  (E. Guilyardi)  OPA8  
    58       !!        !  97-08  (G. Madec)  optimization 
    59       !!        !  99-07  (E. Guilyardi)  hd28 + heat content  
    60       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    6163      !!------------------------------------------------------------------- 
    62       !! * Arguments 
    6364      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    64  
    65       !! * Local declarations 
    66       INTEGER :: ji, jj, jk         ! dummy loop arguments 
    67       INTEGER :: iid, iif, ilevel   ! temporary integers 
    68       INTEGER, DIMENSION(jpi) ::   idepth 
    69       INTEGER, DIMENSION(jpi,jpj) ::   ikc 
    70  
    71       REAL(wp) :: zd, zmoy, zthick_0, zcoef              ! temporary scalars 
    72       REAL(wp), DIMENSION(jpi) ::   zmax 
    73       REAL(wp), DIMENSION(jpi,jpj) ::   zthick 
    74       REAL(wp), DIMENSION(jpi,jpk) ::   zdzt 
     65      !! 
     66      INTEGER                          ::   ji, jj, jk            ! dummy loop arguments 
     67      INTEGER                          ::   iid, iif, ilevel      ! temporary integers 
     68      INTEGER, DIMENSION(jpi,jpj)      ::   ikc                   ! levels 
     69      REAL(wp)                         ::   zd, zthick_0, zcoef   ! temporary scalars 
     70      REAL(wp), DIMENSION(jpi,jpj)     ::   zthick 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzt 
    7572      !!---------------------------------------------------------------------- 
    7673 
     
    8279      ENDIF 
    8380 
    84  
    8581      ! -------------------------- ! 
    8682      !  Depth of the thermocline  ! 
     
    8884      ! The depth of the thermocline is defined as the depth of the  
    8985      ! strongest vertical temperature gradient 
    90        
     86      zdzt(:,:,1) = 0.e0 
     87      DO jk = 2, jpk                      ! vertical gradient of temperature 
     88         zdzt(:,:,jk) = ( tn(:,:,jk-1) - tn(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     89      END DO 
    9190      DO jj = 1, jpj 
    92           
    93          ! vertical gradient of temperature 
    94          DO jk = 2, jpkm1 
    95             zdzt(:,jk) = ( tn(:,jj,jk-1) - tn(:,jj,jk) ) / fse3w(:,jj,jk) * tmask(:,jj,jk) 
    96          END DO 
    97           
    98          ! search the level of maximum vertical temperature gradient 
    99          zmax  (:) = 0.e0 
    100          idepth(:) = 1 
    101          DO jk = jpkm1, 2, -1 
    102             DO ji = 1, jpi 
    103                IF( zdzt(ji,jk) > zmax(ji) ) THEN 
    104                   zmax  (ji) = zdzt(ji,jk) 
    105                   idepth(ji) = jk 
    106                ENDIF 
    107             END DO 
    108          END DO 
     91         DO ji = 1, jpi 
     92            ilevel = MAXLOC( zdzt(ji,jj,:), dim= 1 )      ! level of maximum vertical temperature gradient 
     93            hth(ji,jj) = fsdepw(ji,jj,ilevel)             ! depth of the thermocline 
     94         END DO          
     95      END DO 
    10996 
    110          ! depth of the thermocline 
    111          DO ji = 1, jpi 
    112             hth(ji,jj) = fsdepw(ji,jj,idepth(ji)) 
    113          END DO 
    114           
    115       END DO 
    116       CALL iom_put( "thermod", hth )   ! depth of the thermocline 
    117  
     97      CALL iom_put( "thermod", hth )      ! depth of the thermocline 
    11898 
    11999      ! ----------------------- ! 
    120100      !  Depth of 20C isotherm  ! 
    121101      ! ----------------------- ! 
    122  
    123       ! initialization to the number of ocean w-point mbathy 
    124       ! (cf dommsk, minimum value: 1) 
    125       ikc(:,:) = 1 
    126  
    127       ! search the depth of 20 degrees isotherm 
    128       ! ( starting from the top, last level above 20C, if not exist, = 1) 
    129       DO jk = 1, jpkm1 
    130          DO jj = 1, jpj 
    131             DO ji = 1, jpi 
    132                IF( tn(ji,jj,jk) >= 20. ) ikc(ji,jj) = jk 
    133             END DO 
     102       
     103      ! search last level above 20C 
     104      ikc(:,:) = COUNT( tn >= 20., dim = 3 ) 
     105      ! Depth of 20C isotherm, linear interpolation 
     106      DO jj = 1, jpj 
     107         DO ji = 1, jpi 
     108            iid = MAX(1, ikc(ji,jj)) 
     109            zd = fsdept(ji,jj,iid) + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                           )   & 
     110               &                   * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                           )   & 
     111               &                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) 
     112            ! bound by the ocean depth, minimum value, first T-point depth 
     113            iif = mbathy(ji,jj) 
     114            hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 
    134115         END DO 
    135116      END DO 
    136        
    137       ! Depth of 20C isotherm 
    138       DO jj = 1, jpj 
    139          DO ji = 1, jpi 
    140             iid = ikc(ji,jj) 
    141             iif = mbathy(ji,jj) 
    142             IF( iid /= 1 ) THEN  
    143                ! linear interpolation 
    144                zd =  fsdept(ji,jj,iid)   & 
    145                   + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   & 
    146                   * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   & 
    147                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    & 
    148                   + (1.-tmask(ji,jj,1))                       ) 
    149                ! bound by the ocean depth, minimum value, first T-point depth 
    150                hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif)) 
    151             ELSE  
    152                hd20(ji,jj)=0. 
    153             ENDIF 
    154          END DO 
    155       END DO 
    156       CALL iom_put( "20d", hd20 )   ! depth of the 20 isotherm 
     117      WHERE(ikc == 0 )   hd20 = 0.e0 
     118      CALL iom_put( "20d", hd20 )         ! depth of the 20 isotherm 
    157119 
    158120      ! ----------------------- ! 
     
    160122      ! ----------------------- ! 
    161123       
    162       ! initialization to the number of ocean w-point mbathy 
    163       ! (cf dommsk, minimum value: 1) 
    164       ikc(:,:) = 1 
    165        
    166       ! search the depth of 28 degrees isotherm 
    167       ! ( starting from the top, last level above 28C, if not exist, = 1) 
    168       DO jk = 1, jpkm1 
    169          DO jj = 1, jpj 
    170             DO ji = 1, jpi 
    171                IF( tn(ji,jj,jk) >= 28. ) ikc(ji,jj) = jk 
    172             END DO 
     124      ! search last level above 28C 
     125      ikc(:,:) = COUNT( tn >= 28., dim = 3 ) 
     126      ! Depth of 28C isotherm, linear interpolation 
     127      DO jj = 1, jpj 
     128         DO ji = 1, jpi 
     129            iid = MAX(1, ikc(ji,jj)) 
     130            zd = fsdept(ji,jj,iid) + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                           )   & 
     131               &                   * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                           )   & 
     132               &                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) 
     133            ! bound by the ocean depth, minimum value, first T-point depth 
     134            iif = mbathy(ji,jj) 
     135            hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 
    173136         END DO 
    174137      END DO 
    175        
    176       ! Depth of 28C isotherm 
    177       DO jj = 1, jpj 
    178          DO ji = 1, jpi 
    179             iid = ikc(ji,jj) 
    180             iif = mbathy(ji,jj) 
    181             IF( iid /= 1 ) THEN  
    182                ! linear interpolation 
    183                zd =  fsdept(ji,jj,iid)   & 
    184                   + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   & 
    185                   * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   & 
    186                   / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    & 
    187                   + ( 1. - tmask(ji,jj,1) )  ) 
    188                ! bound by the ocean depth, minimum value, first T-point depth 
    189                hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 
    190             ELSE  
    191                hd28(ji,jj) = 0. 
    192             ENDIF 
    193          END DO 
    194       END DO 
    195       CALL iom_put( "28d", hd28 )   ! depth of the 28 isotherm 
     138      WHERE(ikc == 0 )   hd28 = 0.e0 
     139      CALL iom_put( "28d", hd28 )         ! depth of the 28 isotherm 
    196140 
    197       ! ----------------------------------------- ! 
    198       !  Heat content of first 300 m (18 levels) ! 
    199       ! ----------------------------------------- ! 
     141      ! ----------------------------- ! 
     142      !  Heat content of first 300 m ! 
     143      ! ----------------------------- ! 
    200144 
    201145      ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...) 
     
    221165      zcoef = rau0 * rcp 
    222166      htc3(:,:) = zcoef * htc3(:,:) 
    223       CALL iom_put( "hc300", htc3 )   ! first 300m heaat content 
     167      CALL iom_put( "hc300", htc3 )      ! first 300m heaat content 
     168 
    224169 
    225170   END SUBROUTINE dia_hth 
Note: See TracChangeset for help on using the changeset viewer.