[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 |
---|
[12807] | 28 | INTEGER :: Nis0_1, Njs0_1 |
---|
| 29 | INTEGER :: Nie0_1, Nje0_1 |
---|
[12586] | 30 | CONTAINS |
---|
| 31 | |
---|
| 32 | SUBROUTINE halo_mng_init( ) |
---|
| 33 | |
---|
| 34 | jpi_1 = jpi |
---|
| 35 | jpj_1 = jpj |
---|
| 36 | |
---|
[12807] | 37 | Nis0_1 = Nis0 |
---|
| 38 | Njs0_1 = Njs0 |
---|
[12586] | 39 | |
---|
[12807] | 40 | Nie0_1 = Nie0 |
---|
| 41 | Nje0_1 = Nje0 |
---|
[12586] | 42 | |
---|
[12719] | 43 | jpimax_1 = jpimax |
---|
| 44 | jpjmax_1 = jpjmax |
---|
| 45 | |
---|
[12586] | 46 | END SUBROUTINE halo_mng_init |
---|
| 47 | |
---|
| 48 | SUBROUTINE halo_mng_set( khls ) |
---|
| 49 | |
---|
| 50 | INTEGER, INTENT(in ) :: khls |
---|
| 51 | |
---|
| 52 | nn_hls = khls |
---|
| 53 | |
---|
[12719] | 54 | jpi = jpi_1 + 2*khls -2 |
---|
| 55 | jpj = jpj_1 + 2*khls -2 |
---|
| 56 | |
---|
[12807] | 57 | jpi = jpi_1 + 2*khls -2 |
---|
| 58 | jpj = jpj_1 + 2*khls -2 |
---|
[12586] | 59 | |
---|
[12719] | 60 | jpimax = jpimax_1 + 2*khls -2 |
---|
| 61 | jpjmax = jpjmax_1 + 2*khls -2 |
---|
[12586] | 62 | |
---|
[12807] | 63 | Nis0 = Nis0_1 + khls - 1 |
---|
| 64 | Njs0 = Njs0_1 + khls - 1 |
---|
[12719] | 65 | |
---|
[12807] | 66 | Nie0 = Nie0_1 + khls - 1 |
---|
| 67 | Nje0 = Nje0_1 + khls - 1 |
---|
[12719] | 68 | |
---|
[12586] | 69 | END SUBROUTINE halo_mng_set |
---|
| 70 | |
---|
| 71 | SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval) |
---|
| 72 | |
---|
| 73 | REAL(wp), POINTER, DIMENSION(:,:) :: pta |
---|
| 74 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 75 | REAL(wp), INTENT(in) :: psgn |
---|
| 76 | REAL(wp), OPTIONAL, INTENT(in ) :: fillval |
---|
| 77 | REAL(wp), POINTER, DIMENSION(:,:) :: zpta |
---|
| 78 | INTEGER :: offset |
---|
[12719] | 79 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 80 | |
---|
| 81 | pta_size_i = SIZE(pta,1) |
---|
| 82 | pta_size_j = SIZE(pta,2) |
---|
| 83 | |
---|
| 84 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 85 | IF (pta_size_i .ne. jpi) THEN |
---|
| 86 | ALLOCATE (zpta(jpi, jpj)) |
---|
| 87 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 88 | |
---|
[12719] | 89 | IF (pta_size_i .lt. jpi) THEN |
---|
| 90 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta |
---|
[12586] | 91 | ELSE |
---|
[12719] | 92 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) |
---|
[12586] | 93 | END IF |
---|
| 94 | CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) |
---|
| 95 | DEALLOCATE(pta) |
---|
| 96 | pta => zpta |
---|
| 97 | END IF |
---|
| 98 | |
---|
| 99 | END SUBROUTINE halo_mng_resize_2D |
---|
| 100 | |
---|
| 101 | SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval) |
---|
| 102 | |
---|
| 103 | REAL(wp), POINTER, DIMENSION(:,:,:) :: pta |
---|
| 104 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 105 | REAL(wp), INTENT(in) :: psgn |
---|
| 106 | REAL(wp), OPTIONAL, INTENT(in ) :: fillval |
---|
| 107 | REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta |
---|
| 108 | INTEGER :: offset |
---|
[12719] | 109 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 110 | |
---|
| 111 | pta_size_i = SIZE(pta,1) |
---|
| 112 | pta_size_j = SIZE(pta,2) |
---|
| 113 | |
---|
| 114 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 115 | IF (pta_size_i .ne. jpi) THEN |
---|
| 116 | ALLOCATE (zpta(jpi, jpj, jpk)) |
---|
| 117 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 118 | |
---|
[12719] | 119 | IF (pta_size_i .lt. jpi) THEN |
---|
| 120 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta |
---|
[12586] | 121 | ELSE |
---|
[12719] | 122 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) |
---|
[12586] | 123 | END IF |
---|
| 124 | CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) |
---|
| 125 | DEALLOCATE(pta) |
---|
| 126 | pta => zpta |
---|
| 127 | END IF |
---|
| 128 | |
---|
| 129 | END SUBROUTINE halo_mng_resize_3D |
---|
| 130 | |
---|
| 131 | SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, fjpt) |
---|
| 132 | |
---|
| 133 | REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta |
---|
| 134 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 135 | REAL(wp), INTENT(in) :: psgn |
---|
| 136 | REAL(wp), OPTIONAL, INTENT(in) :: fillval |
---|
| 137 | INTEGER , INTENT(in) :: fjpt |
---|
| 138 | REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta |
---|
| 139 | INTEGER :: offset |
---|
[12719] | 140 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 141 | |
---|
| 142 | pta_size_i = SIZE(pta,1) |
---|
| 143 | pta_size_j = SIZE(pta,2) |
---|
| 144 | |
---|
| 145 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 146 | IF (pta_size_i .ne. jpi) THEN |
---|
| 147 | ALLOCATE (zpta(jpi, jpj, jpk, jpt)) |
---|
| 148 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 149 | |
---|
[12719] | 150 | IF (pta_size_i .lt. jpi) THEN |
---|
| 151 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta |
---|
[12586] | 152 | ELSE |
---|
[12719] | 153 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) |
---|
[12586] | 154 | END IF |
---|
| 155 | CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) |
---|
| 156 | DEALLOCATE(pta) |
---|
| 157 | pta => zpta |
---|
| 158 | END IF |
---|
| 159 | |
---|
| 160 | END SUBROUTINE halo_mng_resize_4D |
---|
| 161 | |
---|
| 162 | SUBROUTINE halo_mng_resize_5D(pta, cdna, psgn, fillval, kjpt, fjpt) |
---|
| 163 | |
---|
| 164 | REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: pta |
---|
| 165 | CHARACTER(len=1), INTENT(in) :: cdna |
---|
| 166 | REAL(wp), INTENT(in) :: psgn |
---|
| 167 | REAL(wp), OPTIONAL, INTENT(in) :: fillval |
---|
| 168 | INTEGER , OPTIONAL, INTENT(in) :: kjpt ! number of tracers |
---|
| 169 | INTEGER , INTENT(in) :: fjpt |
---|
| 170 | REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta |
---|
| 171 | INTEGER :: offset |
---|
[12719] | 172 | INTEGER :: pta_size_i, pta_size_j |
---|
[12586] | 173 | |
---|
| 174 | pta_size_i = SIZE(pta,1) |
---|
| 175 | pta_size_j = SIZE(pta,2) |
---|
| 176 | |
---|
| 177 | ! check if the current size of pta is equal to the current expected dimension |
---|
[12719] | 178 | IF (pta_size_i .ne. jpi) THEN |
---|
| 179 | ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) |
---|
| 180 | offset = abs((jpi - pta_size_i) / 2) |
---|
[12586] | 181 | |
---|
[12719] | 182 | IF (pta_size_i .lt. jpi) THEN |
---|
| 183 | zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta |
---|
[12586] | 184 | ELSE |
---|
[12719] | 185 | zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) |
---|
[12586] | 186 | END IF |
---|
| 187 | CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval) |
---|
| 188 | DEALLOCATE(pta) |
---|
| 189 | pta => zpta |
---|
| 190 | END IF |
---|
| 191 | |
---|
| 192 | END SUBROUTINE halo_mng_resize_5D |
---|
| 193 | |
---|
| 194 | END MODULE |
---|