Ignore:
Timestamp:
2019-10-18T12:52:29+02:00 (12 months ago)
Author:
francesca
Message:

add extra halo support- ticket #2009

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/LBC/mpp_nfd_generic.h90

    r11692 r11719  
    4848   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 
    4949      !!---------------------------------------------------------------------- 
    50       ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
     50      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
    5151      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    5252      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     
    5454      ! 
    5555      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices 
    56       INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array 
     56      INTEGER  ::   ipi, ipk, ipl, ipf         ! dimension of the input array 
    5757      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    5858      INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb 
     
    8080         ALLOCATE(ipj_s(ipf)) 
    8181 
    82          ipj      = 2            ! Max 2nd dimension of message transfers (last two j-line only) 
    83          ipj_s(:) = 1            ! Real 2nd dimension of message transfers (depending on perf requirement) 
     82         ijpj      = 2 + nn_hls - 1           ! Max 2nd dimension of message transfers (last two j-line only) 
     83         ipj_s(:) = 1 + nn_hls - 1           ! Real 2nd dimension of message transfers (depending on perf requirement) 
    8484                                 ! by default, only one line is exchanged 
    8585 
    86          ALLOCATE( jj_s(ipf,2) ) 
     86         ALLOCATE( jj_s(ipf,ijpj) ) 
    8787 
    8888         ! re-define number of exchanged lines : 
     
    9898         IF ( l_full_nf_update .OR.                          &    ! if coupling fields 
    9999              ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart 
    100             ipj_s(:) = 2 
     100            ipj_s(:) = 2 + nn_hls - 1  
    101101 
    102102         ! Index of modifying lines in input 
     
    110110               ! 
    111111               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    112                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
     112                     DO ji = 1, nn_hls+1 
     113                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     114               ENDDO 
    113115               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    114                   jj_s(jf,1) = nlcj - 3 ;  jj_s(jf,2) = nlcj - 2 
     116               DO ji = 1, nn_hls+1 
     117                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 
     118               ENDDO 
    115119               END SELECT 
    116120            ! 
     
    119123               ! 
    120124               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    121                   jj_s(jf,1) = nlcj - 1       
    122                   ipj_s(jf) = 1                  ! need only one line anyway 
     125               DO ji = 1, nn_hls 
     126                  jj_s(jf,ji) = nlcj - 2*nn_hls + ji      
     127               ENDDO 
     128               ipj_s(jf) = nn_hls                  ! need only one line anyway 
    123129               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    124                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
     130               DO ji = 1, nn_hls+1 
     131                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     132               ENDDO 
    125133               END SELECT 
    126134            ! 
     
    131139         ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged 
    132140         ! 
    133          ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) ) 
     141         ALLOCATE( znorthloc(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
    134142         ! 
    135143         js = 0 
     
    139147               DO jl = 1, ipl 
    140148                  DO jk = 1, ipk 
    141                      znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf) 
     149                     znorthloc(1-nn_hls+1:jpi,js,jk,jl,1) = ARRAY_IN(1-nn_hls+1:jpi,jj_s(jf,jj),jk,jl,jf) 
    142150                  END DO 
    143151               END DO 
     
    145153         END DO 
    146154         ! 
    147          ibuffsize = jpimax * ipf_j * ipk * ipl 
    148          ! 
    149          ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) ) 
    150          ALLOCATE( ztabr(jpimax*jpmaxngh,ipj,ipk,ipl,ipf) )  
     155         ibuffsize = (jpimax + nn_hls -1) * ipf_j * ipk * ipl 
     156         ! 
     157         ALLOCATE( zfoldwk(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
     158         ALLOCATE( ztabr(1-nn_hls+1:(jpi+nn_hls-1)*jpmaxngh-nn_hls+1,ijpj,ipk,ipl,ipf) )  
    151159         ! when some processors of the north fold are suppressed,  
    152160         ! values of ztab* arrays corresponding to these suppressed domain won't be defined  
     
    218226      ELSE                             !==  allgather exchanges  ==! 
    219227         ! 
    220          ipj   = 4            ! 2nd dimension of message transfers (last j-lines) 
    221          ! 
    222          ALLOCATE( znorthloc(jpimax,ipj,ipk,ipl,ipf) ) 
    223          ! 
    224          DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab 
     228         ijpj   = 4            ! 2nd dimension of message transfers (last j-lines) 
     229         ! 
     230         ALLOCATE( znorthloc(jpimax,ijpj,ipk,ipl,ipf) ) 
     231         ! 
     232         DO jf = 1, ipf                ! put in znorthloc the last ijpj j-lines of ptab 
    225233            DO jl = 1, ipl 
    226234               DO jk = 1, ipk 
    227                   DO jj = nlcj - ipj +1, nlcj 
    228                      ij = jj - nlcj + ipj 
     235                  DO jj = nlcj - ijpj +1, nlcj 
     236                     ij = jj - nlcj + ijpj 
    229237                     znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 
    230238                  END DO 
     
    233241         END DO 
    234242         ! 
    235          ibuffsize = jpimax * ipj * ipk * ipl * ipf 
    236          ! 
    237          ALLOCATE( ztab       (jpiglo,ipj,ipk,ipl,ipf     ) ) 
    238          ALLOCATE( znorthgloio(jpimax,ipj,ipk,ipl,ipf,jpni) ) 
     243         ibuffsize = jpimax * ijpj * ipk * ipl * ipf 
     244         ! 
     245         ALLOCATE( ztab       (jpiglo,ijpj,ipk,ipl,ipf     ) ) 
     246         ALLOCATE( znorthgloio(jpimax,ijpj,ipk,ipl,ipf,jpni) ) 
    239247         ! 
    240248         ! when some processors of the north fold are suppressed, 
     
    263271               DO jl = 1, ipl 
    264272                  DO jk = 1, ipk 
    265                      DO jj = 1, ipj 
     273                     DO jj = 1, ijpj 
    266274                        DO ji = ildi, ilei 
    267275                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 
     
    279287            DO jl = 1, ipl 
    280288               DO jk = 1, ipk 
    281                   DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN 
    282                      ij = jj - nlcj + ipj 
     289                  DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to ARRAY_IN 
     290                     ij = jj - nlcj + ijpj 
    283291                     DO ji= 1, nlci 
    284292                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 
Note: See TracChangeset for help on using the changeset viewer.