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 6433 for branches/UKMO/v3_6_extra_CMIP6_diagnostics – NEMO

Ignore:
Timestamp:
2016-04-06T14:54:25+02:00 (8 years ago)
Author:
timgraham
Message:

Modified method as suggested by Christian. adv and ldf transports by basin now work correctly.

Location:
branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r6432 r6433  
    297297   END SUBROUTINE dia_ptr_init 
    298298 
    299    SUBROUTINE dia_ptr_ohst_components( pva, ptr )  
    300       !!---------------------------------------------------------------------- 
    301       !!                    ***  ROUTINE dia_ptr_oht_components  *** 
    302       !!---------------------------------------------------------------------- 
    303       !! Wrapper for heat and salt transport calculations to calculate them 
    304       !! for each basin 
     299   SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva )  
     300      !!---------------------------------------------------------------------- 
     301      !!                    ***  ROUTINE dia_ptr_ohst_components  *** 
     302      !!---------------------------------------------------------------------- 
     303      !! Wrapper for heat and salt transport calculations to calculate them for each basin 
    305304      !! Called from all advection and/or diffusion routines 
    306       INTEGER                          :: jn 
    307       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: pva   ! 3D input array of advection/diffusion 
    308       REAL(wp), DIMENSION(jpi,nptr), INTENT(OUT)   :: ptr   ! zonal & vertical sum 
     305      !!---------------------------------------------------------------------- 
     306      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
     307      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
     308      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     309      INTEGER                                        :: jn    ! 
     310 
    309311       
    310       ptr(:, 1) = ptr_sj( pva(:,:,:) ) 
     312      IF( cptr == 'adv' ) THEN 
     313         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     314         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     315      ENDIF 
     316      IF( cptr == 'ldf' ) THEN 
     317         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     318         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     319      ENDIF 
     320      ! 
    311321      IF( ln_subbas ) THEN 
    312          DO jn=2,nptr 
    313             ptr(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
    314          END DO 
     322         ! 
     323         IF( cptr == 'adv' ) THEN 
     324             IF( ktra == jp_tem ) THEN  
     325                DO jn = 2, nptr 
     326                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     327                END DO 
     328             ENDIF 
     329             IF( ktra == jp_sal ) THEN  
     330                DO jn = 2, nptr 
     331                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     332                END DO 
     333             ENDIF 
     334         ENDIF 
     335         IF( cptr == 'ldf' ) THEN 
     336             IF( ktra == jp_tem ) THEN  
     337                DO jn = 2, nptr 
     338                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     339                 END DO 
     340             ENDIF 
     341             IF( ktra == jp_sal ) THEN  
     342                DO jn = 2, nptr 
     343                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     344                END DO 
     345             ENDIF 
     346         ENDIF 
     347         ! 
    315348      ENDIF 
    316349 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r6428 r6433  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    282            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    283            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    284          ENDIF 
     281         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    285282         ! 
    286283      END DO 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r6428 r6433  
    219219         END IF 
    220220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    221          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    222            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    223            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    224          ENDIF 
     221         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    225222 
    226223         ! II. Vertical advective fluxes 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r6428 r6433  
    200200 
    201201         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    202          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    203             IF( jn == jp_tem )  CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    204             IF( jn == jp_sal )  CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    205          ENDIF 
     202         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:)  ) 
    206203 
    207204         ! II. Vertical advective fluxes 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r6428 r6433  
    355355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    356356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    357          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    358            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    359            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    360          ENDIF 
     357         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    361358         ! 
    362359      END DO 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6432 r6433  
    8686      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    8787      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
    88       REAL(wp), POINTER, DIMENSION(:,:) :: ptr_adv_tmp 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    8989      !!---------------------------------------------------------------------- 
    9090      ! 
    … …  
    108108      ! 
    109109      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    110          CALL wrk_alloc( jpi, nptr, ptr_adv_tmp ) 
    111          ptr_adv_tmp(:,:) = 0._wp 
     110         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     111         zptry(:,:,:) = 0._wp 
    112112      ENDIF 
    113113      ! 
    … …  
    199199         END IF 
    200200         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    201          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    202            CALL dia_ptr_ohst_components( zwy(:,:,:), ptr_adv_tmp(:,:)  ) 
    203          ENDIF 
     201         IF( cdtype == 'TRA' .AND. ln_diaptr )    zptry(:,:,:) = zwy(:,:,:)  
    204202 
    205203         ! 3. antidiffusive flux : high order minus low order 
    … …  
    270268         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    271269         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    272            IF( jn == jp_tem ) THEN  
    273               CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    274               htr_adv(:,:) = htr_adv(:,:) + ptr_adv_tmp(:,:) 
    275            ENDIF 
    276            IF( jn == jp_sal )  THEN 
    277               CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    278               htr_adv(:,:) = htr_adv(:,:) + ptr_adv_tmp(:,:) 
    279            ENDIF 
    280            ptr_adv_tmp(:,:) = 0._wp 
     270            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     271            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    281272         ENDIF 
    282273         ! 
    … …  
    285276                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
    286277      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    287       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, nptr, ptr_adv_tmp ) 
     278      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    288279      ! 
    289280      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
    … …  
    332323      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
    333324      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     325      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    334326      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 
    335       REAL(wp), POINTER, DIMENSION(:,:) :: ptr_adv_tmp 
    336327      !!---------------------------------------------------------------------- 
    337328      ! 
    … …  
    357348      ! 
    358349      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    359          CALL wrk_alloc( jpi, nptr, ptr_adv_tmp ) 
    360          ptr_adv_tmp(:,:) = 0._wp 
     350         CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     351         zptry(:,:,:) = 0._wp 
    361352      ENDIF 
    362353      ! 
    … …  
    449440         END IF 
    450441         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    451          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    452            CALL dia_ptr_ohst_components( zwy(:,:,:), ptr_adv_tmp(:,:)  ) 
    453          ENDIF 
     442         IF( cdtype == 'TRA' .AND. ln_diaptr )  zptry(:,:,:) = zwy(:,:,:) 
    454443 
    455444         ! 3. antidiffusive flux : high order minus low order 
    … …  
    575564         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    576565         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    577            IF( jn == jp_tem ) THEN  
    578               CALL dia_ptr_ohst_components( zwy(:,:,:), htr_adv(:,:)  ) 
    579               htr_adv(:,:) = htr_adv(:,:) + ptr_adv_tmp(:,:) 
    580            ENDIF 
    581            IF( jn == jp_sal )  THEN 
    582               CALL dia_ptr_ohst_components( zwy(:,:,:), str_adv(:,:)  ) 
    583               htr_adv(:,:) = htr_adv(:,:) + ptr_adv_tmp(:,:) 
    584            ENDIF 
    585            ptr_adv_tmp(:,:) = 0._wp 
     566            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  
     567            CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 
    586568         ENDIF 
    587569         ! 
    … …  
    592574                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    593575      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    594       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, nptr, ptr_adv_tmp ) 
     576      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    595577      ! 
    596578      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts') 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r6428 r6433  
    177177         END IF 
    178178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    179          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    180            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( ztv(:,:,:), htr_adv(:,:)  ) 
    181            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( ztv(:,:,:), str_adv(:,:)  ) 
    182          ENDIF 
     179         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 
    183180          
    184181         ! TVD scheme for the vertical direction   

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r6428 r6433  
    173173         !                                                 
    174174         ! "zonal" mean lateral diffusive heat and salt transport 
    175          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    176            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( ztv(:,:,:),htr_ldf(:,:) ) 
    177            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( ztv(:,:,:),str_ldf(:,:) ) 
    178          ENDIF 
     175         IF( cdtype == 'TRA' .AND. ln_diaptr )   CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    179176         !                                                ! =========== 
    180177      END DO                                              ! tracer loop 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r6428 r6433  
    247247         !                                                ! =============== 
    248248         ! "Poleward" diffusive heat or salt transport 
    249          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 
    250             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    251             IF( jn == jp_tem )  CALL dia_ptr_ohst_components( -zftv(:,:,:),htr_ldf(:,:) ) 
    252             IF( jn == jp_sal )  CALL dia_ptr_ohst_components( -zftv(:,:,:),str_ldf(:,:) ) 
    253          ENDIF 
     249        ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     250         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 
    254251 
    255252         !                             ! ************ !   ! =============== 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r6428 r6433  
    235235         ! 
    236236         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    237          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    238237            ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    239             IF( jn == jp_tem )  CALL dia_ptr_ohst_components( -zftv(:,:,:),htr_ldf(:,:) ) 
    240             IF( jn == jp_sal )  CALL dia_ptr_ohst_components( -zftv(:,:,:),str_ldf(:,:) ) 
    241          ENDIF 
     238         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:)  ) 
    242239  
    243240         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r6428 r6433  
    386386         ! 
    387387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    388          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    389             IF( jn == jp_tem )  CALL dia_ptr_ohst_components( zftv(:,:,:),htr_ldf(:,:) ) 
    390             IF( jn == jp_sal )  CALL dia_ptr_ohst_components( zftv(:,:,:),str_ldf(:,:) ) 
    391          ENDIF 
     388         IF( cdtype == 'TRA' .AND. ln_diaptr )  CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 
    392389 
    393390         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 

  • branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r6428 r6433  
    154154         ! 
    155155         ! "Poleward" diffusive heat or salt transports 
    156          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
    157            IF( jn == jp_tem )  CALL dia_ptr_ohst_components( ztv(:,:,:),htr_ldf(:,:) ) 
    158            IF( jn == jp_sal )  CALL dia_ptr_ohst_components( ztv(:,:,:),str_ldf(:,:) ) 
    159          ENDIF 
     156         IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 
    160157         !                                                  ! ================== 
    161158      END DO                                                ! end of tracer loop 
Note: See TracChangeset for help on using the changeset viewer.