[12586] | 1 | MODULE halo_mng |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE halo_mng *** |
---|
| 4 | !! Ocean numerics: massively parallel processing library |
---|
| 5 | !!===================================================================== |
---|
| 6 | !! History : OPA ! 1994 (M. Guyon, J. Escobar, M. Imbard) |
---|
| 7 | !Original code |
---|
| 8 | !! 4.0 ! 2019 (CMCC - ASC) initial version of halo management module |
---|
| 9 | !in_out_manager |
---|
| 10 | !!---------------------------------------------------------------------- |
---|
| 11 | |
---|
| 12 | USE dom_oce ! ocean space and time domain |
---|
| 13 | USE lbclnk ! ocean lateral boundary condition (or mpp link) |
---|
| 14 | |
---|
| 15 | IMPLICIT NONE |
---|
| 16 | PRIVATE |
---|
| 17 | |
---|
| 18 | INTERFACE halo_mng_resize |
---|
| 19 | MODULE PROCEDURE halo_mng_resize_2D, halo_mng_resize_3D, halo_mng_resize_4D, halo_mng_resize_5D |
---|
| 20 | END INTERFACE |
---|
| 21 | |
---|
| 22 | PUBLIC halo_mng_resize |
---|
| 23 | PUBLIC halo_mng_init |
---|
| 24 | PUBLIC halo_mng_set |
---|
| 25 | |
---|
| 26 | INTEGER :: jpi_1, jpj_1 |
---|
| 27 | INTEGER :: jpimax_1, jpjmax_1 |
---|
| 28 | INTEGER :: nlci_1, nlcj_1 |
---|
[12719] | 29 | INTEGER :: nldi_1, nldj_1 |
---|
| 30 | INTEGER :: nlei_1, nlej_1 |
---|
[12586] | 31 | CONTAINS |
---|
| 32 | |
---|
| 33 | SUBROUTINE halo_mng_init( ) |
---|
| 34 | |
---|
| 35 | jpi_1 = jpi |
---|
| 36 | jpj_1 = jpj |
---|
| 37 | |
---|
| 38 | nlci_1 = nlci |
---|
| 39 | nlcj_1 = nlcj |
---|
| 40 | |
---|
[12719] | 41 | nldi_1 = nldi |
---|
| 42 | nldj_1 = nldj |
---|
[12586] | 43 | |
---|
[12719] | 44 | nlei_1 = nlei |
---|
| 45 | nlej_1 = nlej |
---|
[12586] | 46 | |
---|
[12719] | 47 | jpimax_1 = jpimax |
---|
| 48 | jpjmax_1 = jpjmax |
---|
| 49 | |
---|
[12586] | 50 | END SUBROUTINE halo_mng_init |
---|
| 51 | |
---|
| 52 | SUBROUTINE halo_mng_set( khls ) |
---|
| 53 | |
---|
| 54 | INTEGER, INTENT(in ) :: khls |
---|
| 55 | |
---|
| 56 | nn_hls = khls |
---|
| 57 | |
---|
[12719] | 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 |
---|
[12586] | 63 | |
---|
[12719] | 64 | jpimax = jpimax_1 + 2*khls -2 |
---|
| 65 | jpjmax = jpjmax_1 + 2*khls -2 |
---|
[12586] | 66 | |
---|
[12719] | 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 |
---|
| 72 | |
---|
[12586] | 73 | END SUBROUTINE halo_mng_set |
---|
| 74 | |
---|
| 75 | SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval) |
---|
| 76 | |
---|
| 77 | REAL(wp), POINTER, DIMENSION(:,:) :: pta |
---|
| 78 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 79 | REAL(wp), INTENT(in) :: psgn |
---|
| 80 | REAL(wp), OPTIONAL, INTENT(in ) :: fillval |
---|
| 81 | REAL(wp), POINTER, DIMENSION(:,:) :: zpta |
---|
| 82 | INTEGER :: offset |
---|
[12719] | 83 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 84 | |
---|
| 85 | pta_size_i = SIZE(pta,1) |
---|
| 86 | pta_size_j = SIZE(pta,2) |
---|
| 87 | |
---|
| 88 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 89 | IF (pta_size_i .ne. jpi) THEN |
---|
| 90 | ALLOCATE (zpta(jpi, jpj)) |
---|
| 91 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 92 | |
---|
[12719] | 93 | IF (pta_size_i .lt. jpi) THEN |
---|
| 94 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta |
---|
[12586] | 95 | ELSE |
---|
[12719] | 96 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) |
---|
[12586] | 97 | END IF |
---|
| 98 | CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) |
---|
| 99 | DEALLOCATE(pta) |
---|
| 100 | pta => zpta |
---|
| 101 | END IF |
---|
| 102 | |
---|
| 103 | END SUBROUTINE halo_mng_resize_2D |
---|
| 104 | |
---|
| 105 | SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval) |
---|
| 106 | |
---|
| 107 | REAL(wp), POINTER, DIMENSION(:,:,:) :: pta |
---|
| 108 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 109 | REAL(wp), INTENT(in) :: psgn |
---|
| 110 | REAL(wp), OPTIONAL, INTENT(in ) :: fillval |
---|
| 111 | REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta |
---|
| 112 | INTEGER :: offset |
---|
[12719] | 113 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 114 | |
---|
| 115 | pta_size_i = SIZE(pta,1) |
---|
| 116 | pta_size_j = SIZE(pta,2) |
---|
| 117 | |
---|
| 118 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 119 | IF (pta_size_i .ne. jpi) THEN |
---|
| 120 | ALLOCATE (zpta(jpi, jpj, jpk)) |
---|
| 121 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 122 | |
---|
[12719] | 123 | IF (pta_size_i .lt. jpi) THEN |
---|
| 124 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta |
---|
[12586] | 125 | ELSE |
---|
[12719] | 126 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) |
---|
[12586] | 127 | END IF |
---|
| 128 | CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) |
---|
| 129 | DEALLOCATE(pta) |
---|
| 130 | pta => zpta |
---|
| 131 | END IF |
---|
| 132 | |
---|
| 133 | END SUBROUTINE halo_mng_resize_3D |
---|
| 134 | |
---|
| 135 | SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, fjpt) |
---|
| 136 | |
---|
| 137 | REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta |
---|
| 138 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 139 | REAL(wp), INTENT(in) :: psgn |
---|
| 140 | REAL(wp), OPTIONAL, INTENT(in) :: fillval |
---|
| 141 | INTEGER , INTENT(in) :: fjpt |
---|
| 142 | REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta |
---|
| 143 | INTEGER :: offset |
---|
[12719] | 144 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 145 | |
---|
| 146 | pta_size_i = SIZE(pta,1) |
---|
| 147 | pta_size_j = SIZE(pta,2) |
---|
| 148 | |
---|
| 149 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 150 | IF (pta_size_i .ne. jpi) THEN |
---|
| 151 | ALLOCATE (zpta(jpi, jpj, jpk, jpt)) |
---|
| 152 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 153 | |
---|
[12719] | 154 | IF (pta_size_i .lt. jpi) THEN |
---|
| 155 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta |
---|
[12586] | 156 | ELSE |
---|
[12719] | 157 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) |
---|
[12586] | 158 | END IF |
---|
| 159 | CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) |
---|
| 160 | DEALLOCATE(pta) |
---|
| 161 | pta => zpta |
---|
| 162 | END IF |
---|
| 163 | |
---|
| 164 | END SUBROUTINE halo_mng_resize_4D |
---|
| 165 | |
---|
| 166 | SUBROUTINE halo_mng_resize_5D(pta, cdna, psgn, fillval, kjpt, fjpt) |
---|
| 167 | |
---|
| 168 | REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: pta |
---|
| 169 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 170 | REAL(wp), INTENT(in) :: psgn |
---|
| 171 | REAL(wp), OPTIONAL, INTENT(in) :: fillval |
---|
| 172 | INTEGER , OPTIONAL, INTENT(in) :: kjpt ! number of tracers |
---|
| 173 | INTEGER , INTENT(in) :: fjpt |
---|
| 174 | REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta |
---|
| 175 | INTEGER :: offset |
---|
[12719] | 176 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 177 | |
---|
| 178 | pta_size_i = SIZE(pta,1) |
---|
| 179 | pta_size_j = SIZE(pta,2) |
---|
| 180 | |
---|
| 181 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 182 | IF (pta_size_i .ne. jpi) THEN |
---|
| 183 | ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) |
---|
| 184 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 185 | |
---|
[12719] | 186 | IF (pta_size_i .lt. jpi) THEN |
---|
| 187 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta |
---|
[12586] | 188 | ELSE |
---|
[12719] | 189 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) |
---|
[12586] | 190 | END IF |
---|
| 191 | CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval) |
---|
| 192 | DEALLOCATE(pta) |
---|
| 193 | pta => zpta |
---|
| 194 | END IF |
---|
| 195 | |
---|
| 196 | END SUBROUTINE halo_mng_resize_5D |
---|
| 197 | |
---|
| 198 | END MODULE |
---|