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 5602 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 – NEMO

Ignore:
Timestamp:
2015-07-16T13:55:15+02:00 (9 years ago)
Author:
cbricaud
Message:

merge change from trunk rev 5003 to 5519 ( rev where branche 3.6_stable were created )

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r4990 r5602  
    106106      ENDIF 
    107107      ! 
    108       zwi(:,:,:) = 0.e0 ; zwz(:,:,:) = 0.e0 
     108      zwi(:,:,:) = 0.e0 ;  
    109109      ! 
    110110      !                                                          ! =========== 
    111111      DO jn = 1, kjpt                                            ! tracer loop 
    112112         !                                                       ! =========== 
    113          ! 1. Bottom value : flux set to zero 
     113         ! 1. Bottom and k=1 value : flux set to zero 
    114114         ! ---------------------------------- 
    115115         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0 
    116116         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0 
    117  
     117           
     118         zwz(:,:,1  ) = 0._wp 
    118119         ! 2. upstream advection with initial mass fluxes & intermediate update 
    119120         ! -------------------------------------------------------------------- 
     
    134135 
    135136         ! upstream tracer flux in the k direction 
     137         ! Interior value 
     138         DO jk = 2, jpkm1 
     139            DO jj = 1, jpj 
     140               DO ji = 1, jpi 
     141                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
     142                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
     143                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
     144               END DO 
     145            END DO 
     146         END DO 
    136147         ! Surface value 
    137148         IF( lk_vvl ) THEN    
    138             DO jj = 1, jpj 
    139                DO ji = 1, jpi 
    140                   zwz(ji,jj, mikt(ji,jj) ) = 0.e0                         ! volume variable 
    141                END DO 
    142             END DO 
     149            IF ( ln_isfcav ) THEN 
     150               DO jj = 1, jpj 
     151                  DO ji = 1, jpi 
     152                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable 
     153                  END DO 
     154               END DO 
     155            ELSE 
     156               zwz(:,:,1) = 0.e0          ! volume variable 
     157            END IF 
    143158         ELSE                 
    144             DO jj = 1, jpj 
    145                DO ji = 1, jpi 
    146                   zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    147                END DO 
    148             END DO    
     159            IF ( ln_isfcav ) THEN 
     160               DO jj = 1, jpj 
     161                  DO ji = 1, jpi 
     162                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     163                  END DO 
     164               END DO    
     165            ELSE 
     166               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
     167            END IF 
    149168         ENDIF 
    150          ! Interior value 
    151          DO jj = 1, jpj 
    152             DO ji = 1, jpi 
    153                DO jk = mikt(ji,jj)+1, jpkm1 
    154                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    155                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    156                   zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) 
    157                END DO 
    158             END DO 
    159          END DO 
    160169 
    161170         ! total advective trend 
     
    184193         END IF 
    185194         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    187            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    188            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     195         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     196           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     197           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    189198         ENDIF 
    190199 
     
    202211       
    203212         ! antidiffusive flux on k 
    204          zwz(:,:,1) = 0.e0         ! Surface value 
    205          ! 
    206          DO jj = 1, jpj 
    207             DO ji = 1, jpi 
    208                ik=mikt(ji,jj) 
    209                ! surface value 
    210                zwz(ji,jj,1:ik) = 0.e0 
    211                ! Interior value 
    212                DO jk = mikt(ji,jj)+1, jpkm1                     
     213         ! Interior value 
     214         DO jk = 2, jpkm1                     
     215            DO jj = 1, jpj 
     216               DO ji = 1, jpi 
    213217                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 
    214218               END DO 
    215219            END DO 
    216220         END DO 
     221         ! surface value 
     222         IF ( ln_isfcav ) THEN 
     223            DO jj = 1, jpj 
     224               DO ji = 1, jpi 
     225                  zwz(ji,jj,mikt(ji,jj)) = 0.e0 
     226               END DO 
     227            END DO 
     228         ELSE 
     229            zwz(:,:,1) = 0.e0 
     230         END IF 
    217231         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    218232         CALL lbc_lnk( zwz, 'W',  1. ) 
     
    250264         END IF 
    251265         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    252          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    253            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    254            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     266         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     267           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     268           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    255269         ENDIF 
    256270         ! 
     
    358372 
    359373         ! upstream tracer flux in the k direction 
    360          ! Surface value 
    361          IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0._wp                        ! volume variable 
    362          ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface  
    363          ENDIF 
    364374         ! Interior value 
    365375         DO jk = 2, jpkm1 
     
    372382            END DO 
    373383         END DO 
     384         ! Surface value 
     385         IF( lk_vvl ) THEN 
     386            IF ( ln_isfcav ) THEN 
     387               DO jj = 1, jpj 
     388                  DO ji = 1, jpi 
     389                     zwz(ji,jj, mikt(ji,jj) ) = 0.e0          ! volume variable +    isf 
     390                  END DO 
     391               END DO 
     392            ELSE 
     393               zwz(:,:,1) = 0.e0                              ! volume variable + no isf 
     394            END IF 
     395         ELSE 
     396            IF ( ln_isfcav ) THEN 
     397               DO jj = 1, jpj 
     398                  DO ji = 1, jpi 
     399                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface +    isf 
     400                  END DO 
     401               END DO 
     402            ELSE 
     403               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf 
     404            END IF 
     405         ENDIF 
    374406 
    375407         ! total advective trend 
     
    398430         END IF 
    399431         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    400          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    401            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    402            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     432         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     433           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
     434           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    403435         ENDIF 
    404436 
     
    524556         END IF 
    525557         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    526          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    527            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 
    528            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 
     558         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
     559           IF( jn == jp_tem )  htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 
     560           IF( jn == jp_sal )  str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 
    529561         ENDIF 
    530562         ! 
     
    580612         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    581613 
    582       DO jj = 2, jpjm1 
    583          DO ji = fs_2, fs_jpim1   ! vector opt. 
    584             DO jk = mikt(ji,jj), jpkm1 
    585                ikm1 = MAX(jk-1,mikt(ji,jj)) 
    586                z2dtt = p2dt(jk) 
    587                 
     614      DO jk = 1, jpkm1 
     615         ikm1 = MAX(jk-1,1) 
     616         z2dtt = p2dt(jk) 
     617         DO jj = 2, jpjm1 
     618            DO ji = fs_2, fs_jpim1   ! vector opt. 
     619 
    588620               ! search maximum in neighbourhood 
    589621               zup = MAX(  zbup(ji  ,jj  ,jk  ),   & 
Note: See TracChangeset for help on using the changeset viewer.