- Timestamp:
- 2020-04-08T17:45:31+02:00 (4 years ago)
- 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 27 27 INTEGER :: jpimax_1, jpjmax_1 28 28 INTEGER :: nlci_1, nlcj_1 29 INTEGER :: jplbi_1, jplbj_1 29 INTEGER :: nldi_1, nldj_1 30 INTEGER :: nlei_1, nlej_1 30 31 CONTAINS 31 32 … … 38 39 nlcj_1 = nlcj 39 40 40 jplbi_1 = 1 41 jplbj_1 = 1 42 43 jplbi = 1 44 jplbj = 1 41 nldi_1 = nldi 42 nldj_1 = nldj 45 43 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 48 49 49 50 END SUBROUTINE halo_mng_init … … 54 55 55 56 nn_hls = khls 56 jpi = jpi_1 + khls -157 jpj = jpj_1 + khls -158 57 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 61 63 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 67 72 68 73 END SUBROUTINE halo_mng_set … … 76 81 REAL(wp), POINTER, DIMENSION(:,:) :: zpta 77 82 INTEGER :: offset 78 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j83 INTEGER :: pta_size_i, pta_size_j 79 84 80 85 pta_size_i = SIZE(pta,1) 81 86 pta_size_j = SIZE(pta,2) 82 exp_size_i = jpi - jplbi + 183 exp_size_j = jpj - jplbj + 184 87 85 88 ! check if the current size of pta is equal to the current expected dimension 86 IF (pta_size_i .ne. exp_size_i) THEN87 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj))88 offset = (exp_size_i - pta_size_i) / 289 IF (pta_size_i .ne. jpi) THEN 90 ALLOCATE (zpta(jpi, jpj)) 91 offset = abs((jpi - pta_size_i) / 2) 89 92 90 IF (pta_size_i .lt. exp_size_i) THEN91 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1) = pta93 IF (pta_size_i .lt. jpi) THEN 94 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta 92 95 ELSE 93 zpta = pta( jplbi : jpi, jplbj :jpj)96 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) 94 97 END IF 95 98 CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) … … 108 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 109 112 INTEGER :: offset 110 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j113 INTEGER :: pta_size_i, pta_size_j 111 114 112 115 pta_size_i = SIZE(pta,1) 113 116 pta_size_j = SIZE(pta,2) 114 exp_size_i = jpi - jplbi + 1115 exp_size_j = jpj - jplbj + 1116 117 117 118 ! check if the current size of pta is equal to the current expected dimension 118 IF (pta_size_i .ne. exp_size_i) THEN119 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk))120 offset = (exp_size_i - pta_size_i) / 2119 IF (pta_size_i .ne. jpi) THEN 120 ALLOCATE (zpta(jpi, jpj, jpk)) 121 offset = abs((jpi - pta_size_i) / 2) 121 122 122 IF (pta_size_i .lt. exp_size_i) THEN123 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :) = pta123 IF (pta_size_i .lt. jpi) THEN 124 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta 124 125 ELSE 125 zpta = pta( jplbi : jpi, jplbj :jpj, :)126 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) 126 127 END IF 127 128 CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) … … 141 142 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 142 143 INTEGER :: offset 143 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j144 INTEGER :: pta_size_i, pta_size_j 144 145 145 146 pta_size_i = SIZE(pta,1) 146 147 pta_size_j = SIZE(pta,2) 147 exp_size_i = jpi - jplbi + 1148 exp_size_j = jpj - jplbj + 1149 148 150 149 ! check if the current size of pta is equal to the current expected dimension 151 IF (pta_size_i .ne. exp_size_i) THEN152 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk, jpt))153 offset = (exp_size_i - pta_size_i) / 2150 IF (pta_size_i .ne. jpi) THEN 151 ALLOCATE (zpta(jpi, jpj, jpk, jpt)) 152 offset = abs((jpi - pta_size_i) / 2) 154 153 155 IF (pta_size_i .lt. exp_size_i) THEN156 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :) = pta154 IF (pta_size_i .lt. jpi) THEN 155 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta 157 156 ELSE 158 zpta = pta( jplbi : jpi, jplbj :jpj, :, :)157 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) 159 158 END IF 160 159 CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) … … 175 174 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta 176 175 INTEGER :: offset 177 INTEGER :: pta_size_i, pta_size_j , exp_size_i, exp_size_j176 INTEGER :: pta_size_i, pta_size_j 178 177 179 178 pta_size_i = SIZE(pta,1) 180 179 pta_size_j = SIZE(pta,2) 181 exp_size_i = jpi - jplbi + 1182 exp_size_j = jpj - jplbj + 1183 180 184 181 ! check if the current size of pta is equal to the current expected dimension 185 IF (pta_size_i .ne. exp_size_i) THEN186 ALLOCATE (zpta(jp lbi:jpi, jplbj:jpj, jpk, kjpt, jpt))187 offset = (exp_size_i - pta_size_i) / 2182 IF (pta_size_i .ne. jpi) THEN 183 ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) 184 offset = abs((jpi - pta_size_i) / 2) 188 185 189 IF (pta_size_i .lt. exp_size_i) THEN190 zpta (offset+ jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :, :) = pta186 IF (pta_size_i .lt. jpi) THEN 187 zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta 191 188 ELSE 192 zpta = pta( jplbi : jpi, jplbj :jpj, :, :, :)189 zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) 193 190 END IF 194 191 CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval)
Note: See TracChangeset
for help on using the changeset viewer.