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 13054 for NEMO – NEMO

Changeset 13054 for NEMO


Ignore:
Timestamp:
2020-06-05T18:56:01+02:00 (4 years ago)
Author:
hadcv
Message:

Tiling for dia_ar5_hst, dia_ptr routines

Location:
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DIA/diaar5.F90

    r12958 r13054  
    3434   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
     36   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   hstr_adv, hstr_ldf 
    3637 
    3738   LOGICAL  :: l_ar5 
     
    5354      !!---------------------------------------------------------------------- 
    5455      ! 
    55       ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     56      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , & 
     57         &      hstr_adv(jpi,jpj,jpts,2), hstr_ldf(jpi,jpj,jpts,2), STAT=dia_ar5_alloc ) 
    5658      ! 
    5759      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
     
    301303   END SUBROUTINE dia_ar5 
    302304 
    303  
    304    SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx )  
     305   ! TODO: These changes and lbc_lnk not necessary if using XIOS (subdomain support, will not output haloes) 
     306   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 
    305307      !!---------------------------------------------------------------------- 
    306308      !!                    ***  ROUTINE dia_ar5_htr *** 
     
    311313      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    312314      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
    313       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
    314       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
     315      REAL(wp), DIMENSION(A2D,jpk)    , INTENT(in)   :: puflx  ! u-flux of advection/diffusion 
     316      REAL(wp), DIMENSION(A2D,jpk)    , INTENT(in)   :: pvflx  ! v-flux of advection/diffusion 
    315317      ! 
    316318      INTEGER    ::  ji, jj, jk 
    317       REAL(wp), DIMENSION(jpi,jpj)  :: z2d 
    318  
    319      
    320       z2d(:,:) = puflx(:,:,1)  
    321       DO_3D_00_00( 1, jpkm1 ) 
    322          z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
    323       END_3D 
    324        CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 
    325        IF( cptr == 'adv' ) THEN 
    326           IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in i-direction 
    327           IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * z2d )  ! advective salt transport in i-direction 
    328        ENDIF 
    329        IF( cptr == 'ldf' ) THEN 
    330           IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in i-direction 
    331           IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * z2d ) ! diffusive salt transport in i-direction 
    332        ENDIF 
    333        ! 
    334        z2d(:,:) = pvflx(:,:,1)  
    335        DO_3D_00_00( 1, jpkm1 ) 
    336           z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
    337        END_3D 
    338        CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 
    339        IF( cptr == 'adv' ) THEN 
    340           IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d )  ! advective heat transport in j-direction 
    341           IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * z2d )  ! advective salt transport in j-direction 
    342        ENDIF 
    343        IF( cptr == 'ldf' ) THEN 
    344           IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in j-direction 
    345           IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * z2d ) ! diffusive salt transport in j-direction 
    346        ENDIF 
    347            
     319 
     320      IF( cptr /= 'adv' .AND. cptr /= 'ldf' ) RETURN 
     321      IF( ktra /= jp_tem .AND. ktra /= jp_sal ) RETURN 
     322 
     323      IF( cptr == 'adv' ) THEN 
     324         DO_2D_00_00 
     325            hstr_adv(ji,jj,ktra,1) = puflx(ji,jj,1) 
     326            hstr_adv(ji,jj,ktra,2) = pvflx(ji,jj,1) 
     327         END_2D 
     328         DO_3D_00_00( 1, jpkm1 ) 
     329            hstr_adv(ji,jj,ktra,1) = hstr_adv(ji,jj,ktra,1) + puflx(ji,jj,jk) 
     330            hstr_adv(ji,jj,ktra,2) = hstr_adv(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
     331         END_3D 
     332      ELSE IF( cptr == 'ldf' ) THEN 
     333         DO_2D_00_00 
     334            hstr_ldf(ji,jj,ktra,1) = puflx(ji,jj,1) 
     335            hstr_ldf(ji,jj,ktra,2) = pvflx(ji,jj,1) 
     336         END_2D 
     337         DO_3D_00_00( 1, jpkm1 ) 
     338            hstr_ldf(ji,jj,ktra,1) = hstr_ldf(ji,jj,ktra,1) + puflx(ji,jj,jk) 
     339            hstr_ldf(ji,jj,ktra,2) = hstr_ldf(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
     340         END_3D 
     341      ENDIF 
     342 
     343      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     344         IF( cptr == 'adv' ) THEN 
     345            CALL lbc_lnk( 'diaar5', hstr_adv(:,:,ktra,1), 'U', -1. ) 
     346            IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,1) )  ! advective heat transport in i-direction 
     347            IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * hstr_adv(:,:,ktra,1) )  ! advective salt transport in i-direction 
     348            CALL lbc_lnk( 'diaar5', hstr_adv(:,:,ktra,2), 'V', -1. ) 
     349            IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,2) )  ! advective heat transport in j-direction 
     350            IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * hstr_adv(:,:,ktra,2) )  ! advective salt transport in j-direction 
     351         ENDIF 
     352         IF( cptr == 'ldf' ) THEN 
     353            CALL lbc_lnk( 'diaar5', hstr_ldf(:,:,ktra,1), 'U', -1. ) 
     354            IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,1) ) ! diffusive heat transport in i-direction 
     355            IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * hstr_ldf(:,:,ktra,1) ) ! diffusive salt transport in i-direction 
     356            CALL lbc_lnk( 'diaar5', hstr_ldf(:,:,ktra,2), 'V', -1. ) 
     357            IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,2) ) ! diffusive heat transport in j-direction 
     358            IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * hstr_ldf(:,:,ktra,2) ) ! diffusive salt transport in j-direction 
     359         ENDIF 
     360      ENDIF 
    348361   END SUBROUTINE dia_ar5_hst 
    349362 
     
    367380      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    368381         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    369          &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     382         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     383         &  iom_use( 'uadv_heattr' ) .OR. iom_use( 'udiff_heattr' ) .OR. & 
     384         &  iom_use( 'uadv_salttr' ) .OR. iom_use( 'udiff_salttr' ) .OR. & 
     385         &  iom_use( 'vadv_heattr' ) .OR. iom_use( 'vdiff_heattr' ) .OR. & 
     386         &  iom_use( 'vadv_salttr' ) .OR. iom_use( 'vdiff_salttr' ) ) L_ar5 = .TRUE. 
    370387   
    371388      IF( l_ar5 ) THEN 
  • NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DIA/diaptr.F90

    r12738 r13054  
    2222   USE oce              ! ocean dynamics and active tracers 
    2323   USE dom_oce          ! ocean space and time domain 
     24   USE domain, ONLY : dom_tile 
    2425   USE phycst           ! physical constants 
    2526   ! 
     
    3233   PRIVATE 
    3334 
     35   INTERFACE ptr_sum 
     36      MODULE PROCEDURE ptr_sum_3d, ptr_sum_2d 
     37   END INTERFACE 
     38 
    3439   INTERFACE ptr_sj 
    3540      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 
     
    4348 
    4449   !                                  !!** namelist  namptr  ** 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.) 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.) 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   pvtr_int, pzon_int             !: Other zonal integrals 
    4753 
    4854   LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini) 
    4955   INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc) 
     56   INTEGER, PARAMETER         ::   jp_msk = 3 
     57   INTEGER, PARAMETER         ::   jp_vtr = 4 
    5058 
    5159   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
     
    5563   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks 
    5664   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 
    57  
    58    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)   :: p_fval1d 
    59    REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 
    6065 
    6166   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
     
    6974CONTAINS 
    7075 
     76   ! TODO: Most changes and some code in this module not necessary if using XIOS (subdomain support, axis operations) 
    7177   SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 
    7278      !!---------------------------------------------------------------------- 
     
    7884      ! 
    7985      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    80       REAL(wp) ::   zsfc,zvfc               ! local scalar 
     86      INTEGER  ::   itile 
    8187      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d    ! 3D workspace 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    8588      REAL(wp), DIMENSION(jpj)      ::  zvsum, ztsum, zssum   ! 1D workspace 
    8689      ! 
     
    99102      IF( .NOT. l_diaptr )   RETURN 
    100103 
     104      ! Calculate zonal integrals 
     105      IF( PRESENT( pvtr ) ) THEN 
     106         CALL dia_ptr_zint( Kmm, pvtr ) 
     107      ELSE 
     108         CALL dia_ptr_zint( Kmm ) 
     109      ENDIF 
     110 
     111      ! Calculate diagnostics only when zonal integrals have finished 
     112      IF( ntile /= 0 .AND. ntile /= nijtile )  RETURN 
     113 
    101114      IF( PRESENT( pvtr ) ) THEN 
    102115         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF 
    103116            DO jn = 1, nptr                                    ! by sub-basins 
    104                z4d1(1,:,:,jn) =  ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  ! zonal cumulative effective transport excluding closed seas 
    105                DO jk = jpkm1, 1, -1  
     117               z4d1(1,:,:,jn) =  pvtr_int(:,:,jp_vtr,jn)                  ! zonal cumulative effective transport excluding closed seas 
     118               DO jk = jpkm1, 1, -1 
    106119                  z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn)    ! effective j-Stream-Function (MSF) 
    107120               END DO 
     
    112125            CALL iom_put( 'zomsf', z4d1 * rc_sv ) 
    113126         ENDIF 
    114          IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
    115             & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
    116             ! define fields multiplied by scalar 
    117             zmask(:,:,:) = 0._wp 
    118             zts(:,:,:,:) = 0._wp 
    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 
    125          ENDIF 
    126127         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
    127128            DO jn = 1, nptr 
    128                sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     129               sjk(:,:,jn) = pvtr_int(:,:,jp_msk,jn) 
    129130               r1_sjk(:,:,jn) = 0._wp 
    130131               WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
    131132               ! i-mean T and S, j-Stream-Function, basin 
    132                zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    133                zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    134                v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  
     133               zt_jk(:,:,jn) = pvtr_int(:,:,jp_tem,jn) * r1_sjk(:,:,jn) 
     134               zs_jk(:,:,jn) = pvtr_int(:,:,jp_sal,jn) * r1_sjk(:,:,jn) 
     135               v_msf(:,:,jn) = pvtr_int(:,:,jp_vtr,jn) 
    135136               hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 
    136137               hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 
     
    156157            ! Calculate barotropic heat and salt transport here  
    157158            DO jn = 1, nptr 
    158                sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     159               sjk(:,1,jn) = SUM( pvtr_int(:,:,jp_msk,jn), 2 ) 
    159160               r1_sjk(:,1,jn) = 0._wp 
    160161               WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
    161162               ! 
    162                zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 
    163                ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
    164                zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     163               zvsum(:) =    SUM( pvtr_int(:,:,jp_vtr,jn), 2 ) 
     164               ztsum(:) =    SUM( pvtr_int(:,:,jp_tem,jn), 2 ) 
     165               zssum(:) =    SUM( pvtr_int(:,:,jp_sal,jn), 2 ) 
    165166               hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 
    166167               hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 
     
    183184         ENDIF  
    184185         ! 
     186         hstr_ove(:,:,:) = 0._wp       ! Zero before next timestep 
     187         hstr_btr(:,:,:) = 0._wp 
     188         pvtr_int(:,:,:,:) = 0._wp 
    185189      ELSE 
    186          ! 
    187          zmask(:,:,:) = 0._wp 
    188          zts(:,:,:,:) = 0._wp 
    189          IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface  
    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 
     190         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface 
    196191            ! 
    197192            DO jn = 1, nptr 
    198                zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
    199                z4d1(:,:,:,jn) = zmask(:,:,:) 
     193               z4d1(1,:,:,jn) = pzon_int(:,:,jp_msk,jn) 
     194               DO ji = 2, jpi 
     195                  z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 
     196               ENDDO 
    200197            ENDDO 
    201198            CALL iom_put( 'zosrf', z4d1 ) 
    202199            ! 
    203200            DO jn = 1, nptr 
    204                z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
    205                   &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    206                DO ji = 1, jpi 
     201               z4d2(1,:,:,jn) = pzon_int(:,:,jp_tem,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     202               DO ji = 2, jpi 
    207203                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
    208204               ENDDO 
     
    211207            ! 
    212208            DO jn = 1, nptr 
    213                z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
    214                   &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    215                DO ji = 1, jpi 
     209               z4d2(1,:,:,jn) = pzon_int(:,:,jp_sal,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
     210               DO ji = 2, jpi 
    216211                  z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 
    217212               ENDDO 
     
    277272         ! 
    278273         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
    279             zts(:,:,:,:) = 0._wp 
    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 
    285              CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
    286              CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
    287274             DO jn = 1, nptr 
    288275                z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
     
    301288         ENDIF 
    302289         ! 
     290         ! TODO: Possibly not necessary if using XIOS (if cumulative axis operations are possible) 
    303291         IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 
     292            itile = ntile 
     293            CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )                            ! Use full domain 
    304294            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 
    305295            z2d(:,:) = ptr_ci_2d( z2d(:,:) )   
    306296            CALL iom_put( 'uocetr_vsum_cumul', z2d ) 
    307          ENDIF 
    308          ! 
     297            IF( ntile /= itile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )   ! Revert to tile domain 
     298         ENDIF 
     299         ! 
     300         hstr_adv(:,:,:) = 0._wp       ! Zero before next timestep 
     301         hstr_ldf(:,:,:) = 0._wp 
     302         hstr_eiv(:,:,:) = 0._wp 
     303         hstr_vtr(:,:,:) = 0._wp 
     304         pzon_int(:,:,:,:) = 0._wp 
    309305      ENDIF 
    310306      ! 
     
    312308      ! 
    313309   END SUBROUTINE dia_ptr 
     310 
     311 
     312   SUBROUTINE dia_ptr_zint( Kmm, pvtr ) 
     313      !!---------------------------------------------------------------------- 
     314      !!                    ***  ROUTINE dia_ptr_zint *** 
     315      !!---------------------------------------------------------------------- 
     316      !! ** Purpose : i and i-k sum operations on arrays 
     317      !! 
     318      !! ** Method  : - Call ptr_sjk (i sum) or ptr_sj (i-k sum) to perform the sum operation 
     319      !!              - Call ptr_sum to add this result to the sum over tiles 
     320      !! 
     321      !! ** Action  : pvtr_int - terms for volume streamfunction, heat/salt transport barotropic/overturning terms 
     322      !!              pzon_int - terms for i mean temperature/salinity 
     323      !!---------------------------------------------------------------------- 
     324      INTEGER                     , INTENT(in)           :: Kmm          ! time level index 
     325      REAL(wp), DIMENSION(A2D,jpk), INTENT(in), OPTIONAL :: pvtr         ! j-effective transport 
     326      REAL(wp), DIMENSION(A2D,jpk)                       :: zmask        ! 3D workspace 
     327      REAL(wp), DIMENSION(A2D,jpk,jpts)                  :: zts          ! 4D workspace 
     328      REAL(wp), DIMENSION(A1Dj,jpk,nptr)                 :: sjk, v_msf   ! Zonal sum: i-k surface area, j-effective transport 
     329      REAL(wp), DIMENSION(A1Dj,jpk,nptr)                 :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S) 
     330      REAL(wp)                                           :: zsfc, zvfc   ! i-k surface area 
     331      INTEGER  ::   ji, jj, jk, jn                                       ! dummy loop indices 
     332 
     333      IF( PRESENT( pvtr ) ) THEN 
     334         ! i sum of effective j transport excluding closed seas 
     335         IF( iom_use( 'zomsf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
     336            DO jn = 1, nptr 
     337               v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 
     338            ENDDO 
     339 
     340            CALL ptr_sum( pvtr_int(:,:,jp_vtr,:), v_msf(:,:,:) ) 
     341         ENDIF 
     342 
     343         ! i sum of j surface area, j surface area - temperature/salinity product on V grid 
     344         IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
     345            & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
     346            zmask(:,:,:) = 0._wp 
     347            zts(:,:,:,:) = 0._wp 
     348 
     349            DO_3D_10_11( 1, jpkm1 ) 
     350               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     351               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     352               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 
     353               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     354            END_3D 
     355 
     356            DO jn = 1, nptr 
     357               sjk(:,:,jn)   = ptr_sjk( zmask(:,:,:)     , btmsk(:,:,jn) ) 
     358               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     359               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     360            ENDDO 
     361 
     362            CALL ptr_sum( pvtr_int(:,:,jp_msk,:), sjk(:,:,:)   ) 
     363            CALL ptr_sum( pvtr_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 
     364            CALL ptr_sum( pvtr_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 
     365         ENDIF 
     366      ELSE 
     367         ! i sum of j surface area - temperature/salinity product on T grid 
     368         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN 
     369            zmask(:,:,:) = 0._wp 
     370            zts(:,:,:,:) = 0._wp 
     371 
     372            DO_3D_11_11( 1, jpkm1 ) 
     373               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
     374               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     375               zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
     376               zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
     377            END_3D 
     378 
     379            DO jn = 1, nptr 
     380               sjk(:,:,jn)   = ptr_sjk( zmask(:,:,:)     , btmsk(:,:,jn) ) 
     381               zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     382               zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     383            ENDDO 
     384 
     385            CALL ptr_sum( pzon_int(:,:,jp_msk,:), sjk(:,:,:)   ) 
     386            CALL ptr_sum( pzon_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 
     387            CALL ptr_sum( pzon_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 
     388         ENDIF 
     389 
     390         ! i-k sum of j surface area - temperature/salinity product on V grid 
     391         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
     392            zts(:,:,:,:) = 0._wp 
     393 
     394            DO_3D_10_11( 1, jpkm1 ) 
     395               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     396               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 
     397               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     398            END_3D 
     399 
     400            CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
     401            CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
     402         ENDIF 
     403      ENDIF 
     404   END SUBROUTINE dia_ptr_zint 
    314405 
    315406 
     
    380471         hstr_btr(:,:,:) = 0._wp           ! 
    381472         hstr_vtr(:,:,:) = 0._wp           ! 
     473         pvtr_int(:,:,:,:) = 0._wp 
     474         pzon_int(:,:,:,:) = 0._wp 
    382475         ! 
    383476         ll_init = .FALSE. 
     
    397490      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    398491      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
    399       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pvflx   ! 3D input array of advection/diffusion 
     492      REAL(wp), DIMENSION(A2D,jpk)    , INTENT(in)   :: pvflx ! 3D input array of advection/diffusion 
     493      REAL(wp), DIMENSION(A1Dj,nptr)                 :: zsj   ! 
    400494      INTEGER                                        :: jn    ! 
    401495 
     496      DO jn = 1, nptr 
     497         zsj(:,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
     498      ENDDO 
    402499      ! 
    403500      IF( cptr == 'adv' ) THEN 
    404          IF( ktra == jp_tem )  THEN 
    405              DO jn = 1, nptr 
    406                 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    407              ENDDO 
    408          ENDIF 
    409          IF( ktra == jp_sal )  THEN 
    410              DO jn = 1, nptr 
    411                 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    412              ENDDO 
    413          ENDIF 
     501         IF( ktra == jp_tem )  CALL ptr_sum( hstr_adv(:,jp_tem,:), zsj(:,:) ) 
     502         IF( ktra == jp_sal )  CALL ptr_sum( hstr_adv(:,jp_sal,:), zsj(:,:) ) 
     503      ELSE IF( cptr == 'ldf' ) THEN 
     504         IF( ktra == jp_tem )  CALL ptr_sum( hstr_ldf(:,jp_tem,:), zsj(:,:) ) 
     505         IF( ktra == jp_sal )  CALL ptr_sum( hstr_ldf(:,jp_sal,:), zsj(:,:) ) 
     506      ELSE IF( cptr == 'eiv' ) THEN 
     507         IF( ktra == jp_tem )  CALL ptr_sum( hstr_eiv(:,jp_tem,:), zsj(:,:) ) 
     508         IF( ktra == jp_sal )  CALL ptr_sum( hstr_eiv(:,jp_sal,:), zsj(:,:) ) 
     509      ELSE IF( cptr == 'vtr' ) THEN 
     510         IF( ktra == jp_tem )  CALL ptr_sum( hstr_vtr(:,jp_tem,:), zsj(:,:) ) 
     511         IF( ktra == jp_sal )  CALL ptr_sum( hstr_vtr(:,jp_sal,:), zsj(:,:) ) 
    414512      ENDIF 
    415513      ! 
    416       IF( cptr == 'ldf' ) THEN 
    417          IF( ktra == jp_tem )  THEN 
    418              DO jn = 1, nptr 
    419                 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    420              ENDDO 
    421          ENDIF 
    422          IF( ktra == jp_sal )  THEN 
    423              DO jn = 1, nptr 
    424                 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    425              ENDDO 
    426          ENDIF 
     514   END SUBROUTINE dia_ptr_hst 
     515 
     516 
     517   SUBROUTINE ptr_sum_2d( phstr, pva ) 
     518      !!---------------------------------------------------------------------- 
     519      !!                    ***  ROUTINE ptr_sum_2d *** 
     520      !!---------------------------------------------------------------------- 
     521      !! ** Purpose : Add two 2D arrays with (j,nptr) dimensions 
     522      !! 
     523      !! ** Method  : - phstr = phstr + pva 
     524      !!              - Call mpp_sum if the final tile 
     525      !! 
     526      !! ** Action  : phstr 
     527      !!---------------------------------------------------------------------- 
     528      REAL(wp), DIMENSION(jpj,nptr) , INTENT(inout)         ::  phstr  ! 
     529      REAL(wp), DIMENSION(A1Dj,nptr), INTENT(in)            ::  pva    ! 
     530      INTEGER                                               ::  jj 
     531#if defined key_mpp_mpi 
     532      INTEGER, DIMENSION(1)          ::  ish1d 
     533      INTEGER, DIMENSION(2)          ::  ish2d 
     534      REAL(wp), DIMENSION(jpj*nptr)  ::  zwork 
     535#endif 
     536 
     537      DO jj = Ntjs0, Ntje0 
     538         phstr(jj,:) = phstr(jj,:)  + pva(jj,:) 
     539      END DO 
     540 
     541#if defined key_mpp_mpi 
     542      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     543         ish1d(1) = jpj*nptr 
     544         ish2d(1) = jpj ; ish2d(2) = nptr 
     545         zwork(:) = RESHAPE( phstr(:,:), ish1d ) 
     546         CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 
     547         phstr(:,:) = RESHAPE( zwork, ish2d ) 
    427548      ENDIF 
    428       ! 
    429       IF( cptr == 'eiv' ) THEN 
    430          IF( ktra == jp_tem )  THEN 
    431              DO jn = 1, nptr 
    432                 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    433              ENDDO 
    434          ENDIF 
    435          IF( ktra == jp_sal )  THEN 
    436              DO jn = 1, nptr 
    437                 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    438              ENDDO 
    439          ENDIF 
     549#endif 
     550   END SUBROUTINE ptr_sum_2d 
     551 
     552 
     553   SUBROUTINE ptr_sum_3d( phstr, pva ) 
     554      !!---------------------------------------------------------------------- 
     555      !!                    ***  ROUTINE ptr_sum_3d *** 
     556      !!---------------------------------------------------------------------- 
     557      !! ** Purpose : Add two 3D arrays with (j,k,nptr) dimensions 
     558      !! 
     559      !! ** Method  : - phstr = phstr + pva 
     560      !!              - Call mpp_sum if the final tile 
     561      !! 
     562      !! ** Action  : phstr 
     563      !!---------------------------------------------------------------------- 
     564      REAL(wp), DIMENSION(jpj,jpk,nptr) , INTENT(inout)     ::  phstr  ! 
     565      REAL(wp), DIMENSION(A1Dj,jpk,nptr), INTENT(in)        ::  pva    ! 
     566      INTEGER                                               ::  jj, jk 
     567#if defined key_mpp_mpi 
     568      INTEGER, DIMENSION(1)              ::  ish1d 
     569      INTEGER, DIMENSION(3)              ::  ish3d 
     570      REAL(wp), DIMENSION(jpj*jpk*nptr)  ::  zwork 
     571#endif 
     572 
     573      DO jk = 1, jpk 
     574         DO jj = Ntjs0, Ntje0 
     575            phstr(jj,jk,:) = phstr(jj,jk,:)  + pva(jj,jk,:) 
     576         END DO 
     577      END DO 
     578 
     579#if defined key_mpp_mpi 
     580      IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     581         ish1d(1) = jpj*jpk*nptr 
     582         ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nptr 
     583         zwork(:) = RESHAPE( phstr(:,:,:), ish1d ) 
     584         CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 
     585         phstr(:,:,:) = RESHAPE( zwork, ish3d ) 
    440586      ENDIF 
    441       ! 
    442       IF( cptr == 'vtr' ) THEN 
    443          IF( ktra == jp_tem )  THEN 
    444              DO jn = 1, nptr 
    445                 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    446              ENDDO 
    447          ENDIF 
    448          IF( ktra == jp_sal )  THEN 
    449              DO jn = 1, nptr 
    450                 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    451              ENDDO 
    452          ENDIF 
    453       ENDIF 
    454       ! 
    455    END SUBROUTINE dia_ptr_hst 
     587#endif 
     588   END SUBROUTINE ptr_sum_3d 
    456589 
    457590 
     
    461594      !!---------------------------------------------------------------------- 
    462595      INTEGER               ::   dia_ptr_alloc   ! return value 
    463       INTEGER, DIMENSION(3) ::   ierr 
     596      INTEGER, DIMENSION(2) ::   ierr 
    464597      !!---------------------------------------------------------------------- 
    465598      ierr(:) = 0 
     
    471604            &      hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1)  ) 
    472605            ! 
    473          ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     606         ALLOCATE( pvtr_int(jpj,jpk,jpts+2,nptr), & 
     607            &      pzon_int(jpj,jpk,jpts+1,nptr), STAT=ierr(2) ) 
    474608         ! 
    475609         dia_ptr_alloc = MAXVAL( ierr ) 
     
    491625      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
    492626      !!---------------------------------------------------------------------- 
    493       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)  ::   pvflx  ! mask flux array at V-point 
    494       REAL(wp), INTENT(in), DIMENSION(jpi,jpj)      ::   pmsk   ! Optional 2D basin mask 
     627      REAL(wp), INTENT(in), DIMENSION(A2D,jpk)  ::   pvflx  ! mask flux array at V-point 
     628      REAL(wp), INTENT(in), DIMENSION(jpi,jpj)  ::   pmsk   ! Optional 2D basin mask 
    495629      ! 
    496630      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
    497       INTEGER                  ::   ijpj         ! ??? 
    498       REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
     631      REAL(wp), DIMENSION(A1Dj) :: p_fval  ! function value 
    499632      !!-------------------------------------------------------------------- 
    500633      ! 
    501       p_fval => p_fval1d 
    502  
    503       ijpj = jpj 
    504634      p_fval(:) = 0._wp 
    505635      DO_3D_00_00( 1, jpkm1 ) 
    506636         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    507637      END_3D 
    508 #if defined key_mpp_mpi 
    509       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 
    510 #endif 
    511       ! 
    512638   END FUNCTION ptr_sj_3d 
    513639 
     
    524650      !! ** Action  : - p_fval: i-k-mean poleward flux of pvflx 
    525651      !!---------------------------------------------------------------------- 
    526       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pvflx  ! mask flux array at V-point 
     652      REAL(wp) , INTENT(in), DIMENSION(A2D)    ::   pvflx  ! mask flux array at V-point 
    527653      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    528654      ! 
    529655      INTEGER                  ::   ji,jj       ! dummy loop arguments 
    530       INTEGER                  ::   ijpj        ! ??? 
    531       REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
     656      REAL(wp), DIMENSION(A1Dj) :: p_fval ! function value 
    532657      !!-------------------------------------------------------------------- 
    533658      !  
    534       p_fval => p_fval1d 
    535  
    536       ijpj = jpj 
    537659      p_fval(:) = 0._wp 
    538660      DO_2D_00_00 
    539661         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    540662      END_2D 
    541 #if defined key_mpp_mpi 
    542       CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 
    543 #endif 
    544       !  
    545663   END FUNCTION ptr_sj_2d 
    546664 
     
    587705      !! 
    588706      IMPLICIT none 
    589       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! mask flux array at V-point 
    590       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask 
     707      REAL(wp) , INTENT(in), DIMENSION(A2D,jpk) ::   pta    ! mask flux array at V-point 
     708      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pmsk   ! Optional 2D basin mask 
    591709      !! 
    592710      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
    593       REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    594 #if defined key_mpp_mpi 
    595       INTEGER, DIMENSION(1) ::   ish 
    596       INTEGER, DIMENSION(2) ::   ish2 
    597       INTEGER               ::   ijpjjpk 
    598       REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point 
    599 #endif 
     711      REAL(wp), DIMENSION(A1Dj,jpk) :: p_fval     ! return function value 
    600712      !!-------------------------------------------------------------------- 
    601713      ! 
    602       p_fval => p_fval2d 
    603  
    604714      p_fval(:,:) = 0._wp 
    605       ! 
    606715      DO_3D_00_00( 1, jpkm1 ) 
    607716         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    608717      END_3D 
    609       ! 
    610 #if defined key_mpp_mpi 
    611       ijpjjpk = jpj*jpk 
    612       ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    613       zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
    614       CALL mpp_sum( 'diaptr', zwork, ijpjjpk, ncomm_znl ) 
    615       p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    616 #endif 
    617       ! 
    618718   END FUNCTION ptr_sjk 
    619719 
  • NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/do_loop_substitute.h90

    r12979 r13054  
    114114#define Ntie2      Ntie0 + nn_hls 
    115115#define Ntje2      Ntje0 + nn_hls 
    116 #define A2D        Ntis2:Ntie2,Ntjs2:Ntje2 
     116#define A1Di       Ntis2:Ntie2 
     117#define A1Dj       Ntjs2:Ntje2 
     118#define A2D        A1Di,A1Dj 
    117119 
    118120#define DO_2D_00_00   DO jj = Ntjs0, Ntje0   ;   DO ji = Ntis0, Ntie0 
Note: See TracChangeset for help on using the changeset viewer.