[11720] | 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 | |
---|
| 14 | IMPLICIT NONE |
---|
| 15 | PRIVATE |
---|
| 16 | |
---|
| 17 | INTERFACE halo_mng_copy |
---|
| 18 | MODULE PROCEDURE halo_mng_copy_2D, halo_mng_copy_3d, halo_mng_copy_4d |
---|
| 19 | END INTERFACE |
---|
| 20 | |
---|
| 21 | PUBLIC halo_mng_copy |
---|
| 22 | PUBLIC halo_mng_init |
---|
| 23 | PUBLIC halo_mng_set |
---|
| 24 | |
---|
| 25 | INTEGER :: jpi_1, jpj_1 |
---|
| 26 | INTEGER :: jpimax_1, jpjmax_1 |
---|
| 27 | INTEGER :: nlci_1, nlcj_1 |
---|
| 28 | INTEGER :: jplbi_1, jplbj_1 |
---|
| 29 | CONTAINS |
---|
| 30 | |
---|
| 31 | SUBROUTINE halo_mng_init( ) |
---|
| 32 | |
---|
| 33 | jpi_1 = jpi |
---|
| 34 | jpj_1 = jpj |
---|
| 35 | |
---|
| 36 | nlci_1 = nlci |
---|
| 37 | nlcj_1 = nlcj |
---|
| 38 | |
---|
| 39 | jplbi_1 = 1 |
---|
| 40 | jplbj_1 = 1 |
---|
| 41 | |
---|
| 42 | jplbi = 1 |
---|
| 43 | jplbj = 1 |
---|
| 44 | |
---|
| 45 | jpimax_1 = jpimax |
---|
| 46 | jpjmax_1 = jpjmax |
---|
| 47 | |
---|
| 48 | END SUBROUTINE halo_mng_init |
---|
| 49 | |
---|
| 50 | SUBROUTINE halo_mng_set( khls ) |
---|
| 51 | |
---|
| 52 | INTEGER, INTENT(in ) :: khls |
---|
| 53 | |
---|
| 54 | nn_hls = khls |
---|
| 55 | jpi = jpi_1 + khls -1 |
---|
| 56 | jpj = jpj_1 + khls -1 |
---|
| 57 | |
---|
| 58 | nlci = nlci_1 + khls -1 |
---|
| 59 | nlcj = nlcj_1 + khls -1 |
---|
| 60 | |
---|
| 61 | jplbi = jplbi_1 - khls +1 |
---|
| 62 | jplbj = jplbj_1 - khls +1 |
---|
| 63 | |
---|
| 64 | jpimax = jpimax_1 + khls -1 |
---|
| 65 | jpjmax = jpjmax_1 + khls -1 |
---|
| 66 | |
---|
| 67 | END SUBROUTINE halo_mng_set |
---|
| 68 | |
---|
| 69 | SUBROUTINE halo_mng_copy_2D(pta_1, pta_2) |
---|
| 70 | !!---------------------------------------------------------------------- |
---|
| 71 | !! *** ROUTINE halo_mng_copy *** |
---|
| 72 | !! |
---|
| 73 | !! ** Purpose : copy pta_1 into pta_2 |
---|
| 74 | !! ** Method : |
---|
| 75 | !! History : |
---|
| 76 | !! 1.0 ! 07-19 ( CMCC - ASC ) halo_mng_copy |
---|
| 77 | !!---------------------------------------------------------------------- |
---|
| 78 | REAL(wp), DIMENSION(:,:), INTENT(in) :: pta_1 |
---|
| 79 | REAL(wp), DIMENSION(:,:), INTENT(out) :: pta_2 |
---|
| 80 | INTEGER :: halo, off1, off2 |
---|
| 81 | INTEGER, DIMENSION(2) :: dim |
---|
| 82 | |
---|
| 83 | halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 |
---|
| 84 | IF (halo < 0) THEN |
---|
| 85 | off1 = 0 |
---|
| 86 | off2 = -halo |
---|
| 87 | dim = SHAPE(pta_1) |
---|
| 88 | ELSE |
---|
| 89 | off1 = halo |
---|
| 90 | off2 = 0 |
---|
| 91 | dim = SHAPE(pta_2) |
---|
| 92 | END IF |
---|
| 93 | |
---|
| 94 | pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1) |
---|
| 95 | |
---|
| 96 | |
---|
| 97 | END SUBROUTINE halo_mng_copy_2D |
---|
| 98 | |
---|
| 99 | SUBROUTINE halo_mng_copy_3D(pta_1, pta_2) |
---|
| 100 | !!---------------------------------------------------------------------- |
---|
| 101 | !! *** ROUTINE halo_mng_copy *** |
---|
| 102 | !! |
---|
| 103 | !! ** Purpose : copy pta_1 into pta_2 |
---|
| 104 | !! ** Method : |
---|
| 105 | !! History : |
---|
| 106 | !! 1.0 ! 07-19 ( CMCC - ASC ) halo_mng_copy |
---|
| 107 | !!---------------------------------------------------------------------- |
---|
| 108 | REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pta_1 |
---|
| 109 | REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pta_2 |
---|
| 110 | |
---|
| 111 | INTEGER :: halo, off1, off2 |
---|
| 112 | INTEGER, DIMENSION(3) :: dim |
---|
| 113 | |
---|
| 114 | halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 |
---|
| 115 | IF (halo < 0) THEN |
---|
| 116 | off1 = 0 |
---|
| 117 | off2 = -halo |
---|
| 118 | dim = SHAPE(pta_1) |
---|
| 119 | ELSE |
---|
| 120 | off1 = halo |
---|
| 121 | off2 = 0 |
---|
| 122 | dim = SHAPE(pta_2) |
---|
| 123 | END IF |
---|
| 124 | |
---|
| 125 | pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:) |
---|
| 126 | |
---|
| 127 | END SUBROUTINE halo_mng_copy_3D |
---|
| 128 | |
---|
| 129 | SUBROUTINE halo_mng_copy_4D(pta_1, pta_2) |
---|
| 130 | !!---------------------------------------------------------------------- |
---|
| 131 | !! *** ROUTINE halo_mng_copy *** |
---|
| 132 | !! |
---|
| 133 | !! ** Purpose : copy pta_1 into pta_2 |
---|
| 134 | !! ** Method : |
---|
| 135 | !! History : |
---|
| 136 | !! 1.0 ! 07-19 ( CMCC - ASC ) halo_mng_copy |
---|
| 137 | !!---------------------------------------------------------------------- |
---|
| 138 | REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pta_1 |
---|
| 139 | REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pta_2 |
---|
| 140 | INTEGER :: halo, off1, off2 |
---|
| 141 | INTEGER, DIMENSION(4) :: dim |
---|
| 142 | |
---|
| 143 | halo = (SIZE(pta_1,1) - SIZE(pta_2,1))/2 |
---|
| 144 | IF (halo < 0) THEN |
---|
| 145 | off1 = 0 |
---|
| 146 | off2 = -halo |
---|
| 147 | dim = SHAPE(pta_1) |
---|
| 148 | ELSE |
---|
| 149 | off1 = halo |
---|
| 150 | off2 = 0 |
---|
| 151 | dim = SHAPE(pta_2) |
---|
| 152 | END IF |
---|
| 153 | |
---|
| 154 | pta_2(1+off2:SIZE(pta_2,1)-off2, 1+off2:SIZE(pta_2,2)-off2,:,:) = pta_1(1+off1:SIZE(pta_1,1)-off1, 1+off1:SIZE(pta_1,2)-off1,:,:) |
---|
| 155 | |
---|
| 156 | END SUBROUTINE halo_mng_copy_4D |
---|
| 157 | END MODULE |
---|