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 12377 for NEMO/trunk/src/OCE/DIA/diaptr.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/DIA/diaptr.F90

    r12276 r12377  
    4646   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
    4747 
    48    LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    49    LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
     48   LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini) 
    5049   INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc) 
    5150 
    … …  
    6059   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 
    6160 
     61   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
    6262   !! * Substitutions 
    63 #  include "vectopt_loop_substitute.h90" 
     63#  include "do_loop_substitute.h90" 
    6464   !!---------------------------------------------------------------------- 
    6565   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6969CONTAINS 
    7070 
    71    SUBROUTINE dia_ptr( pvtr ) 
     71   SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 
    7272      !!---------------------------------------------------------------------- 
    7373      !!                  ***  ROUTINE dia_ptr  *** 
    7474      !!---------------------------------------------------------------------- 
     75      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index      
     76      INTEGER                         , INTENT(in)           ::   Kmm    ! time level index 
    7577      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport 
    7678      ! 
    … …  
    9294      ! 
    9395      IF( ln_timing )   CALL timing_start('dia_ptr') 
    94       ! 
     96 
     97      IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init 
     98      ! 
     99      IF( .NOT. l_diaptr )   RETURN 
     100 
    95101      IF( PRESENT( pvtr ) ) THEN 
    96102         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF 
    … …  
    111117            zmask(:,:,:) = 0._wp 
    112118            zts(:,:,:,:) = 0._wp 
    113             DO jk = 1, jpkm1 
    114                DO jj = 1, jpjm1 
    115                   DO ji = 1, jpi 
    116                      zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 
    117                      zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
    118                      zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    119                      zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    120                   ENDDO 
    121                ENDDO 
    122              ENDDO 
     119            DO_3D_10_11( 1, jpkm1 ) 
     120               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     121               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     122               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     123               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     124            END_3D 
    123125         ENDIF 
    124126         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
    … …  
    186188         zts(:,:,:,:) = 0._wp 
    187189         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface  
    188             DO jk = 1, jpkm1 
    189                DO jj = 1, jpj 
    190                   DO ji = 1, jpi 
    191                      zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk) 
    192                      zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    193                      zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 
    194                      zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 
    195                   END DO 
    196                END DO 
    197             END DO 
     190            DO_3D_11_11( 1, jpkm1 ) 
     191               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
     192               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     193               zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
     194               zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
     195            END_3D 
    198196            ! 
    199197            DO jn = 1, nptr 
    … …  
    280278         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
    281279            zts(:,:,:,:) = 0._wp 
    282             DO jk = 1, jpkm1 
    283                DO jj = 1, jpjm1 
    284                   DO ji = 1, jpi 
    285                      zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 
    286                      zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    287                      zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
    288                   ENDDO 
    289                ENDDO 
    290              ENDDO 
     280            DO_3D_10_11( 1, jpkm1 ) 
     281               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     282               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     283               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     284            END_3D 
    291285             CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
    292286             CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
    … …  
    326320      !! ** Purpose :   Initialization, namelist read 
    327321      !!---------------------------------------------------------------------- 
    328       INTEGER ::  inum, jn, ios, ierr           ! local integers 
    329       !! 
    330       NAMELIST/namptr/ ln_diaptr, ln_subbas 
     322      INTEGER ::  inum, jn           ! local integers 
     323      !! 
    331324      REAL(wp), DIMENSION(jpi,jpj) :: zmsk 
    332325      !!---------------------------------------------------------------------- 
    333326 
    334  
    335       REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport 
    336       READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 
    337 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 
    338  
    339       REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    340       READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    341 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 
    342       IF(lwm) WRITE ( numond, namptr ) 
    343  
     327      l_diaptr = .FALSE. 
     328      IF(   iom_use( 'zomsf'    ) .OR. iom_use( 'zotem'    ) .OR. iom_use( 'zosal'    ) .OR.  & 
     329         &  iom_use( 'zosrf'    ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.  & 
     330         &  iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR.  & 
     331         &  iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR.  &  
     332         &  iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  & 
     333         &  iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) )  l_diaptr  = .TRUE. 
     334 
     335  
    344336      IF(lwp) THEN                     ! Control print 
    345337         WRITE(numout,*) 
    … …  
    347339         WRITE(numout,*) '~~~~~~~~~~~~' 
    348340         WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    349          WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr 
     341         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      l_diaptr  = ', l_diaptr 
    350342      ENDIF 
    351343 
    352       IF( ln_diaptr ) THEN   
     344      IF( l_diaptr ) THEN   
    353345         ! 
    354346         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    … …  
    389381         hstr_vtr(:,:,:) = 0._wp           ! 
    390382         ! 
     383         ll_init = .FALSE. 
     384         ! 
    391385      ENDIF  
    392386      !  
    … …  
    394388 
    395389 
    396    SUBROUTINE dia_ptr_hst( ktra, cptr, pva )  
     390   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx )  
    397391      !!---------------------------------------------------------------------- 
    398392      !!                    ***  ROUTINE dia_ptr_hst *** 
    … …  
    403397      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    404398      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
    405       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     399      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx   ! 3D input array of advection/diffusion 
    406400      INTEGER                                        :: jn    ! 
    407401 
    … …  
    410404         IF( ktra == jp_tem )  THEN 
    411405             DO jn = 1, nptr 
    412                 hstr_adv(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     406                hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    413407             ENDDO 
    414408         ENDIF 
    415409         IF( ktra == jp_sal )  THEN 
    416410             DO jn = 1, nptr 
    417                 hstr_adv(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     411                hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    418412             ENDDO 
    419413         ENDIF 
    … …  
    423417         IF( ktra == jp_tem )  THEN 
    424418             DO jn = 1, nptr 
    425                 hstr_ldf(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     419                hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    426420             ENDDO 
    427421         ENDIF 
    428422         IF( ktra == jp_sal )  THEN 
    429423             DO jn = 1, nptr 
    430                 hstr_ldf(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     424                hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    431425             ENDDO 
    432426         ENDIF 
    … …  
    436430         IF( ktra == jp_tem )  THEN 
    437431             DO jn = 1, nptr 
    438                 hstr_eiv(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     432                hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    439433             ENDDO 
    440434         ENDIF 
    441435         IF( ktra == jp_sal )  THEN 
    442436             DO jn = 1, nptr 
    443                 hstr_eiv(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     437                hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    444438             ENDDO 
    445439         ENDIF 
    … …  
    449443         IF( ktra == jp_tem )  THEN 
    450444             DO jn = 1, nptr 
    451                 hstr_vtr(:,jp_tem,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     445                hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    452446             ENDDO 
    453447         ENDIF 
    454448         IF( ktra == jp_sal )  THEN 
    455449             DO jn = 1, nptr 
    456                 hstr_vtr(:,jp_sal,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     450                hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    457451             ENDDO 
    458452         ENDIF 
    … …  
    486480 
    487481 
    488    FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval ) 
     482   FUNCTION ptr_sj_3d( pvflx, pmsk )   RESULT ( p_fval ) 
    489483      !!---------------------------------------------------------------------- 
    490484      !!                    ***  ROUTINE ptr_sj_3d  *** 
    … …  
    492486      !! ** Purpose :   i-k sum computation of a j-flux array 
    493487      !! 
    494       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    495       !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    496       !! 
    497       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    498       !!---------------------------------------------------------------------- 
    499       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pva   ! mask flux array at V-point 
     488      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i). 
     489      !!              pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     490      !! 
     491      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
     492      !!---------------------------------------------------------------------- 
     493      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pvflx  ! mask flux array at V-point 
    500494      REAL(wp), INTENT(in), DIMENSION(jpi,jpj)      ::   pmsk   ! Optional 2D basin mask 
    501495      ! 
    … …  
    509503      ijpj = jpj 
    510504      p_fval(:) = 0._wp 
    511       DO jk = 1, jpkm1 
    512          DO jj = 2, jpjm1 
    513             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    514                p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    515             END DO 
    516          END DO 
    517       END DO 
     505      DO_3D_00_00( 1, jpkm1 ) 
     506         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
     507      END_3D 
    518508#if defined key_mpp_mpi 
    519509      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 
    … …  
    523513 
    524514 
    525    FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval ) 
     515   FUNCTION ptr_sj_2d( pvflx, pmsk )   RESULT ( p_fval ) 
    526516      !!---------------------------------------------------------------------- 
    527517      !!                    ***  ROUTINE ptr_sj_2d  *** 
    528518      !! 
    529       !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array 
    530       !! 
    531       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i). 
    532       !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
    533       !! 
    534       !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    535       !!---------------------------------------------------------------------- 
    536       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
     519      !! ** Purpose :   "zonal" and vertical sum computation of a j-flux array 
     520      !! 
     521      !! ** Method  : - i-k sum of pvflx using the interior 2D vmask (vmask_i). 
     522      !!      pvflx is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 
     523      !! 
     524      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
     525      !!---------------------------------------------------------------------- 
     526      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pvflx  ! mask flux array at V-point 
    537527      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    538528      ! 
    … …  
    546536      ijpj = jpj 
    547537      p_fval(:) = 0._wp 
    548       DO jj = 2, jpjm1 
    549          DO ji = fs_2, fs_jpim1   ! Vector opt. 
    550             p_fval(jj) = p_fval(jj) + pva(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    551          END DO 
    552       END DO 
     538      DO_2D_00_00 
     539         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
     540      END_2D 
    553541#if defined key_mpp_mpi 
    554542      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 
    … …  
    577565      p_fval(:,:) = 0._wp 
    578566      DO jc = 1, jpnj ! looping over all processors in j axis 
    579          DO jj = 2, jpjm1 
    580             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    581                p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
    582             END DO 
    583          END DO 
     567         DO_2D_00_00 
     568            p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
     569         END_2D 
    584570         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 
    585571      END DO 
    … …  
    595581      !! ** Purpose :   i-sum computation of an array 
    596582      !! 
    597       !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i). 
    598       !! 
    599       !! ** Action  : - p_fval: i-mean poleward flux of pva 
     583      !! ** Method  : - i-sum of field using the interior 2D vmask (pmsk). 
     584      !! 
     585      !! ** Action  : - p_fval: i-sum of masked field 
    600586      !!---------------------------------------------------------------------- 
    601587      !! 
    … …  
    618604      p_fval(:,:) = 0._wp 
    619605      ! 
    620       DO jk = 1, jpkm1 
    621          DO jj = 2, jpjm1 
    622             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    623                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    624             END DO 
    625          END DO 
    626       END DO 
     606      DO_3D_00_00( 1, jpkm1 ) 
     607         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
     608      END_3D 
    627609      ! 
    628610#if defined key_mpp_mpi 
Note: See TracChangeset for help on using the changeset viewer.