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

replace halo-copy routines - ticket #2009

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.