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 2082 for branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90 – NEMO

Ignore:
Timestamp:
2010-09-10T12:32:58+02:00 (14 years ago)
Author:
cetlod
Message:

Improve the merge of TRA-TRC, see ticket #717

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90

    r2024 r2082  
    1414   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last 
    1515   !!                   ocean level (Z-coord. with Partial Steps) 
    16    !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last 
    17    !!                   ocean level (Z-coord. with Partial Steps) 
    1816   !!---------------------------------------------------------------------- 
    1917   !! * Modules used 
     
    3129   PUBLIC zps_hde          ! routine called by step.F90 
    3230   PUBLIC zps_hde_init     ! routine called by opa.F90 
    33 #if defined key_top 
    34    PUBLIC zps_hde_trc  
    35 #endif 
    3631 
    3732   !! * module variables 
     
    4944   !!---------------------------------------------------------------------- 
    5045CONTAINS 
    51    SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   & 
    52                             pgtu, pgsu, pgru,   & 
    53                             pgtv, pgsv, pgrv  ) 
     46 
     47   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   & 
     48                                 prd, pgru, pgrv    ) 
    5449      !!---------------------------------------------------------------------- 
    5550      !!                     ***  ROUTINE zps_hde  *** 
     
    9186      !!          di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~ 
    9287      !! 
    93       !! ** Action  : - pgtu, pgsu, pgru: horizontal gradient of T, S 
    94       !!                and rd at U-points  
    95       !!              - pgtv, pgsv, pgrv: horizontal gradient of T, S 
     88      !! ** Action  : - pgtu, pgtv: horizontal gradient of tracer at U/V-points 
     89      !!              - pgru, pgrv: horizontal gradient of rd if present at U/V-points  
    9690      !!                and rd at V-points  
    9791      !!---------------------------------------------------------------------- 
    9892      !! * Arguments 
    99       INTEGER, INTENT( in ) ::   kt ! ocean time-step index 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in )  :: ptem, psal, prd  ! 3D T, S and rd fields 
    101       REAL(wp), DIMENSION(jpi,jpj)    , INTENT( out ) :: pgtu, pgsu, pgru !  horizontal grad. of T, S and rd at u-point  
    102       REAL(wp), DIMENSION(jpi,jpj)    , INTENT( out ) :: pgtv, pgsv, pgrv !  horizontal grad. of T, S and rd at v-point  
    103       !! * Local declarations 
    104       INTEGER ::   ji , jj          ! Dummy loop indices 
    105       INTEGER ::   iku, ikv         ! partial step level at u- and v-points 
    106       REAL(wp), DIMENSION(jpi,jpj) ::   zti, ztj, zsi, zsj   ! interpolated value of T, S 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   zri, zrj             ! interpolated value of rd 
    108       REAL(wp), DIMENSION(jpi,jpj) ::   zhgi, zhgj           ! depth of interpolation for eos2d 
    109       REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv                 ! temporary scalars 
    110  
    111  
    112       ! Interpolation of T and S at the last ocean level 
    113 # if defined key_vectopt_loop 
    114          jj = 1 
    115          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    116 # else 
    117       DO jj = 1, jpjm1 
    118          DO ji = 1, jpim1 
    119 # endif 
    120             ! last level 
    121             iku = mbatu(ji,jj) 
    122             ikv = mbatv(ji,jj) 
    123             ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    124             ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
    125  
    126             ! i- direction 
    127             IF( ze3wu >= 0. ) THEN      ! case 1 
    128                ! interpolated values of T and S 
    129                zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
    130                zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) ) 
    131                zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) ) 
    132                ! depth of the partial step level 
    133                zhgi(ji,jj) = fsdept(ji,jj,iku) 
    134                ! gradient of T and S 
    135                pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) ) 
    136                pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) ) 
    137  
    138             ELSE                        ! case 2 
    139                ! interpolated values of T and S 
    140                zmaxu =  -ze3wu / fse3w(ji,jj,iku) 
    141                zti(ji,jj) = ptem(ji,jj,iku) + zmaxu * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) ) 
    142                zsi(ji,jj) = psal(ji,jj,iku) + zmaxu * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) ) 
    143                ! depth of the partial step level 
    144                zhgi(ji,jj) = fsdept(ji+1,jj,iku) 
    145                ! gradient of T and S  
    146                pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) ) 
    147                pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) ) 
    148             ENDIF 
    149  
    150             ! j- direction 
    151             IF( ze3wv >= 0. ) THEN      ! case 1 
    152                ! interpolated values of T and S 
    153                zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
    154                ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) ) 
    155                zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) ) 
    156                ! depth of the partial step level 
    157                zhgj(ji,jj) = fsdept(ji,jj,ikv)  
    158                ! gradient of T and S 
    159                pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) ) 
    160                pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) ) 
    161  
    162             ELSE                        ! case 2 
    163                ! interpolated values of T and S 
    164                zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
    165                ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) ) 
    166                zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) )  
    167                ! depth of the partial step level 
    168                zhgj(ji,jj) = fsdept(ji,jj+1,ikv)  
    169                ! gradient of T and S 
    170                pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) ) 
    171                pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) ) 
    172             ENDIF 
    173 # if ! defined key_vectopt_loop 
    174          END DO 
    175 # endif 
    176       END DO 
    177  
    178       ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial 
    179       ! step and store it in  zri, zrj for each  case 
    180       CALL eos( zti, zsi, zhgi, zri ) 
    181       CALL eos( ztj, zsj, zhgj, zrj ) 
    182  
    183  
    184       ! Gradient of density at the last level  
    185 # if defined key_vectopt_loop 
    186          jj = 1 
    187          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    188 # else 
    189       DO jj = 1, jpjm1 
    190          DO ji = 1, jpim1 
    191 # endif 
    192             iku = mbatu(ji,jj) 
    193             ikv = mbatv(ji,jj) 
    194             ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    195             ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
    196             IF( ze3wu >= 0. ) THEN    ! i-direction: case 1 
    197                pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 
    198             ELSE                      ! i-direction: case 2 
    199                pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 
    200             ENDIF 
    201             IF( ze3wv >= 0. ) THEN    ! j-direction: case 1 
    202                pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) )   
    203             ELSE                      ! j-direction: case 2 
    204                pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 
    205             ENDIF 
    206 # if ! defined key_vectopt_loop 
    207          END DO 
    208 # endif 
    209       END DO 
    210  
    211       ! Lateral boundary conditions on each gradient 
    212       CALL lbc_lnk( pgtu , 'U', -1. )   ;   CALL lbc_lnk( pgtv , 'V', -1. ) 
    213       CALL lbc_lnk( pgsu , 'U', -1. )   ;   CALL lbc_lnk( pgsv , 'V', -1. ) 
    214       CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. ) 
    215  
    216    END SUBROUTINE zps_hde 
    217  
    218 #if defined key_top 
    219    !!---------------------------------------------------------------------- 
    220    !!   'key_top'                                                TOP models 
    221    !!---------------------------------------------------------------------- 
    222    SUBROUTINE zps_hde_trc ( kt, kjpt, ptra, pgtru, pgtrv ) 
    223       !!---------------------------------------------------------------------- 
    224       !!                     ***  ROUTINE zps_hde_trc  *** 
    225       !!                     
    226       !! ** Purpose :   Compute the horizontal derivative of passive tracers 
    227       !!      TRA at u- and v-points with a linear interpolation for z-coordinate 
    228       !!      with partial steps. 
    229       !! 
    230       !! ** Method  :   the same for T & S 
    231       !! 
    232       !! ** Action  : - pgtru : horizontal gradient of TRA at U-points  
    233       !!              - pgtrv : horizontal gradient of TRA at V-points  
    234       !!---------------------------------------------------------------------- 
    235       !! * Arguments 
    236       INTEGER                              , INTENT( in )  ::  kt    ! ocean time-step index 
    237       INTEGER                              , INTENT( in )  ::  kjpt  ! number of tracers 
    238       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in )  ::  ptra  ! 4D tracers fields 
    239       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT( out ) ::  pgtru, pgtrv  ! horizontal grad. of TRA u- and v-points  
     93      INTEGER                              , INTENT( in )           ::  kt    ! ocean time-step index 
     94      INTEGER                              , INTENT( in )           ::  kjpt  ! number of tracers 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in )           ::  pta   ! 4D active or passive tracers fields 
     96      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT( out)           ::  pgtu, pgtv  ! horizontal grad. of ptra u- and v-points  
     97      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT( in ), OPTIONAL ::  prd   ! 3D rd fields 
     98      REAL(wp), DIMENSION(jpi,jpj         ), INTENT( out), OPTIONAL ::  pgru, pgrv  ! horizontal grad. of prd u- and v-points  
    24099      !! * Local declarations 
    241100      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    242101      INTEGER  ::   iku, ikv        ! partial step level at u- and v-points 
    243       REAL(wp) ::   ztrai, ztraj, ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    244       !!---------------------------------------------------------------------- 
    245  
     102      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj     ! interpolated value of tracer 
     103      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj     ! interpolated value of rd 
     104      REAL(wp), DIMENSION(jpi,jpj)      ::   zhi, zhj     ! depth of interpolation for eos2d 
     105      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
     106      !!---------------------------------------------------------------------- 
     107 
     108 
     109      ! Interpolation of tracers at the last ocean level 
    246110      DO jn = 1, kjpt 
    247          ! Interpolation of passive tracers at the last ocean level 
    248111# if defined key_vectopt_loop 
    249112         jj = 1 
     
    262125               IF( ze3wu >= 0. ) THEN      ! case 1 
    263126                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
    264                   ! interpolated values of passive tracers 
    265                   ztrai = ptra(ji+1,jj,iku,jn) + zmaxu * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) ) 
    266                   ! gradient of passive tracers 
    267                   pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai - ptra(ji,jj,iku,jn) ) 
     127                  ! interpolated values of tracers 
     128                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku-1,jn) - pta(ji+1,jj,iku,jn) ) 
     129                  ! gradient of tracers 
     130                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    268131               ELSE                        ! case 2 
    269132                  zmaxu = -ze3wu / fse3w(ji,jj,iku) 
    270                   ! interpolated values of passive tracers 
    271                   ztrai = ptra(ji,jj,iku,jn) + zmaxu * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) ) 
    272                   ! gradient of passive tracers 
    273                   pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai ) 
     133                  ! interpolated values of tracers 
     134                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku-1,jn) - pta(ji,jj,iku,jn) ) 
     135                  ! gradient of tracers 
     136                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    274137               ENDIF 
    275138 
     
    277140               IF( ze3wv >= 0. ) THEN      ! case 1 
    278141                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
    279                   ! interpolated values of passive tracers 
    280                   ztraj = ptra(ji,jj+1,ikv,jn) + zmaxv * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) ) 
    281                   ! gradient of passive tracers 
    282                   pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj - ptra(ji,jj,ikv,jn) ) 
     142                  ! interpolated values of tracers 
     143                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv-1,jn) - pta(ji,jj+1,ikv,jn) ) 
     144                  ! gradient of tracers 
     145                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    283146               ELSE                        ! case 2 
    284147                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
    285                   ! interpolated values of passive tracers 
    286                   ztraj = ptra(ji,jj,ikv,jn) + zmaxv * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) ) 
    287                   ! gradient of passive tracers 
    288                   pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj ) 
     148                  ! interpolated values of tracers 
     149                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv-1,jn) - pta(ji,jj,ikv,jn) ) 
     150                  ! gradient of tracers 
     151                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    289152               ENDIF 
    290153# if ! defined key_vectopt_loop 
     
    294157 
    295158         ! Lateral boundary conditions on each gradient 
    296          CALL lbc_lnk( pgtru(:,:,jn) , 'U', -1. ) 
    297          CALL lbc_lnk( pgtrv(:,:,jn) , 'V', -1. ) 
     159         CALL lbc_lnk( pgtu(:,:,jn) , 'U', -1. ) 
     160         CALL lbc_lnk( pgtv(:,:,jn) , 'V', -1. ) 
    298161 
    299162      END DO 
    300163 
    301    END SUBROUTINE zps_hde_trc 
    302 #endif 
     164      ! horizontal derivative of rd 
     165      IF( PRESENT( prd ) ) THEN 
     166         ! depth of the partial step level 
     167# if defined key_vectopt_loop 
     168         jj = 1 
     169         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
     170# else 
     171         DO jj = 1, jpjm1 
     172            DO ji = 1, jpim1 
     173# endif 
     174               iku = mbatu(ji,jj) 
     175               ikv = mbatv(ji,jj) 
     176               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
     177               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     178               IF( ze3wu >= 0. ) THEN    
     179                  zhi(ji,jj) = fsdept(ji  ,jj,iku) 
     180               ELSE                    
     181                  zhi(ji,jj) = fsdept(ji+1,jj,iku) 
     182               ENDIF 
     183               IF( ze3wv >= 0. ) THEN   
     184                  zhj(ji,jj) = fsdept(ji,jj  ,ikv) 
     185               ELSE                    
     186                  zhj(ji,jj) = fsdept(ji,jj+1,ikv) 
     187               ENDIF 
     188# if ! defined key_vectopt_loop 
     189            END DO 
     190# endif 
     191         END DO 
     192 
     193         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
     194         ! step and store it in  zri, zrj for each  case 
     195         CALL eos( zti, zhi, zri ) 
     196         CALL eos( ztj, zhj, zrj ) 
     197 
     198         ! Gradient of density at the last level  
     199# if defined key_vectopt_loop 
     200         jj = 1 
     201         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
     202# else 
     203         DO jj = 1, jpjm1 
     204            DO ji = 1, jpim1 
     205# endif 
     206               iku = mbatu(ji,jj) 
     207               ikv = mbatv(ji,jj) 
     208               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
     209               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
     210               IF( ze3wu >= 0. ) THEN    ! i-direction: case 1 
     211                  pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 
     212               ELSE                      ! i-direction: case 2 
     213                  pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 
     214               ENDIF 
     215               IF( ze3wv >= 0. ) THEN    ! j-direction: case 1 
     216                  pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 
     217               ELSE                      ! j-direction: case 2 
     218                  pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 
     219               ENDIF 
     220# if ! defined key_vectopt_loop 
     221            END DO 
     222# endif 
     223         END DO 
     224 
     225         ! Lateral boundary conditions on each gradient 
     226         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. ) 
     227         ! 
     228      END IF 
     229      ! 
     230   END SUBROUTINE zps_hde 
    303231 
    304232   SUBROUTINE zps_hde_init 
Note: See TracChangeset for help on using the changeset viewer.