Changeset 12325


Ignore:
Timestamp:
2020-01-15T13:26:22+01:00 (13 days ago)
Author:
francesca
Message:

replace halo-copy routines - ticket #2009

Location:
NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/DOM/dom_oce.F90

    r10068 r12325  
    116116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
    117117   ! 
    118    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    119    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t                    !: associated metrics at t-point 
     119 
     120   REAL(wp), PUBLIC, POINTER             , DIMENSION(:,:) ::   r1_e1e2t, r1_e1e2u, r1_e1e2v                        !: associated metrics at t-point 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u     , e2_e1u       !: associated metrics at u-point 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v  , e1_e2v       !: associated metrics at v-point 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f  , r1_e1e2f                !: associated metrics at f-point 
    122124   ! 
    123125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s] 
     
    130132   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
    131133   !                                                        !  ref.   ! before  !   now   ! after  ! 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    133    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    138    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,  e3t_a   !: t- vert. scale factor [m] 
     135   REAL(wp), PUBLIC, POINTER  , SAVE, DIMENSION(:,:,:) ::      e3t_n ,   e3u_n ,  e3v_n,  e3w_n 
     136 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_a   !: u- vert. scale factor [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_a   !: v- vert. scale factor [m] 
     139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n   !: f- vert. scale factor [m] 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b            !: w- vert. scale factor [m] 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n   !: uw-vert. scale factor [m] 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n   !: vw-vert. scale factor [m] 
    139143 
    140144   !                                                        !  ref.   ! before  !   now   ! 
     
    171175 
    172176   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF) 
    173    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF) 
     177   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF) 
     178   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:) ::   mikt           !: top first wet T-, U-, V-, F-level (ISF) 
    174179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF) 
    175180 
    176181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
    177    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    178    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
     182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fmask   !: land/ocean mask at T-, U-, V- and F-pts 
     183   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, wmask   !: land/ocean mask at T-, U-, V- and F-pts 
     184 
     185   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    179186 
    180187   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/LBC/halo_mng.F90

    r11720 r12325  
    1111 
    1212   USE dom_oce       ! ocean space and time domain 
     13   USE lbclnk        ! ocean lateral boundary condition (or mpp link)  
    1314 
    1415   IMPLICIT NONE 
    1516   PRIVATE 
    1617 
    17    INTERFACE halo_mng_copy 
    18       MODULE PROCEDURE halo_mng_copy_2D, halo_mng_copy_3d, halo_mng_copy_4d 
     18   INTERFACE halo_mng_resize 
     19      MODULE PROCEDURE halo_mng_resize_2D, halo_mng_resize_3d, halo_mng_resize_4d 
    1920   END INTERFACE 
    2021 
    21    PUBLIC halo_mng_copy 
     22   PUBLIC halo_mng_resize 
    2223   PUBLIC halo_mng_init 
    2324   PUBLIC halo_mng_set 
     
    6768   END SUBROUTINE halo_mng_set 
    6869    
    69    SUBROUTINE halo_mng_copy_2D(pta_1, pta_2) 
    70       !!---------------------------------------------------------------------- 
    71       !!                  ***  ROUTINE halo_mng_copy  *** 
    72       !! 
    73       !! ** Purpose : copy pta_1 into pta_2 
    74       !! ** Method  : 
    75       !! History : 
    76       !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy 
    77       !!---------------------------------------------------------------------- 
    78        REAL(wp), DIMENSION(:,:), INTENT(in)  :: pta_1 
    79        REAL(wp), DIMENSION(:,:), INTENT(out)  :: pta_2 
    80        INTEGER :: halo, off1, off2 
    81        INTEGER, DIMENSION(2) :: dim 
     70   SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval) 
     71    
     72      REAL(wp), POINTER, DIMENSION(:,:) :: pta 
     73      CHARACTER(len=1), INTENT(in)  :: cdna 
     74      REAL(wp), INTENT(in)  :: psgn 
     75      REAL(wp), OPTIONAL, INTENT(in ) :: fillval 
     76      REAL(wp), POINTER, DIMENSION(:,:) :: zpta 
     77      INTEGER :: offset 
     78      INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
    8279 
    83        halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 
    84        IF (halo < 0) THEN 
    85           off1 = 0 
    86           off2 = -halo 
    87           dim = SHAPE(pta_1) 
    88        ELSE 
    89           off1 = halo 
    90           off2 = 0 
    91           dim = SHAPE(pta_2) 
    92        END IF 
    93          
    94        pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1) 
    95         
    96      
    97    END SUBROUTINE halo_mng_copy_2D 
     80      pta_size_i = SIZE(pta,1) 
     81      pta_size_j = SIZE(pta,2) 
     82      exp_size_i = jpi - jplbi + 1 
     83      exp_size_j = jpj - jplbj + 1 
     84       
     85      ! check if the current size of pta is equal to the current expected dimension 
     86      IF (pta_size_i .ne. exp_size_i) THEN 
     87         ALLOCATE (zpta(jplbi:jpi, jplbj:jpj)) 
     88         offset = (exp_size_i - pta_size_i) / 2  
    9889 
    99    SUBROUTINE halo_mng_copy_3D(pta_1, pta_2) 
    100       !!---------------------------------------------------------------------- 
    101       !!                  ***  ROUTINE halo_mng_copy  *** 
    102       !! 
    103       !! ** Purpose : copy pta_1 into pta_2 
    104       !! ** Method  : 
    105       !! History : 
    106       !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy 
    107       !!---------------------------------------------------------------------- 
    108        REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pta_1 
    109        REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pta_2 
     90         IF (pta_size_i .lt. exp_size_i) THEN 
     91            zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1) = pta 
     92         ELSE 
     93            zpta = pta(jplbi : jpi, jplbj : jpj) 
     94         END IF 
     95         CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) 
     96         DEALLOCATE(pta) 
     97         pta => zpta 
     98      END IF 
     99       
     100   END SUBROUTINE halo_mng_resize_2D 
    110101 
    111        INTEGER :: halo, off1, off2 
    112        INTEGER, DIMENSION(3) :: dim 
     102   SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval) 
     103    
     104      REAL(wp), POINTER, DIMENSION(:,:,:) :: pta 
     105      CHARACTER(len=1), INTENT(in)  :: cdna 
     106      REAL(wp), INTENT(in)  :: psgn 
     107      REAL(wp), OPTIONAL, INTENT(in ) :: fillval 
     108      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 
     109      INTEGER :: offset 
     110      INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
    113111 
    114        halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 
    115        IF (halo < 0) THEN 
    116           off1 = 0 
    117           off2 = -halo 
    118           dim = SHAPE(pta_1) 
    119        ELSE 
    120           off1 = halo 
    121           off2 = 0 
    122           dim = SHAPE(pta_2) 
    123        END IF 
    124          
    125        pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:)  
     112      pta_size_i = SIZE(pta,1) 
     113      pta_size_j = SIZE(pta,2) 
     114      exp_size_i = jpi - jplbi + 1 
     115      exp_size_j = jpj - jplbj + 1 
     116       
     117      ! check if the current size of pta is equal to the current expected dimension 
     118      IF (pta_size_i .ne. exp_size_i) THEN 
     119         ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk)) 
     120         offset = (exp_size_i - pta_size_i) / 2  
    126121 
    127    END SUBROUTINE halo_mng_copy_3D 
     122         IF (pta_size_i .lt. exp_size_i) THEN 
     123            zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :) = pta 
     124         ELSE 
     125            zpta = pta(jplbi : jpi, jplbj : jpj, :) 
     126         END IF 
     127         CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) 
     128         DEALLOCATE(pta) 
     129         pta => zpta 
     130      END IF 
     131       
     132   END SUBROUTINE halo_mng_resize_3D 
    128133 
    129    SUBROUTINE halo_mng_copy_4D(pta_1, pta_2) 
    130       !!---------------------------------------------------------------------- 
    131       !!                  ***  ROUTINE halo_mng_copy  *** 
    132       !! 
    133       !! ** Purpose : copy pta_1 into pta_2 
    134       !! ** Method  : 
    135       !! History : 
    136       !!   1.0  !  07-19  ( CMCC - ASC )  halo_mng_copy 
    137       !!---------------------------------------------------------------------- 
    138        REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pta_1 
    139        REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pta_2 
    140        INTEGER :: halo, off1, off2 
    141        INTEGER, DIMENSION(4) :: dim 
     134   SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, kjpt) 
     135    
     136      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta 
     137      CHARACTER(len=1), INTENT(in)  :: cdna 
     138      REAL(wp), INTENT(in)  :: psgn 
     139      REAL(wp), OPTIONAL, INTENT(in) :: fillval 
     140      INTEGER , OPTIONAL, INTENT(in) ::   kjpt            ! number of tracers 
     141      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 
     142      INTEGER :: offset 
     143      INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
    142144 
    143        halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 
    144        IF (halo < 0) THEN 
    145           off1 = 0 
    146           off2 = -halo 
    147           dim = SHAPE(pta_1) 
    148        ELSE 
    149           off1 = halo 
    150           off2 = 0 
    151           dim = SHAPE(pta_2) 
    152        END IF 
    153          
    154        pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:,:) 
     145      pta_size_i = SIZE(pta,1) 
     146      pta_size_j = SIZE(pta,2) 
     147      exp_size_i = jpi - jplbi + 1 
     148      exp_size_j = jpj - jplbj + 1 
     149       
     150      ! check if the current size of pta is equal to the current expected dimension 
     151      IF (pta_size_i .ne. exp_size_i) THEN 
     152         ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk, kjpt)) 
     153         offset = (exp_size_i - pta_size_i) / 2  
    155154 
    156    END SUBROUTINE halo_mng_copy_4D 
     155         IF (pta_size_i .lt. exp_size_i) THEN 
     156            zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :) = pta 
     157         ELSE 
     158            zpta = pta(jplbi : jpi, jplbj : jpj, :, :) 
     159         END IF 
     160         CALL lbc_lnk( 'halo_mng_resize_4D', zpta, cdna, psgn, pfillval=fillval) 
     161         DEALLOCATE(pta) 
     162         pta => zpta 
     163      END IF 
     164       
     165   END SUBROUTINE halo_mng_resize_4D 
     166    
    157167END MODULE 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/SBC/sbcrnf.F90

    r11692 r12325  
    5858   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths 
    5959    
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
     60   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
    6161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.) 
    6262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/TRA/traadv.F90

    r11692 r12325  
    8686      ! 
    8787      INTEGER ::   jk   ! dummy loop index 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace 
     88      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zun, zvn, zwn   ! 3D workspace 
    8989      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
    9090      !!---------------------------------------------------------------------- 
    9191      ! 
    9292      IF( ln_timing )   CALL timing_start('tra_adv') 
     93      ALLOCATE( zun(jpi,jpj,jpk), zvn(jpi,jpj,jpk), zwn(jpi,jpj,jpk) ) 
    9394      ! 
    9495      !                                          ! set time step 
     
    171172         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    172173      ! 
     174      DEALLOCATE( zun, zvn, zwn ) 
    173175      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
    174176      ! 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/TRA/traadv_mus.F90

    r11719 r12325  
    2828   USE iom            ! XIOS library 
    2929   USE in_out_manager ! I/O manager 
    30    USE lib_mpp        ! distribued memory computing 
    31    USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    3230   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3331   USE halo_mng 
     
    3836   PUBLIC   tra_adv_mus   ! routine called by traadv.F90 
    3937    
    40    REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) ::   r1_e1e2t_exh2, r1_e1e2u_exh2, r1_e1e2v_exh2 
    41    REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) ::   rnfmsk_exh2, upsmsk_exh2, mikt_exh2 
    42    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   tmask_exh2, wmask_exh2, umask_exh2, vmask_exh2 
    43    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   e3u_n_exh2, e3v_n_exh2, e3t_n_exh2, e3w_n_exh2 
    44    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   pun_exh2, pvn_exh2, pwn_exh2   ! 3 ocean velocity components 
    45    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ptb_exh2, pta_exh2        ! before and now tracer fields 
    46  
    47     
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
     38   REAL(wp), POINTER, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
    4939   !                                                           !  and in closed seas (orca 2 and 1 configurations) 
    5040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
     
    8373      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation 
    8474      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    85       !!---------------------------------------------------------------------- 
     75      !!----------------------------------------------------------------------  
    8676      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8777      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     
    9080      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    9181      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     82      REAL(wp), POINTER, DIMENSION(:,:,:)  , INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     83      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout) ::   pta             ! tracer trend 
     84      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(in   ) ::   ptb             ! before tracer trend  
    9585      ! 
    96       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    97       INTEGER  ::   last_khls, ierr             ! local integer 
     86      INTEGER  ::   ji, jj, jk, jn, ierr   ! dummy loop indices 
    9887      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
    9988      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
     
    10291      !!---------------------------------------------------------------------- 
    10392      ! 
    104        
    105    CALL halo_mng_set(jphls) 
    106     
    107    ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 
    108    ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 
    109    ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 
    110    ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 
    111  
    112    IF (kt==kit000) THEN 
    113       if (.not. allocated(pun_exh2))   ALLOCATE(pun_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    114       if (.not. allocated(pvn_exh2))   ALLOCATE(pvn_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    115       if (.not. allocated(pwn_exh2))   ALLOCATE(pwn_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    116       if (.not. allocated(ptb_exh2))   ALLOCATE(ptb_exh2(jplbi:jpi,jplbj:jpj,jpk,kjpt)) 
    117       if (.not. allocated(pta_exh2))   ALLOCATE(pta_exh2(jplbi:jpi,jplbj:jpj,jpk,kjpt)) 
    118       if (.not. allocated(r1_e1e2t_exh2)) ALLOCATE(r1_e1e2t_exh2(jplbi:jpi,jplbj:jpj)) 
    119       if (.not. allocated(r1_e1e2u_exh2)) ALLOCATE(r1_e1e2u_exh2(jplbi:jpi,jplbj:jpj)) 
    120       if (.not. allocated(r1_e1e2v_exh2)) ALLOCATE(r1_e1e2v_exh2(jplbi:jpi,jplbj:jpj)) 
    121       if (.not. allocated(tmask_exh2)) ALLOCATE(tmask_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    122       if (.not. allocated(wmask_exh2)) ALLOCATE(wmask_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    123       if (.not. allocated(umask_exh2)) ALLOCATE(umask_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    124       if (.not. allocated(vmask_exh2)) ALLOCATE(vmask_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    125       if (.not. allocated(e3u_n_exh2)) ALLOCATE(e3u_n_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    126       if (.not. allocated(e3v_n_exh2)) ALLOCATE(e3v_n_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    127       if (.not. allocated(e3t_n_exh2)) ALLOCATE(e3t_n_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    128       if (.not. allocated(e3w_n_exh2)) ALLOCATE(e3w_n_exh2(jplbi:jpi,jplbj:jpj,jpk)) 
    129       IF( ln_isfcav.and..not.allocated(mikt_exh2)) ALLOCATE(mikt_exh2(jplbi:jpi,jplbj:jpj)) 
    130       IF( ld_msc_ups.and..not.allocated(rnfmsk_exh2)) ALLOCATE(rnfmsk_exh2(jplbi:jpi,jplbj:jpj)) 
    131       IF( ld_msc_ups.and..not.allocated(upsmsk_exh2)) ALLOCATE(upsmsk_exh2(jplbi:jpi,jplbj:jpj)) 
    132  
    133       CALL halo_mng_copy(r1_e1e2t, r1_e1e2t_exh2) 
    134       CALL halo_mng_copy(r1_e1e2u, r1_e1e2u_exh2) 
    135       CALL halo_mng_copy(r1_e1e2v, r1_e1e2v_exh2) 
    136       CALL halo_mng_copy(tmask, tmask_exh2) 
    137       CALL halo_mng_copy(wmask, wmask_exh2) 
    138       CALL halo_mng_copy(umask, umask_exh2) 
    139       CALL halo_mng_copy(vmask, vmask_exh2) 
    140  
    141       CALL lbc_lnk( 'traadv_mus', r1_e1e2u_exh2, 'U', -1.) 
    142       CALL lbc_lnk( 'traadv_mus', r1_e1e2v_exh2, 'V', -1.) 
    143       CALL lbc_lnk( 'traadv_mus', r1_e1e2t_exh2, 'T', 1.) 
    144       CALL lbc_lnk( 'traadv_mus', tmask_exh2, 'T', 1. ) 
    145       CALL lbc_lnk( 'traadv_mus', wmask_exh2, 'W', 1.) 
    146       CALL lbc_lnk( 'traadv_mus', umask_exh2, 'U', 1. ) 
    147       CALL lbc_lnk( 'traadv_mus', vmask_exh2, 'V', 1.) 
    148    ENDIF 
    149     
    150    IF( ln_isfcav ) THEN ; CALL halo_mng_copy(REAL(mikt), mikt_exh2) ; CALL lbc_lnk( 'traadv_mus', mikt_exh2, 'T', 1.) ; ENDIF 
    151    IF( ld_msc_ups) THEN ; CALL halo_mng_copy(rnfmsk, rnfmsk_exh2) ; CALL lbc_lnk( 'traadv_mus', rnfmsk_exh2, 'T', 1.) ; ENDIF 
    152    IF( ld_msc_ups) THEN ; CALL halo_mng_copy(upsmsk, upsmsk_exh2) ; CALL lbc_lnk( 'traadv_mus', upsmsk_exh2, 'T', 1.) ; ENDIF 
    153  
    154    CALL halo_mng_copy(e3u_n, e3u_n_exh2) 
    155    CALL halo_mng_copy(e3v_n, e3v_n_exh2) 
    156    CALL halo_mng_copy(e3t_n, e3t_n_exh2) 
    157    CALL halo_mng_copy(e3w_n, e3w_n_exh2) 
    158    CALL halo_mng_copy(pun, pun_exh2) 
    159    CALL halo_mng_copy(pvn, pvn_exh2) 
    160    CALL halo_mng_copy(pwn, pwn_exh2) 
    161    CALL halo_mng_copy(ptb, ptb_exh2) 
    162    CALL halo_mng_copy(pta, pta_exh2) 
    163  
    164    CALL lbc_lnk( 'traadv_mus', e3u_n_exh2, 'U', -1., pfillval = 1.0_wp ) 
    165    CALL lbc_lnk( 'traadv_mus', e3v_n_exh2, 'V', -1., pfillval = 1.0_wp ) 
    166    CALL lbc_lnk( 'traadv_mus', e3t_n_exh2, 'T', 1., pfillval = 1.0_wp ) 
    167    CALL lbc_lnk( 'traadv_mus', e3w_n_exh2, 'W', 1., pfillval = 1.0_wp ) 
    168    CALL lbc_lnk( 'traadv_mus', pun_exh2, 'U', -1.) 
    169    CALL lbc_lnk( 'traadv_mus', pvn_exh2, 'V', -1.) 
    170    CALL lbc_lnk( 'traadv_mus', pwn_exh2, 'W', 1.) 
    171    CALL lbc_lnk( 'traadv_mus', pta_exh2, 'T', 1.) 
    172    CALL lbc_lnk( 'traadv_mus', ptb_exh2, 'T', 1.) 
    173  
    174 #     define pun pun_exh2 
    175 #     define pvn pvn_exh2 
    176 #     define pwn pwn_exh2 
    177 #     define ptb ptb_exh2 
    178 #     define pta pta_exh2 
    179 #     define r1_e1e2t r1_e1e2t_exh2 
    180 #     define r1_e1e2u r1_e1e2u_exh2 
    181 #     define r1_e1e2v r1_e1e2v_exh2 
    182 #     define tmask tmask_exh2 
    183 #     define wmask wmask_exh2 
    184 #     define umask umask_exh2 
    185 #     define vmask vmask_exh2 
    186 #     define e3u_n e3u_n_exh2 
    187 #     define e3v_n e3v_n_exh2 
    188 #     define e3t_n e3t_n_exh2 
    189 #     define e3w_n e3w_n_exh2 
    190 #     define mikt mikt_exh2 
    191 #     define rnfmsk rnfmsk_exh2 
    192 #     define upsmsk upsmsk_exh2 
     93      CALL halo_mng_set(jphls) 
     94       
     95      ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 
     96      ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 
     97      ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 
     98      ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 
     99       
     100      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
     101      CALL halo_mng_resize(r1_e1e2u,'U', -1._wp) 
     102      CALL halo_mng_resize(r1_e1e2v,'V', -1._wp) 
     103      CALL halo_mng_resize(tmask,'T', 1._wp) 
     104      CALL halo_mng_resize(ptb, 'T', 1._wp, kjpt=kjpt ) 
     105      CALL halo_mng_resize(pta, 'T', 1._wp, kjpt=kjpt) 
     106      CALL halo_mng_resize(wmask, 'W', 1._wp) 
     107      CALL halo_mng_resize(umask, 'U', 1._wp) 
     108      CALL halo_mng_resize(vmask, 'V', 1._wp) 
     109      CALL halo_mng_resize(e3t_n,'T', 1._wp, fillval=1._wp) 
     110      CALL halo_mng_resize(e3u_n, 'U', -1._wp, fillval=1._wp) 
     111      CALL halo_mng_resize(e3v_n, 'V', -1._wp, fillval=1._wp) 
     112      CALL halo_mng_resize(e3w_n, 'W', 1._wp, fillval=1._wp) 
     113      CALL halo_mng_resize(pun, 'U', -1._wp) 
     114      CALL halo_mng_resize(pvn, 'V', -1._wp) 
     115      CALL halo_mng_resize(pwn, 'W', 1._wp) 
     116       
     117      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
     118      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
     119      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
    193120 
    194121      IF( kt == kit000 )  THEN 
     
    373300      END DO                     ! end of tracer loop 
    374301      ! 
    375 #     undef pun 
    376 #     undef pvn 
    377 #     undef pwn 
    378 #     undef ptb 
    379 #     undef pta 
    380 #     undef r1_e1e2t 
    381 #     undef r1_e1e2u 
    382 #     undef r1_e1e2v 
    383 #     undef tmask 
    384 #     undef wmask 
    385 #     undef umask 
    386 #     undef vmask 
    387 #     undef e3u_n 
    388 #     undef e3v_n 
    389 #     undef e3t_n 
    390 #     undef e3w_n 
    391 #     undef mikt 
    392 #     undef rnfmsk 
    393 #     undef upsmsk 
    394  
    395    CALL halo_mng_copy(pta_exh2, pta) 
    396  
    397     last_khls = jphls - ((SIZE(pta_exh2, 1) - SIZE(pta, 1))/2) 
    398  
    399     CALL halo_mng_set(last_khls) 
    400  
    401    CALL lbc_lnk( 'traadv_mus', pta, 'T', 1. ) 
    402  
    403    IF( kt==nitend ) THEN 
    404       if (allocated(pun_exh2)) DEALLOCATE(pun_exh2) 
    405       if (allocated(pvn_exh2)) DEALLOCATE(pvn_exh2) 
    406       if (allocated(pwn_exh2)) DEALLOCATE(pwn_exh2) 
    407          if (allocated(ptb_exh2)) DEALLOCATE(ptb_exh2) 
    408       if (allocated(pta_exh2)) DEALLOCATE(pta_exh2) 
    409       if (allocated(r1_e1e2t_exh2)) DEALLOCATE(r1_e1e2t_exh2) 
    410       if (allocated(r1_e1e2u_exh2)) DEALLOCATE(r1_e1e2u_exh2) 
    411       if (allocated(r1_e1e2v_exh2)) DEALLOCATE(r1_e1e2v_exh2) 
    412       if (allocated(tmask_exh2)) DEALLOCATE(tmask_exh2) 
    413       if (allocated(wmask_exh2)) DEALLOCATE(wmask_exh2) 
    414       if (allocated(umask_exh2)) DEALLOCATE(umask_exh2) 
    415       if (allocated(vmask_exh2)) DEALLOCATE(vmask_exh2) 
    416       if (allocated(e3u_n_exh2)) DEALLOCATE(e3u_n_exh2) 
    417       if (allocated(e3v_n_exh2)) DEALLOCATE(e3v_n_exh2) 
    418       if (allocated(e3t_n_exh2)) DEALLOCATE(e3t_n_exh2) 
    419       if (allocated(e3w_n_exh2)) DEALLOCATE(e3w_n_exh2) 
    420          IF (ln_isfcav.and.allocated(mikt_exh2)) DEALLOCATE(mikt_exh2) 
    421          IF( ld_msc_ups.and.allocated(rnfmsk_exh2)) DEALLOCATE(rnfmsk_exh2) 
    422       IF( ld_msc_ups.and.allocated(upsmsk_exh2)) DEALLOCATE(upsmsk_exh2) 
    423  
    424     ENDIF 
    425  
    426    DEALLOCATE(zwx,zwy) 
    427     DEALLOCATE(zslpx,zslpy) 
    428    END SUBROUTINE tra_adv_mus 
     302      CALL halo_mng_set(1) 
     303       
     304      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
     305      CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 
     306      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
     307      CALL halo_mng_resize(ptb, 'T', 1._wp, kjpt=kjpt) 
     308      CALL halo_mng_resize(pta, 'T', 1._wp, kjpt=kjpt) 
     309      CALL halo_mng_resize(tmask,'T', 1._wp) 
     310      CALL halo_mng_resize(wmask, 'W', 1._wp) 
     311      CALL halo_mng_resize(umask, 'U', 1._wp) 
     312      CALL halo_mng_resize(vmask, 'V', 1._wp) 
     313      CALL halo_mng_resize(e3t_n,'T', 1._wp, fillval=1._wp) 
     314      CALL halo_mng_resize(e3u_n, 'U', 1._wp, fillval=1._wp) 
     315      CALL halo_mng_resize(e3v_n, 'V', 1._wp, fillval=1._wp) 
     316      CALL halo_mng_resize(e3w_n, 'W', 1._wp, fillval=1._wp) 
     317      CALL halo_mng_resize(pun, 'U', 1._wp) 
     318      CALL halo_mng_resize(pvn, 'V', 1._wp) 
     319      CALL halo_mng_resize(pwn, 'W', 1._wp) 
     320      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
     321      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
     322      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
     323       
     324      DEALLOCATE(zwx,zwy) 
     325      DEALLOCATE(zslpx,zslpy) 
     326       
     327    END SUBROUTINE tra_adv_mus 
    429328 
    430329   !!====================================================================== 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/ZDF/zdfdrg.F90

    r11692 r12325  
    276276      IF( ln_isfcav ) THEN              ! Ocean cavities: top friction setting 
    277277         ALLOCATE( rCd0_top(jpi,jpj), rCdU_top(jpi,jpj) ) 
    278          CALL drg_init( 'TOP   '   , mikt       ,                                         &   ! <== in 
     278         CALL drg_init( 'TOP   '   , INT(mikt)       ,                                         &   ! <== in 
    279279            &           r_Cdmin_top, r_Cdmax_top, r_z0_top, r_ke0_top, rCd0_top, rCdU_top )   ! ==> out 
    280280      ENDIF 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/ZDF/zdfphy.F90

    r11692 r12325  
    246246            &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s] 
    247247         IF( ln_isfcav ) THEN    !* top drag   (ocean cavities) 
    248             CALL zdf_drg( kt, mikt    , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
     248            CALL zdf_drg( kt, INT(mikt)    , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
    249249               &              r_z0_top,   r_ke0_top,    rCd0_top,   & 
    250250               &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s] 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/oce.F90

    r10425 r12325  
    2424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wi             !: vertical vel. (adaptive-implicit) [m/s] 
    2525   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1] 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celsius,psu]  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsn                 !: 4D T-S fields                  [Celsius,psu]  
     27   REAL(wp), PUBLIC, POINTER  , SAVE, DIMENSION(:,:,:,:) ::   tsb  , tsa    !: 4D T-S fields                  [Celsius,psu]  
     28 
    2729   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    2830   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/TOP/TRP/trcadv.F90

    r11692 r12325  
    8080      INTEGER ::   jk   ! dummy loop index 
    8181      CHARACTER (len=22) ::   charout 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity 
     82      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zun, zvn, zwn   ! effective velocity 
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    8585      IF( ln_timing )   CALL timing_start('trc_adv') 
     86     ALLOCATE( zun(jpi,jpj,jpk), zvn(jpi,jpj,jpk), zwn(jpi,jpj,jpk) ) 
    8687      ! 
    8788      !                                         !==  effective transport  ==! 
     
    141142      END IF 
    142143      ! 
     144      DEALLOCATE( zun, zvn, zwn ) 
    143145      IF( ln_timing )   CALL timing_stop('trc_adv') 
    144146      ! 
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/TOP/trc.F90

    r10425 r12325  
    3434   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-  
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trn            !: tracer concentration for now time step 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tra            !: tracer concentration for next time step 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trb            !: tracer concentration for before time step 
     36   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::  tra            !: tracer concentration for next time step 
     37   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::  trb            !: tracer concentration for before time step 
    3838   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers 
    3939   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers 
Note: See TracChangeset for help on using the changeset viewer.