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 13766 for NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DIA/diaptr.F90 – NEMO

Ignore:
Timestamp:
2020-11-10T12:57:08+01:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2475: merge with trunk rev 13688

Location:
NEMO/branches/2020/dev_12905_xios_ancil
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_12905_xios_ancil

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DIA/diaptr.F90

    r12489 r13766  
    3636   END INTERFACE 
    3737 
    38    PUBLIC   ptr_sj         ! call by tra_ldf & tra_adv routines 
    39    PUBLIC   ptr_sjk        !  
    40    PUBLIC   dia_ptr_init   ! call in memogcm 
    4138   PUBLIC   dia_ptr        ! call in step module 
    4239   PUBLIC   dia_ptr_hst    ! called from tra_ldf/tra_adv routines 
    4340 
    44    !                                  !!** namelist  namptr  ** 
    4541   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_adv, hstr_ldf, hstr_eiv   !: Heat/Salt TRansports(adv, diff, Bolus.) 
    4642   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hstr_ove, hstr_btr, hstr_vtr   !: heat Salt TRansports(overturn, baro, merional) 
    4743 
    48    LOGICAL , PUBLIC ::   l_diaptr        !: tracers  trend flag (set from namelist in trdini) 
    49    INTEGER, PARAMETER, PUBLIC ::   nptr = 5  ! (glo, atl, pac, ind, ipc) 
     44   LOGICAL, PUBLIC ::   l_diaptr       !: tracers  trend flag 
    5045 
    5146   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    … …  
    5954   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 
    6055 
    61    LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag (set from namelist in trdini) 
     56   LOGICAL ::   ll_init = .TRUE.        !: tracers  trend flag 
     57    
    6258   !! * Substitutions 
    6359#  include "do_loop_substitute.h90" 
     60#  include "domzgr_substitute.h90" 
    6461   !!---------------------------------------------------------------------- 
    6562   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8683      ! 
    8784      !overturning calculation 
    88       REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf  ! i-mean i-k-surface and its inverse 
    89       REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 
    90  
    91       REAL(wp), DIMENSION(jpi,jpj,jpk,nptr)  :: z4d1, z4d2 
    92       REAL(wp), DIMENSION(jpi,jpj,nptr)      :: z3dtr ! i-mean T and S, j-Stream-Function 
     85      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE ::  sjk, r1_sjk, v_msf  ! i-mean i-k-surface and its inverse 
     86      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE ::   zt_jk, zs_jk        ! i-mean T and S, j-Stream-Function 
     87 
     88      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  z4d1, z4d2 
     89      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE ::   z3dtr 
    9390      !!---------------------------------------------------------------------- 
    9491      ! 
    9592      IF( ln_timing )   CALL timing_start('dia_ptr') 
    9693 
    97       IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init 
    98       ! 
    99       IF( .NOT. l_diaptr )   RETURN 
    100  
     94      IF( kt == nit000 .AND. ll_init )   CALL dia_ptr_init   ! -> will define l_diaptr and nbasin 
     95      ! 
     96      IF( .NOT. l_diaptr ) THEN 
     97         IF( ln_timing ) CALL timing_stop('dia_ptr') 
     98         RETURN 
     99      ENDIF 
     100      ! 
     101      ALLOCATE( z3dtr(jpi,jpj,nbasin) ) 
     102      ! 
    101103      IF( PRESENT( pvtr ) ) THEN 
    102104         IF( iom_use( 'zomsf' ) ) THEN    ! effective MSF 
    103             DO jn = 1, nptr                                    ! by sub-basins 
     105            ALLOCATE( z4d1(jpi,jpj,jpk,nbasin) ) 
     106            DO jn = 1, nbasin                                    ! by sub-basins 
    104107               z4d1(1,:,:,jn) =  ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )  ! zonal cumulative effective transport excluding closed seas 
    105108               DO jk = jpkm1, 1, -1  
    … …  
    111114            END DO 
    112115            CALL iom_put( 'zomsf', z4d1 * rc_sv ) 
     116            DEALLOCATE( z4d1 ) 
    113117         ENDIF 
    114118         IF(  iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.   & 
    … …  
    117121            zmask(:,:,:) = 0._wp 
    118122            zts(:,:,:,:) = 0._wp 
    119             DO_3D_10_11( 1, jpkm1 ) 
     123            DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
    120124               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    121125               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
    … …  
    125129         ENDIF 
    126130         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
    127             DO jn = 1, nptr 
     131            DO jn = 1, nbasin 
     132               ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin),   & 
     133                  &                          zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 
    128134               sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
    129135               r1_sjk(:,:,jn) = 0._wp 
    … …  
    135141               hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 
    136142               hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 
     143               DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 
    137144               ! 
    138145            ENDDO 
    139             DO jn = 1, nptr 
     146            DO jn = 1, nbasin 
    140147               z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    141148               DO ji = 1, jpi 
    … …  
    144151            ENDDO 
    145152            CALL iom_put( 'sophtove', z3dtr ) 
    146             DO jn = 1, nptr 
     153            DO jn = 1, nbasin 
    147154               z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    148155               DO ji = 1, jpi 
    … …  
    155162         IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 
    156163            ! Calculate barotropic heat and salt transport here  
    157             DO jn = 1, nptr 
     164            DO jn = 1, nbasin 
     165               ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 
    158166               sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
    159167               r1_sjk(:,1,jn) = 0._wp 
    … …  
    165173               hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 
    166174               hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 
     175               DEALLOCATE( sjk, r1_sjk ) 
    167176               ! 
    168177            ENDDO 
    169             DO jn = 1, nptr 
     178            DO jn = 1, nbasin 
    170179               z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    171180               DO ji = 1, jpi 
    … …  
    174183            ENDDO 
    175184            CALL iom_put( 'sophtbtr', z3dtr ) 
    176             DO jn = 1, nptr 
     185            DO jn = 1, nbasin 
    177186               z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    178187               DO ji = 1, jpi 
    … …  
    188197         zts(:,:,:,:) = 0._wp 
    189198         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 ) 
     199            ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 
     200            DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    191201               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    192202               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    … …  
    195205            END_3D 
    196206            ! 
    197             DO jn = 1, nptr 
     207            DO jn = 1, nbasin 
    198208               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     209               DO ji = 1, jpi 
     210                  zmask(ji,:,:) = zmask(1,:,:) 
     211               ENDDO 
    199212               z4d1(:,:,:,jn) = zmask(:,:,:) 
    200213            ENDDO 
    201214            CALL iom_put( 'zosrf', z4d1 ) 
    202215            ! 
    203             DO jn = 1, nptr 
     216            DO jn = 1, nbasin 
    204217               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 
    205218                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    … …  
    210223            CALL iom_put( 'zotem', z4d2 ) 
    211224            ! 
    212             DO jn = 1, nptr 
     225            DO jn = 1, nbasin 
    213226               z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 
    214227                  &            / MAX( z4d1(1,:,:,jn), 10.e-15 ) 
    … …  
    218231            ENDDO 
    219232            CALL iom_put( 'zosal', z4d2 ) 
     233            DEALLOCATE( z4d1, z4d2 ) 
    220234            ! 
    221235         ENDIF 
    … …  
    224238         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN   
    225239            !  
    226             DO jn = 1, nptr 
     240            DO jn = 1, nbasin 
    227241               z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    228242               DO ji = 1, jpi 
    … …  
    231245            ENDDO 
    232246            CALL iom_put( 'sophtadv', z3dtr ) 
    233             DO jn = 1, nptr 
     247            DO jn = 1, nbasin 
    234248               z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    235249               DO ji = 1, jpi 
    … …  
    242256         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN   
    243257            !  
    244             DO jn = 1, nptr 
     258            DO jn = 1, nbasin 
    245259               z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    246260               DO ji = 1, jpi 
    … …  
    249263            ENDDO 
    250264            CALL iom_put( 'sophtldf', z3dtr ) 
    251             DO jn = 1, nptr 
     265            DO jn = 1, nbasin 
    252266               z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    253267               DO ji = 1, jpi 
    … …  
    260274         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN   
    261275            !  
    262             DO jn = 1, nptr 
     276            DO jn = 1, nbasin 
    263277               z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    264278               DO ji = 1, jpi 
    … …  
    267281            ENDDO 
    268282            CALL iom_put( 'sophteiv', z3dtr ) 
    269             DO jn = 1, nptr 
     283            DO jn = 1, nbasin 
    270284               z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    271285               DO ji = 1, jpi 
    … …  
    278292         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
    279293            zts(:,:,:,:) = 0._wp 
    280             DO_3D_10_11( 1, jpkm1 ) 
     294            DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 
    281295               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    282296               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 
    … …  
    285299             CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
    286300             CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
    287              DO jn = 1, nptr 
     301             DO jn = 1, nbasin 
    288302                z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW) 
    289303                DO ji = 1, jpi 
    … …  
    292306             ENDDO 
    293307             CALL iom_put( 'sophtvtr', z3dtr ) 
    294              DO jn = 1, nptr 
     308             DO jn = 1, nbasin 
    295309               z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram !  (conversion in Gg) 
    296310               DO ji = 1, jpi 
    … …  
    309323      ENDIF 
    310324      ! 
     325      DEALLOCATE( z3dtr ) 
     326      ! 
    311327      IF( ln_timing )   CALL timing_stop('dia_ptr') 
    312328      ! 
    … …  
    318334      !!                  ***  ROUTINE dia_ptr_init  *** 
    319335      !!                    
    320       !! ** Purpose :   Initialization, namelist read 
     336      !! ** Purpose :   Initialization 
    321337      !!---------------------------------------------------------------------- 
    322338      INTEGER ::  inum, jn           ! local integers 
    … …  
    324340      REAL(wp), DIMENSION(jpi,jpj) :: zmsk 
    325341      !!---------------------------------------------------------------------- 
    326  
    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  
     342       
     343      ! l_diaptr is defined with iom_use 
     344      !   --> dia_ptr_init must be done after the call to iom_init 
     345      !   --> cannot be .TRUE. without cpp key: key_iom -->  nbasin define by iom_init is initialized 
     346      l_diaptr = iom_use( 'zomsf'    ) .OR. iom_use( 'zotem'    ) .OR. iom_use( 'zosal'    ) .OR.  & 
     347         &       iom_use( 'zosrf'    ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR.  & 
     348         &       iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR.  & 
     349         &       iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR.  &  
     350         &       iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  & 
     351         &       iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' )  
    335352  
    336353      IF(lwp) THEN                     ! Control print 
    … …  
    338355         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 
    339356         WRITE(numout,*) '~~~~~~~~~~~~' 
    340          WRITE(numout,*) '   Namelist namptr : set ptr parameters' 
    341357         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      l_diaptr  = ', l_diaptr 
    342358      ENDIF 
    … …  
    345361         ! 
    346362         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    347  
     363         ! 
    348364         rc_pwatt = rc_pwatt * rho0_rcp          ! conversion from K.s-1 to PetaWatt 
    349365         rc_ggram = rc_ggram * rho0              ! conversion from m3/s to Gg/s 
    … …  
    352368 
    353369         btmsk(:,:,1) = tmask_i(:,:)                  
    354          CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
    355          CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
    356          CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
    357          CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
    358          CALL iom_close( inum ) 
    359          btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
    360          DO jn = 2, nptr 
    361             btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
     370         IF( nbasin == 5 ) THEN   ! nbasin has been initialized in iom_init to define the axis "basin" 
     371            CALL iom_open( 'subbasins', inum ) 
     372            CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
     373            CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
     374            CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
     375            CALL iom_close( inum ) 
     376            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )            ! Indo-Pacific basin 
     377         ENDIF 
     378         DO jn = 2, nbasin 
     379            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)                 ! interior domain only 
    362380         END DO 
    363381         ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations 
    … …  
    368386         END WHERE 
    369387         btmsk34(:,:,1) = btmsk(:,:,1)                  
    370          DO jn = 2, nptr 
    371             btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)               ! interior domain only 
     388         DO jn = 2, nbasin 
     389            btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)                  ! interior domain only 
    372390         ENDDO 
    373391 
    … …  
    403421      IF( cptr == 'adv' ) THEN 
    404422         IF( ktra == jp_tem )  THEN 
    405              DO jn = 1, nptr 
     423             DO jn = 1, nbasin 
    406424                hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    407425             ENDDO 
    408426         ENDIF 
    409427         IF( ktra == jp_sal )  THEN 
    410              DO jn = 1, nptr 
     428             DO jn = 1, nbasin 
    411429                hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    412430             ENDDO 
    … …  
    416434      IF( cptr == 'ldf' ) THEN 
    417435         IF( ktra == jp_tem )  THEN 
    418              DO jn = 1, nptr 
     436             DO jn = 1, nbasin 
    419437                hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    420438             ENDDO 
    421439         ENDIF 
    422440         IF( ktra == jp_sal )  THEN 
    423              DO jn = 1, nptr 
     441             DO jn = 1, nbasin 
    424442                hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    425443             ENDDO 
    … …  
    429447      IF( cptr == 'eiv' ) THEN 
    430448         IF( ktra == jp_tem )  THEN 
    431              DO jn = 1, nptr 
     449             DO jn = 1, nbasin 
    432450                hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    433451             ENDDO 
    434452         ENDIF 
    435453         IF( ktra == jp_sal )  THEN 
    436              DO jn = 1, nptr 
     454             DO jn = 1, nbasin 
    437455                hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    438456             ENDDO 
    … …  
    442460      IF( cptr == 'vtr' ) THEN 
    443461         IF( ktra == jp_tem )  THEN 
    444              DO jn = 1, nptr 
     462             DO jn = 1, nbasin 
    445463                hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    446464             ENDDO 
    447465         ENDIF 
    448466         IF( ktra == jp_sal )  THEN 
    449              DO jn = 1, nptr 
     467             DO jn = 1, nbasin 
    450468                hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 
    451469             ENDDO 
    … …  
    465483      ierr(:) = 0 
    466484      ! 
     485      ! nbasin has been initialized in iom_init to define the axis "basin" 
     486      ! 
    467487      IF( .NOT. ALLOCATED( btmsk ) ) THEN 
    468          ALLOCATE( btmsk(jpi,jpj,nptr)    , btmsk34(jpi,jpj,nptr),   & 
    469             &      hstr_adv(jpj,jpts,nptr), hstr_eiv(jpj,jpts,nptr), & 
    470             &      hstr_ove(jpj,jpts,nptr), hstr_btr(jpj,jpts,nptr), & 
    471             &      hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1)  ) 
     488         ALLOCATE( btmsk(jpi,jpj,nbasin)    , btmsk34(jpi,jpj,nbasin),   & 
     489            &      hstr_adv(jpj,jpts,nbasin), hstr_eiv(jpj,jpts,nbasin), & 
     490            &      hstr_ove(jpj,jpts,nbasin), hstr_btr(jpj,jpts,nbasin), & 
     491            &      hstr_ldf(jpj,jpts,nbasin), hstr_vtr(jpj,jpts,nbasin), STAT=ierr(1)  ) 
    472492            ! 
    473493         ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
    … …  
    503523      ijpj = jpj 
    504524      p_fval(:) = 0._wp 
    505       DO_3D_00_00( 1, jpkm1 ) 
     525      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    506526         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    507527      END_3D 
    … …  
    536556      ijpj = jpj 
    537557      p_fval(:) = 0._wp 
    538       DO_2D_00_00 
     558      DO_2D( 0, 0, 0, 0 ) 
    539559         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    540560      END_2D 
    … …  
    565585      p_fval(:,:) = 0._wp 
    566586      DO jc = 1, jpnj ! looping over all processors in j axis 
    567          DO_2D_00_00 
     587         DO_2D( 0, 0, 0, 0 ) 
    568588            p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
    569589         END_2D 
    570          CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 
     590         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1.0_wp ) 
    571591      END DO 
    572592      !  
    … …  
    604624      p_fval(:,:) = 0._wp 
    605625      ! 
    606       DO_3D_00_00( 1, jpkm1 ) 
     626      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    607627         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    608628      END_3D 
Note: See TracChangeset for help on using the changeset viewer.