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 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    • Property svn:eol-style deleted
    r1537 r2528  
    88   !!   NEMO     1.0  ! 2002-06  (G. Madec)  free form F90 
    99   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90 
     10   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    1011   !!---------------------------------------------------------------------- 
    1112 
     
    1617   USE dom_oce         ! ocean space and time domain 
    1718   USE zdf_oce         ! ocean vertical physics 
    18    USE trdmod          ! ocean active tracer trends 
    19    USE trdmod_oce      ! ocean variables trends 
     19   USE trdmod_oce      ! ocean active tracer trends 
     20   USE trdtra      ! ocean active tracer trends 
    2021   USE eosbn2          ! equation of state (eos routine)  
    2122   USE lbclnk          ! lateral boundary conditions (or mpp link) 
     
    3031#  include "domzgr_substitute.h90" 
    3132   !!---------------------------------------------------------------------- 
    32    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     33   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3334   !! $Id$  
    34    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    35    !!---------------------------------------------------------------------- 
    36  
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3737CONTAINS 
    3838 
     
    5555      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5656      !!---------------------------------------------------------------------- 
    57       USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace    
    58       USE oce, ONLY :    ztrds => va   ! use va as 3D workspace    
    59       !!  
    6057      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6158      !! 
     
    6865      REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays 
    6966      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays 
     67      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    7068      !!---------------------------------------------------------------------- 
    7169 
     
    7573         inpci = 0 
    7674 
    77          CALL eos( ta, sa, rhd, zrhop )         ! Potential density 
    78  
    79  
    80          IF( l_trdtra )   THEN                  ! Save ta and sa trends 
    81             ztrdt(:,:,:) = ta(:,:,:)  
    82             ztrds(:,:,:) = sa(:,:,:)  
     75         CALL eos( tsa, rhd, zrhop )         ! Potential density 
     76 
     77         IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     78            ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
     79            ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    8380         ENDIF 
    8481 
     
    133130                  IF( zwy(ji,1) /= 0.e0 ) THEN 
    134131                     ! 
    135                      ikbot = mbathy(ji,jj)      ! ikbot: ocean bottom level 
     132                     ikbot = mbkt(ji,jj)        ! ikbot: ocean bottom T-level 
    136133                     ! 
    137134                     DO jiter = 1, jpk          ! vertical iteration 
     
    142139220                     CONTINUE 
    143140                        ik = ik + 1 
    144                         IF( ik >= ikbot-1 ) GO TO 200 
     141                        IF( ik >= ikbot ) GO TO 200 
    145142                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1) 
    146143                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220 
     
    151148                        ! 
    152149                        ze3tot= fse3t(ji,jj,ikup) 
    153                         zta   = ta   (ji,jj,ikup) 
    154                         zsa   = sa   (ji,jj,ikup) 
     150                        zta   = tsa  (ji,jj,ikup,jp_tem) 
     151                        zsa   = tsa  (ji,jj,ikup,jp_sal) 
    155152                        zraua = zrhop(ji,jj,ikup) 
    156153                        ! 
     
    162159                           ze3dwn =  fse3t(ji,jj,jkdown) 
    163160                           ze3tot =  ze3tot + ze3dwn 
    164                            zta   = ( zta*(ze3tot-ze3dwn) + ta(ji,jj,jkdown)*ze3dwn )/ze3tot 
    165                            zsa   = ( zsa*(ze3tot-ze3dwn) + sa(ji,jj,jkdown)*ze3dwn )/ze3tot 
     161                           zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot 
     162                           zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot 
    166163                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot 
    167164                           inpci = inpci+1 
     
    171168                        ! 
    172169                        DO jkp = ikup, ikdown-1 
    173                            ta(ji,jj,jkp) = zta 
    174                            sa(ji,jj,jkp) = zsa 
    175                            zrhop(ji,jj,jkp) = zraua 
     170                           tsa  (ji,jj,jkp,jp_tem) = zta 
     171                           tsa  (ji,jj,jkp,jp_sal) = zsa 
     172                           zrhop(ji,jj,jkp       ) = zraua 
    176173                        END DO 
    177174                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN 
    178                            ta(ji,jj,ikdown) = zta 
    179                            sa(ji,jj,ikdown) = zsa 
    180                            zrhop(ji,jj,ikdown) = zraua 
     175                           tsa  (ji,jj,jkp,jp_tem) = zta 
     176                           tsa  (ji,jj,jkp,jp_sal) = zsa 
     177                           zrhop(ji,jj,ikdown    ) = zraua 
    181178                        ENDIF 
    182179                     END DO 
     
    191188         !  
    192189         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic 
    193             ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    194             ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    195             CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt) 
     190            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     191            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     192            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt ) 
     193            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds ) 
     194            DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )  
    196195         ENDIF 
    197196       
    198197         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign) 
    199198         ! ------------------------------============ 
    200          CALL lbc_lnk( ta, 'T', 1. ) 
    201          CALL lbc_lnk( sa, 'T', 1. ) 
     199         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
     200         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    202201       
    203202 
Note: See TracChangeset for help on using the changeset viewer.