Changeset 12325 for NEMO/branches/2019/dev_r11514_HPC02_singlecoreextrahalo/src/OCE/LBC/halo_mng.F90
 Timestamp:
 20200115T13:26:22+01:00 (17 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/branches/2019/dev_r11514_HPC02_singlecoreextrahalo/src/OCE/LBC/halo_mng.F90
r11720 r12325 11 11 12 12 USE dom_oce ! ocean space and time domain 13 USE lbclnk ! ocean lateral boundary condition (or mpp link) 13 14 14 15 IMPLICIT NONE 15 16 PRIVATE 16 17 17 INTERFACE halo_mng_ copy18 MODULE PROCEDURE halo_mng_ copy_2D, halo_mng_copy_3d, halo_mng_copy_4d18 INTERFACE halo_mng_resize 19 MODULE PROCEDURE halo_mng_resize_2D, halo_mng_resize_3d, halo_mng_resize_4d 19 20 END INTERFACE 20 21 21 PUBLIC halo_mng_ copy22 PUBLIC halo_mng_resize 22 23 PUBLIC halo_mng_init 23 24 PUBLIC halo_mng_set … … 67 68 END SUBROUTINE halo_mng_set 68 69 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 ! 0719 ( 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 70 SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval) 71 72 REAL(wp), POINTER, DIMENSION(:,:) :: pta 73 CHARACTER(len=1), INTENT(in) :: cdna 74 REAL(wp), INTENT(in) :: psgn 75 REAL(wp), OPTIONAL, INTENT(in ) :: fillval 76 REAL(wp), POINTER, DIMENSION(:,:) :: zpta 77 INTEGER :: offset 78 INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 82 79 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 80 pta_size_i = SIZE(pta,1) 81 pta_size_j = SIZE(pta,2) 82 exp_size_i = jpi  jplbi + 1 83 exp_size_j = jpj  jplbj + 1 84 85 ! 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 98 89 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 ! 0719 ( CMCC  ASC ) halo_mng_copy 107 !! 108 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pta_1 109 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pta_2 90 IF (pta_size_i .lt. exp_size_i) THEN 91 zpta (offset+jplbi : offset+pta_size_i+jplbi1, offset+jplbj : offset+pta_size_j+jplbj1) = pta 92 ELSE 93 zpta = pta(jplbi : jpi, jplbj : jpj) 94 END IF 95 CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) 96 DEALLOCATE(pta) 97 pta => zpta 98 END IF 99 100 END SUBROUTINE halo_mng_resize_2D 110 101 111 INTEGER :: halo, off1, off2 112 INTEGER, DIMENSION(3) :: dim 102 SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval) 103 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: pta 105 CHARACTER(len=1), INTENT(in) :: cdna 106 REAL(wp), INTENT(in) :: psgn 107 REAL(wp), OPTIONAL, INTENT(in ) :: fillval 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 109 INTEGER :: offset 110 INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 113 111 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,:) 112 pta_size_i = SIZE(pta,1) 113 pta_size_j = SIZE(pta,2) 114 exp_size_i = jpi  jplbi + 1 115 exp_size_j = jpj  jplbj + 1 116 117 ! 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 126 121 127 END SUBROUTINE halo_mng_copy_3D 122 IF (pta_size_i .lt. exp_size_i) THEN 123 zpta (offset+jplbi : offset+pta_size_i+jplbi1, offset+jplbj : offset+pta_size_j+jplbj1, :) = pta 124 ELSE 125 zpta = pta(jplbi : jpi, jplbj : jpj, :) 126 END IF 127 CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) 128 DEALLOCATE(pta) 129 pta => zpta 130 END IF 131 132 END SUBROUTINE halo_mng_resize_3D 128 133 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 ! 0719 ( 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 134 SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, kjpt) 135 136 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta 137 CHARACTER(len=1), INTENT(in) :: cdna 138 REAL(wp), INTENT(in) :: psgn 139 REAL(wp), OPTIONAL, INTENT(in) :: fillval 140 INTEGER , OPTIONAL, INTENT(in) :: kjpt ! number of tracers 141 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 142 INTEGER :: offset 143 INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 142 144 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,:,:) 145 pta_size_i = SIZE(pta,1) 146 pta_size_j = SIZE(pta,2) 147 exp_size_i = jpi  jplbi + 1 148 exp_size_j = jpj  jplbj + 1 149 150 ! 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, kjpt)) 153 offset = (exp_size_i  pta_size_i) / 2 155 154 156 END SUBROUTINE halo_mng_copy_4D 155 IF (pta_size_i .lt. exp_size_i) THEN 156 zpta (offset+jplbi : offset+pta_size_i+jplbi1, offset+jplbj : offset+pta_size_j+jplbj1, :, :) = pta 157 ELSE 158 zpta = pta(jplbi : jpi, jplbj : jpj, :, :) 159 END IF 160 CALL lbc_lnk( 'halo_mng_resize_4D', zpta, cdna, psgn, pfillval=fillval) 161 DEALLOCATE(pta) 162 pta => zpta 163 END IF 164 165 END SUBROUTINE halo_mng_resize_4D 166 157 167 END MODULE
Note: See TracChangeset
for help on using the changeset viewer.