Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r5034 r5600  
    2828   USE in_out_manager  ! I/O manager 
    2929   USE iom             ! I/O library 
    30 #if defined key_diaar5 
    3130   USE phycst          ! physical constants 
    3231   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33 #endif 
    3432   USE wrk_nemo        ! Memory Allocation 
    3533   USE timing          ! Timing 
     
    106104      ! 
    107105      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     106      INTEGER  ::  ikt 
    108107      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    109108      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    110109      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    111 #if defined key_diaar5 
    112       REAL(wp)                         ::   zztmp               ! local scalar 
    113 #endif 
    114110      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    115111      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
     
    149145            END DO 
    150146         END DO 
     147 
     148         ! partial cell correction 
    151149         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level  
    152150            DO jj = 1, jpjm1 
    153151               DO ji = 1, fs_jpim1   ! vector opt. 
    154152! IF useless if zpshde defines pgu everywhere 
    155                   IF (mbku(ji,jj) > 1) zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)           
    156                   IF (mbkv(ji,jj) > 1) zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    157                   ! (ISF) 
     153                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)           
     154                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
     155               END DO 
     156            END DO 
     157         ENDIF 
     158         IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity 
     159            DO jj = 1, jpjm1 
     160               DO ji = 1, fs_jpim1   ! vector opt. 
    158161                  IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)           
    159162                  IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)      
    160163               END DO 
    161164            END DO 
    162          ENDIF 
     165         END IF 
    163166 
    164167         !!---------------------------------------------------------------------- 
    165168         !!   II - horizontal trend  (full) 
    166169         !!---------------------------------------------------------------------- 
    167 !CDIR PARALLEL DO PRIVATE( zdk1t )  
    168          !                                                ! =============== 
    169          DO jj = 1, jpj                                 ! Horizontal slab 
    170             !                                             ! =============== 
    171             DO ji = 1, jpi   ! vector opt. 
    172                DO jk = mikt(ji,jj), jpkm1 
    173                ! 1. Vertical tracer gradient at level jk and jk+1 
    174                ! ------------------------------------------------ 
    175                ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    176                   zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    177                ! 
    178                   IF( jk == mikt(ji,jj) ) THEN  ;   zdkt(ji,jj,jk) = zdk1t(ji,jj,jk) 
    179                   ELSE                          ;   zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    180                   ENDIF 
     170!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t )  
     171            ! 1. Vertical tracer gradient at level jk and jk+1 
     172            ! ------------------------------------------------ 
     173         !  
     174         ! interior value  
     175         DO jk = 2, jpkm1                
     176            DO jj = 1, jpj 
     177               DO ji = 1, jpi   ! vector opt. 
     178                  zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn  ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 
     179                  ! 
     180                  zdkt(ji,jj,jk)  = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn  ) ) * wmask(ji,jj,jk) 
    181181               END DO 
    182182            END DO 
    183183         END DO 
    184  
    185             ! 2. Horizontal fluxes 
    186             ! --------------------    
    187          DO jj = 1 , jpjm1 
    188             DO ji = 1, fs_jpim1   ! vector opt. 
    189                DO jk = mikt(ji,jj), jpkm1 
     184         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
     185         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 
     186         zdkt (:,:,1) = zdk1t(:,:,1) 
     187         IF ( ln_isfcav ) THEN 
     188            DO jj = 1, jpj 
     189               DO ji = 1, jpi   ! vector opt. 
     190                  ikt = mikt(ji,jj) ! surface level 
     191                  zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn  ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 
     192                  zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 
     193               END DO 
     194            END DO 
     195         END IF 
     196 
     197         ! 2. Horizontal fluxes 
     198         ! --------------------    
     199         DO jk = 1, jpkm1 
     200            DO jj = 1 , jpjm1 
     201               DO ji = 1, fs_jpim1   ! vector opt. 
    190202                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    191203                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     
    208220               END DO 
    209221            END DO 
    210          END DO 
    211222 
    212223            ! II.4 Second derivative (divergence) and add to the general trend 
    213224            ! ---------------------------------------------------------------- 
    214          DO jj = 2 , jpjm1 
    215             DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                DO jk = mikt(ji,jj), jpkm1 
    217                   zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     225            DO jj = 2 , jpjm1 
     226               DO ji = fs_2, fs_jpim1   ! vector opt. 
     227                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    218228                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    219229                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     
    225235         ! 
    226236         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    227          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     237         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    228238            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    229             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    230             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     239            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
     240            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 
    231241         ENDIF 
    232242  
    233 #if defined key_diaar5 
    234          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    235             z2d(:,:) = 0._wp  
    236             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    237             zztmp = -1.0_wp * rau0 * rcp 
    238             DO jk = 1, jpkm1 
    239                DO jj = 2, jpjm1 
    240                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    241                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     243         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     244           ! 
     245           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     246               z2d(:,:) = 0._wp  
     247               DO jk = 1, jpkm1 
     248                  DO jj = 2, jpjm1 
     249                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     250                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     251                     END DO 
    242252                  END DO 
    243253               END DO 
    244             END DO 
    245             z2d(:,:) = zztmp * z2d(:,:) 
    246             CALL lbc_lnk( z2d, 'U', -1. ) 
    247             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    248             z2d(:,:) = 0._wp  
    249             DO jk = 1, jpkm1 
    250                DO jj = 2, jpjm1 
    251                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    252                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     254               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     255               CALL lbc_lnk( z2d, 'U', -1. ) 
     256               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     257               ! 
     258               z2d(:,:) = 0._wp  
     259               DO jk = 1, jpkm1 
     260                  DO jj = 2, jpjm1 
     261                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     262                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     263                     END DO 
    253264                  END DO 
    254265               END DO 
    255             END DO 
    256             z2d(:,:) = zztmp * z2d(:,:) 
    257             CALL lbc_lnk( z2d, 'V', -1. ) 
    258             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    259          END IF 
    260 #endif 
     266               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     267               CALL lbc_lnk( z2d, 'V', -1. ) 
     268               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     269            END IF 
     270            ! 
     271         ENDIF 
    261272 
    262273         !!---------------------------------------------------------------------- 
     
    278289            DO jj = 2, jpjm1 
    279290               DO ji = fs_2, fs_jpim1   ! vector opt. 
    280                   zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     291                  zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk) 
    281292                  ! 
    282293                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      & 
Note: See TracChangeset for help on using the changeset viewer.