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 12719 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90 – NEMO

Ignore:
Timestamp:
2020-04-08T17:45:31+02:00 (4 years ago)
Author:
francesca
Message:

extra-halo management with positive arrays indices - ticket #2366

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90

    r12586 r12719  
    2727   INTEGER :: jpimax_1, jpjmax_1 
    2828   INTEGER :: nlci_1, nlcj_1 
    29    INTEGER :: jplbi_1, jplbj_1 
     29   INTEGER :: nldi_1, nldj_1 
     30   INTEGER :: nlei_1, nlej_1 
    3031CONTAINS 
    3132 
     
    3839        nlcj_1 = nlcj 
    3940 
    40         jplbi_1 = 1  
    41         jplbj_1 = 1  
    42          
    43         jplbi = 1  
    44         jplbj = 1  
     41        nldi_1 = nldi 
     42        nldj_1 = nldj 
    4543 
    46          jpimax_1 = jpimax 
    47          jpjmax_1 = jpjmax 
     44        nlei_1 = nlei 
     45        nlej_1 = nlej 
     46 
     47      jpimax_1 = jpimax 
     48      jpjmax_1 = jpjmax 
    4849 
    4950   END SUBROUTINE halo_mng_init 
     
    5455 
    5556        nn_hls = khls 
    56         jpi = jpi_1 + khls -1 
    57         jpj = jpj_1 + khls -1 
    5857 
    59         nlci = nlci_1 + khls -1 
    60         nlcj = nlcj_1 + khls -1 
     58        jpi = jpi_1 + 2*khls -2 
     59        jpj = jpj_1 + 2*khls -2 
     60 
     61        nlci = nlci_1 + 2*khls -2 
     62        nlcj = nlcj_1 + 2*khls -2 
    6163         
    62         jplbi = jplbi_1 - khls +1  
    63         jplbj = jplbj_1 - khls +1  
    64          
    65         jpimax = jpimax_1 + khls -1 
    66         jpjmax = jpjmax_1 + khls -1 
     64        jpimax = jpimax_1 + 2*khls -2 
     65        jpjmax = jpjmax_1 + 2*khls -2 
     66 
     67        nldi = nldi_1 + khls - 1 
     68        nldj = nldj_1 + khls - 1 
     69 
     70        nlei = nlei_1 + khls - 1 
     71        nlej = nlej_1 + khls - 1 
    6772 
    6873   END SUBROUTINE halo_mng_set 
     
    7681      REAL(wp), POINTER, DIMENSION(:,:) :: zpta 
    7782      INTEGER :: offset 
    78       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     83      INTEGER :: pta_size_i, pta_size_j 
    7984 
    8085      pta_size_i = SIZE(pta,1) 
    8186      pta_size_j = SIZE(pta,2) 
    82       exp_size_i = jpi - jplbi + 1 
    83       exp_size_j = jpj - jplbj + 1 
    8487       
    8588      ! 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  
     89      IF (pta_size_i .ne. jpi) THEN 
     90         ALLOCATE (zpta(jpi, jpj)) 
     91         offset = abs((jpi - pta_size_i) / 2)  
    8992 
    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 
     93         IF (pta_size_i .lt. jpi) THEN 
     94            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta 
    9295         ELSE 
    93             zpta = pta(jplbi : jpi, jplbj : jpj) 
     96            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) 
    9497         END IF 
    9598         CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) 
     
    108111      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 
    109112      INTEGER :: offset 
    110       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     113      INTEGER :: pta_size_i, pta_size_j 
    111114 
    112115      pta_size_i = SIZE(pta,1) 
    113116      pta_size_j = SIZE(pta,2) 
    114       exp_size_i = jpi - jplbi + 1 
    115       exp_size_j = jpj - jplbj + 1 
    116117       
    117118      ! 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  
     119      IF (pta_size_i .ne. jpi) THEN 
     120         ALLOCATE (zpta(jpi, jpj, jpk)) 
     121         offset = abs((jpi - pta_size_i) / 2)  
    121122 
    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 
     123         IF (pta_size_i .lt. jpi) THEN 
     124            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta 
    124125         ELSE 
    125             zpta = pta(jplbi : jpi, jplbj : jpj, :) 
     126            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) 
    126127         END IF 
    127128         CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) 
     
    141142      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 
    142143      INTEGER :: offset 
    143       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     144      INTEGER :: pta_size_i, pta_size_j 
    144145 
    145146      pta_size_i = SIZE(pta,1) 
    146147      pta_size_j = SIZE(pta,2) 
    147       exp_size_i = jpi - jplbi + 1 
    148       exp_size_j = jpj - jplbj + 1 
    149148       
    150149      ! 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, jpt)) 
    153          offset = (exp_size_i - pta_size_i) / 2  
     150      IF (pta_size_i .ne. jpi) THEN 
     151         ALLOCATE (zpta(jpi, jpj, jpk, jpt)) 
     152         offset = abs((jpi - pta_size_i) / 2)  
    154153 
    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 
     154         IF (pta_size_i .lt. jpi) THEN 
     155            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta 
    157156         ELSE 
    158             zpta = pta(jplbi : jpi, jplbj : jpj, :, :) 
     157            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) 
    159158         END IF 
    160159         CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) 
     
    175174      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta 
    176175      INTEGER :: offset 
    177       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     176      INTEGER :: pta_size_i, pta_size_j 
    178177 
    179178      pta_size_i = SIZE(pta,1) 
    180179      pta_size_j = SIZE(pta,2) 
    181       exp_size_i = jpi - jplbi + 1 
    182       exp_size_j = jpj - jplbj + 1 
    183180       
    184181      ! check if the current size of pta is equal to the current expected dimension 
    185       IF (pta_size_i .ne. exp_size_i) THEN 
    186          ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk, kjpt, jpt)) 
    187          offset = (exp_size_i - pta_size_i) / 2  
     182      IF (pta_size_i .ne. jpi) THEN 
     183         ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) 
     184         offset = abs((jpi - pta_size_i) / 2)  
    188185 
    189          IF (pta_size_i .lt. exp_size_i) THEN 
    190             zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :, :) = pta 
     186         IF (pta_size_i .lt. jpi) THEN 
     187            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta 
    191188         ELSE 
    192             zpta = pta(jplbi : jpi, jplbj : jpj, :, :, :) 
     189            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) 
    193190         END IF 
    194191         CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval) 
Note: See TracChangeset for help on using the changeset viewer.