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 3432 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90 – NEMO

Ignore:
Timestamp:
2012-07-11T13:22:58+02:00 (12 years ago)
Author:
trackstand2
Message:

Merge branch 'ksection_partition'

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r3211 r3432  
    9898      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9999      !!---------------------------------------------------------------------- 
     100      USE timing,   ONLY: timing_start, timing_stop 
    100101      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    101102      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
     
    103104!FTRANS zftu zftv :I :I :z 
    104105#if defined key_z_first 
    105       USE wrk_nemo, ONLY:   wdkt => wrk_3d_9 , wdk1t => wrk_3d_10  ! 3D workspace 
     106!      USE wrk_nemo, ONLY:   wdkt => wrk_3d_9 , wdk1t => wrk_3d_10  ! 3D workspace 
    106107!FTRANS wdkt wdk1t :I :I :z 
    107108#else 
     
    131132      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    132133      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
     134#if defined key_z_first 
     135      REAL(wp) ::  wdkt , wdki1t , wdkim1t , wdkj1t , wdkjm1t 
     136      REAL(wp) ::  wdk1t, wdk1i1t, wdk1im1t, wdk1j1t, wdk1jm1t 
     137#endif 
     138 
    133139#if defined key_diaar5 
    134140      REAL(wp)                         ::   zztmp               ! local scalar 
    135141#endif 
    136142      !!---------------------------------------------------------------------- 
     143 
     144      CALL timing_start('tra_ldf_iso') 
    137145 
    138146#if defined key_z_first 
     
    151159      ! 
    152160      !                                                          ! =========== 
     161!DIR$ SHORTLOOP 
    153162      DO jn = 1, kjpt                                            ! tracer loop 
    154163         !                                                       ! =========== 
     
    157166         !!   I - masked horizontal derivative  
    158167         !!---------------------------------------------------------------------- 
     168         CALL timing_start('traldf_iso_I') 
    159169         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 
     170#if defined key_z_first 
     171         DO jj=1,jpj,1 
     172            DO jk=1,jpk,1 
     173               zdit(1  ,jj,jk) = 0.0_wp 
     174               zdit(jpi,jj,jk) = 0.0_wp 
     175               zdjt(1  ,jj,jk) = 0.0_wp 
     176               zdjt(jpi,jj,jk) = 0.0_wp 
     177            END DO 
     178         END DO 
     179#else 
    160180         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0 
    161181         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0 
     182#endif 
    162183         !!end 
    163184 
     
    185206            END DO 
    186207         ENDIF 
     208         ! 
     209         CALL timing_stop('traldf_iso_I','section') 
    187210 
    188211         !!---------------------------------------------------------------------- 
    189212         !!   II - horizontal trend  (full) 
    190213         !!---------------------------------------------------------------------- 
     214         CALL timing_start('traldf_iso_II') 
    191215#if defined key_z_first 
    192216            ! 1. Vertical tracer gradient at level jk and jk+1 
     
    194218            ! surface boundary condition: wdkt(jk=1)=wdkt(jk=2) 
    195219 
    196          DO jj = 1, jpj 
    197             DO ji = 1, jpi 
    198                DO jk = 1, jpkm1 
    199                   wdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    200                END DO 
    201                wdkt(ji,jj,1) = wdk1t(ji,jj,1) 
    202                DO jk = 2, jpkm1 
    203                   wdkt(ji,jj,jk) =  ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    204                END DO 
    205             END DO 
    206          END DO 
     220!!$         DO jj = 1, jpj 
     221!!$            DO ji = 1, jpi 
     222!!$               DO jk = 1, jpkm1 
     223!!$                  wdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
     224!!$               END DO 
     225!!$               wdkt(ji,jj,1) = wdk1t(ji,jj,1) 
     226!!$               DO jk = 2, jpkm1 
     227!!$                  wdkt(ji,jj,jk) =  ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     228!!$               END DO 
     229!!$            END DO 
     230!!$         END DO 
    207231 
    208232            ! 2. Horizontal fluxes 
    209233            ! --------------------    
    210          DO jj = 1 , jpjm1 
    211             DO ji = 1, jpim1 
    212                DO jk = 1, jpkm1 
    213                   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 
    214                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 
    215                   zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
    216                      &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    217                   zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   & 
    218                      &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    219                   zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    220                   zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    221                   zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   & 
    222                      &              + zcof1 * (  wdkt (ji+1,jj,jk) + wdk1t(ji,jj,jk)      & 
    223                      &                         + wdk1t(ji+1,jj,jk) + wdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk) 
    224                   zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    225                      &              + zcof2 * (  wdkt (ji,jj+1,jk) + wdk1t(ji,jj,jk)      & 
    226                      &                         + wdk1t(ji,jj+1,jk) + wdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                   
    227                END DO 
    228             END DO 
    229          END DO 
    230  
    231             ! II.4 Second derivative (divergence) and add to the general trend 
    232             ! ---------------------------------------------------------------- 
     234!!$         DO jj = 1 , jpjm1 
     235!!$            DO ji = 1, jpim1 
     236!!$               DO jk = 1, jpkm1 
     237!!$                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 
     238!!$                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 
     239!!$                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
     240!!$                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. ) 
     241!!$                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   & 
     242!!$                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
     243!!$                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
     244!!$                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
     245!!$                  zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   & 
     246!!$                     &              + zcof1 * (  wdkt (ji+1,jj,jk) + wdk1t(ji,jj,jk)      & 
     247!!$                     &                         + wdk1t(ji+1,jj,jk) + wdkt (ji,jj,jk)  )  ) * umask(ji,jj,jk) 
     248!!$                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
     249!!$                     &              + zcof2 * (  wdkt (ji,jj+1,jk) + wdk1t(ji,jj,jk)      & 
     250!!$                     &                         + wdk1t(ji,jj+1,jk) + wdkt (ji,jj,jk)  )  ) * vmask(ji,jj,jk)                   
     251!!$               END DO 
     252!!$            END DO 
     253!!$         END DO 
     254 
    233255         DO jj = 2 , jpjm1 
    234256            DO ji = 2, jpim1 
    235257               DO jk = 1, jpkm1 
    236                   zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    237                   ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
     258 
     259                  ! 1. Vertical tracer gradient at level jk and jk+1 
     260                  ! ------------------------------------------------ 
     261                  ! surface boundary condition: wdkt(jk=1)=wdkt(jk=2) 
     262 
     263                  wdk1t = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
     264                  wdk1i1t = ( ptb(ji+1,jj,jk,jn) - ptb(ji+1,jj,jk+1,jn) ) * tmask(ji+1,jj,jk+1) 
     265                  wdk1im1t = ( ptb(ji-1,jj,jk,jn) - ptb(ji-1,jj,jk+1,jn) ) * tmask(ji-1,jj,jk+1) 
     266                  wdk1j1t = ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj+1,jk+1,jn) ) * tmask(ji,jj+1,jk+1) 
     267                  wdk1jm1t = ( ptb(ji,jj-1,jk,jn) - ptb(ji,jj-1,jk+1,jn) ) * tmask(ji,jj-1,jk+1) 
     268 
     269                  IF(jk > 1)THEN 
     270                     wdkt =  ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     271                     wdki1t = ( ptb(ji+1,jj,jk-1,jn) - ptb(ji+1,jj,jk,jn) ) * tmask(ji+1,jj,jk) 
     272                     wdkim1t = ( ptb(ji-1,jj,jk-1,jn) - ptb(ji-1,jj,jk,jn) ) * tmask(ji-1,jj,jk) 
     273                     wdkj1t = ( ptb(ji,jj+1,jk-1,jn) - ptb(ji,jj+1,jk,jn) ) * tmask(ji,jj+1,jk) 
     274                     wdkjm1t = ( ptb(ji,jj-1,jk-1,jn) - ptb(ji,jj-1,jk,jn) ) * tmask(ji,jj-1,jk) 
     275                  ELSE 
     276                     wdkt   = wdk1t 
     277                     wdki1t = wdk1i1t 
     278                     wdkim1t= wdk1im1t 
     279                     wdkj1t = wdk1j1t 
     280                     wdkjm1t= wdk1jm1t 
     281                  END IF 
     282 
     283                  ! II.4 Second derivative (divergence) and add to the general trend 
     284                  ! ---------------------------------------------------------------- 
     285                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     286 
     287                  ztra = zbtr * (                                                   & 
     288 
     289!                                zftu(ji,jj,jk) -  
     290                            ( ((fsahtu(ji,jj,jk) + pahtb0) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)) * zdit(ji,jj,jk)                                & 
     291                              - ( fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) /                     & 
     292                                MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)                          & 
     293                                    + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1.) ) *                 & 
     294                              (wdki1t + wdk1t + wdk1i1t + wdkt) ) * umask(ji,jj,jk) - & 
     295 
     296!                                zftu(ji-1,jj,jk) +  
     297                            ( ((fsahtu(ji-1,jj,jk) + pahtb0) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) / e1u(ji-1,jj)) * zdit(ji-1,jj,jk)                                & 
     298                              - ( fsahtu(ji-1,jj,jk) * e2u(ji-1,jj) * uslp(ji-1,jj,jk) /                 & 
     299                                MAX(  tmask(ji,jj,jk  ) + tmask(ji-1,jj,jk+1)                            & 
     300                                    + tmask(ji,jj,jk+1) + tmask(ji-1,jj,jk  ), 1.) ) *                   & 
     301                              (wdkt + wdk1im1t + wdk1t + wdkim1t) ) * umask(ji-1,jj,jk) + & 
     302 
     303 
     304!                                zftv(ji,jj,jk) -  
     305                            (  ((fsahtv(ji,jj,jk) + pahtb0) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)) * zdjt(ji,jj,jk)   & 
     306                     &              - ( fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) /                 & 
     307                                MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)                            & 
     308                     &              + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )) *                   & 
     309                                (wdkj1t + wdk1t + wdk1j1t + wdkt)  ) * vmask(ji,jj,jk) - & 
     310!                                zftv(ji,jj-1,jk) & 
     311                            (  ((fsahtv(ji,jj-1,jk) + pahtb0) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) / e2v(ji,jj-1)) * zdjt(ji,jj-1,jk)   & 
     312                     &              - ( fsahtv(ji,jj-1,jk) * e1v(ji,jj-1) * vslp(ji,jj-1,jk) /           & 
     313                                MAX(  tmask(ji,jj,jk  ) + tmask(ji,jj-1,jk+1)                            & 
     314                     &              + tmask(ji,jj,jk+1) + tmask(ji,jj-1,jk  ), 1. )) *                   & 
     315                                (wdkt + wdk1jm1t + wdk1t + wdkjm1t)  ) * vmask(ji,jj-1,jk) & 
     316 
     317                                ) 
    238318                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    239319               END DO 
     
    295375         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    296376         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    297             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    298             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     377            IF( jn == jp_tem)THEN 
     378               htr_ldf = ptr_vj( zftv ) 
     379            END IF 
     380            IF( jn == jp_sal)THEN 
     381               str_ldf = ptr_vj( zftv ) 
     382            END IF 
    299383         ENDIF 
    300384  
     
    338422         END IF 
    339423#endif 
     424         CALL timing_stop('traldf_iso_II','section') 
    340425 
    341426         !!---------------------------------------------------------------------- 
    342427         !!   III - vertical trend of T & S (extra diagonal terms only) 
    343428         !!---------------------------------------------------------------------- 
     429         CALL timing_start('traldf_iso_III') 
    344430          
    345431         ! Local constant initialization 
    346432         ! ----------------------------- 
     433#if defined key_z_first 
     434         DO jj=1,jpj,1 
     435            DO jk=1,jpk,1 
     436               ztfw(1  ,jj,jk) = 0.0_wp 
     437               ztfw(jpi,jj,jk) = 0.0_wp 
     438            END DO 
     439         END DO 
     440#else 
    347441         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0 
    348           
     442#endif 
    349443         ! Vertical fluxes 
    350444         ! --------------- 
    351445          
    352446         ! Surface and bottom vertical fluxes set to zero 
     447#if defined key_z_first 
     448         DO ji=1,jpi,1 
     449            DO jj=1,jpj,1 
     450               ztfw(ji,jj,1  ) = 0.0_wp 
     451               ztfw(ji,jj,jpk) = 0.0_wp 
     452            END DO 
     453         END DO 
     454#else 
    353455         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0 
    354           
     456#endif 
     457 
    355458         ! interior (2=<jk=<jpk-1) 
    356459#if defined key_z_first 
     
    400503         END DO 
    401504         ! 
     505 
     506         CALL timing_stop('traldf_iso_III','section') 
     507 
    402508      END DO 
    403509      ! 
     
    409515          wrk_not_released(2, 1,2,3) )   CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays') 
    410516#endif 
     517      ! 
     518      CALL timing_stop('tra_ldf_iso','section') 
    411519      ! 
    412520   END SUBROUTINE tra_ldf_iso 
Note: See TracChangeset for help on using the changeset viewer.