Changeset 3566
- Timestamp:
- 2012-11-15T19:09:49+01:00 (11 years ago)
- Location:
- branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r3294 r3566 1 #define SPONGE 1 #define SPONGE && define SPONGE_TOP 2 2 3 3 Module agrif_opa_sponge … … 13 13 PRIVATE 14 14 15 PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 16 15 PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 16 17 !! * Substitutions 18 # include "domzgr_substitute.h90" 17 19 !!---------------------------------------------------------------------- 18 20 !! NEMO/NST 3.3 , NEMO Consortium (2010) … … 27 29 !! *** ROUTINE Agrif_Sponge_Tra *** 28 30 !!--------------------------------------------- 29 #include "domzgr_substitute.h90"30 31 !! 31 32 INTEGER :: ji,jj,jk,jn 32 INTEGER :: spongearea33 33 REAL(wp) :: timecoeff 34 34 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 35 REAL(wp), POINTER, DIMENSION(:,: ) :: localviscsponge36 35 REAL(wp), POINTER, DIMENSION(:,: ) :: ztu, ztv 37 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab … … 39 38 40 39 #if defined SPONGE 41 CALL wrk_alloc( jpi, jpj, localviscsponge,ztu, ztv )40 CALL wrk_alloc( jpi, jpj, ztu, ztv ) 42 41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 43 42 … … 52 51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 53 52 54 spongearea = 2 + 2 * Agrif_irhox() 55 56 localviscsponge = 0. 57 58 IF (.NOT. spongedoneT) THEN 59 spe1ur(:,:) = 0. 60 spe2vr(:,:) = 0. 61 62 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 63 DO ji = 2, spongearea 64 localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 65 ENDDO 66 67 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) & 68 * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:) 69 70 spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 71 localviscsponge(2:spongearea,2:jpj)) & 72 * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1) 73 ENDIF 74 75 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 76 DO ji = nlci-spongearea + 1,nlci-1 77 localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 78 ENDDO 79 80 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 81 localviscsponge(nlci-spongearea + 2:nlci-1,:)) & 82 * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:) 83 84 spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 85 + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) & 86 * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1) 87 ENDIF 88 89 90 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 91 DO jj = 2, spongearea 92 localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 93 ENDDO 94 95 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 96 localviscsponge(2:jpi,2:spongearea)) & 97 * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea) 98 99 spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 100 localviscsponge(:,3:spongearea)) & 101 * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1) 102 ENDIF 103 104 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 105 DO jj = nlcj-spongearea + 1,nlcj-1 106 localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 107 ENDDO 108 109 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 110 localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) & 111 * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1) 112 113 spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 114 localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) & 115 * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2) 116 ENDIF 117 118 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 119 120 spongedoneT = .TRUE. 121 ENDIF 53 CALL Agrif_Sponge 122 54 123 55 DO jn = 1, jpts … … 147 79 ENDDO 148 80 149 CALL wrk_dealloc( jpi, jpj, localviscsponge,ztu, ztv )81 CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 150 82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 151 83 #endif … … 157 89 !! *** ROUTINE Agrif_Sponge_dyn *** 158 90 !!--------------------------------------------- 159 #include "domzgr_substitute.h90"160 91 !! 161 92 INTEGER :: ji,jj,jk 162 INTEGER :: spongearea163 93 REAL(wp) :: timecoeff 164 94 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 165 REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge166 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 167 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff … … 169 98 170 99 #if defined SPONGE 171 CALL wrk_alloc( jpi, jpj, localviscsponge )172 100 CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 173 101 … … 180 108 Agrif_UseSpecialValue = .FALSE. 181 109 182 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:))*umask(:,:,:)110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 183 111 184 112 ztab = 0.e0 … … 188 116 Agrif_UseSpecialValue = .FALSE. 189 117 190 vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:) 191 192 spongearea = 2 + 2 * Agrif_irhox() 193 194 localviscsponge = 0. 195 196 IF (.NOT. spongedoneU) THEN 197 spe1ur2(:,:) = 0. 198 spe2vr2(:,:) = 0. 199 200 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 201 DO ji = 2, spongearea 202 localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2) 203 ENDDO 204 205 spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) 206 207 spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 208 localviscsponge(2:spongearea,2:jpj)) 209 ENDIF 210 211 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 212 DO ji = nlci-spongearea + 1,nlci-1 213 localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2) 214 ENDDO 215 216 spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 217 localviscsponge(nlci-spongearea + 2:nlci-1,:)) 218 219 spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 220 + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) 221 ENDIF 222 223 224 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 225 DO jj = 2, spongearea 226 localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2) 227 ENDDO 228 229 spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 230 localviscsponge(2:jpi,2:spongearea)) 231 232 spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 233 localviscsponge(:,3:spongearea)) 234 ENDIF 235 236 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 237 DO jj = nlcj-spongearea + 1,nlcj-1 238 localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2) 239 ENDDO 240 241 spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 242 localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) 243 244 spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 245 localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) 246 ENDIF 247 248 spongedoneU = .TRUE. 249 250 spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 251 ENDIF 252 253 IF (.NOT. spongedoneT) THEN 254 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 255 ENDIF 256 257 DO jk=1,jpkm1 258 ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 259 vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 119 120 CALL Agrif_Sponge 121 122 DO jk = 1,jpkm1 123 ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 124 vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 260 125 ENDDO 261 126 … … 272 137 DO ji = 2, jpim1 ! vector opt. 273 138 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 274 hdivdiff(ji,jj,jk) = & 275 ( e2u(ji,jj)*fse3u(ji,jj,jk) * & 276 ubdiff(ji,jj,jk) - e2u(ji-1,jj )* & 277 fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) & 278 + e1v(ji,jj)*fse3v(ji,jj,jk) * & 279 vbdiff(ji,jj,jk) - e1v(ji ,jj-1)* & 280 fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr 139 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj ) * fse3u(ji ,jj ,jk) * ubdiff(ji ,jj ,jk) & 140 & - e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) & 141 & + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * vbdiff(ji ,jj ,jk) & 142 & - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr 281 143 END DO 282 144 END DO … … 286 148 zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 287 149 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj ) * vbdiff(ji+1,jj ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk) & 288 & - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) &289 & * fmask(ji,jj,jk) * zbtr150 & - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) & 151 & * fmask(ji,jj,jk) * zbtr 290 152 END DO 291 153 END DO … … 298 160 DO jj = 2, jpjm1 299 161 DO ji = 2, jpim1 ! vector opt. 300 ze2u = rotdiff (ji,jj,jk)301 ze1v = hdivdiff(ji,jj,jk)302 162 ! horizontal diffusive trends 303 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 304 + ( hdivdiff(ji+1,jj,jk) - ze1v & 305 ) / e1u(ji,jj) 306 307 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 308 + ( hdivdiff(ji,jj+1,jk) - ze1v & 309 ) / e2v(ji,jj) 310 163 zua = - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 164 + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk) ) / e1u(ji,jj) 165 166 zva = + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 167 + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) / e2v(ji,jj) 311 168 ! add it to the general momentum trends 312 169 ua(ji,jj,jk) = ua(ji,jj,jk) + zua … … 317 174 END DO ! End of slab 318 175 ! ! =============== 319 CALL wrk_dealloc( jpi, jpj, localviscsponge )320 176 CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 321 322 177 #endif 323 178 324 179 END SUBROUTINE Agrif_Sponge_dyn 325 180 181 SUBROUTINE Agrif_Sponge 182 !!--------------------------------------------- 183 !! *** ROUTINE Agrif_Sponge *** 184 !!--------------------------------------------- 185 INTEGER :: ji,jj,jk 186 INTEGER :: ispongearea, ilci, ilcj 187 REAL(wp) :: z1spongearea 188 REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 189 190 #if defined SPONGE || defined SPONGE_TOP 191 192 CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 193 194 ispongearea = 2 + 2 * Agrif_irhox() 195 ilci = nlci - ispongearea 196 ilcj = nlcj - ispongearea 197 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 198 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 199 200 ! Tracers 201 IF( .NOT. spongedoneT ) THEN 202 zlocalviscsponge(:,:) = 0. 203 spe1ur(:,:) = 0. 204 spe2vr(:,:) = 0. 205 206 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 207 DO ji = 2, ispongearea 208 zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea 209 ENDDO 210 spe1ur(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) + zlocalviscsponge(3:ispongearea,: ) ) & 211 & * e2u(2:ispongearea-1,: ) / e1u(2:ispongearea-1,: ) 212 spe2vr(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) & 213 & * e1v(2:ispongearea ,1:jpjm1) / e2v(2:ispongearea ,1:jpjm1) 214 ENDIF 215 216 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 217 DO ji = ilci+1,nlci-1 218 zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 219 ENDDO 220 221 spe1ur(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) ) & 222 & * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 223 224 spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) & 225 & * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 226 ENDIF 227 228 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 229 DO jj = 2, ispongearea 230 zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 231 ENDDO 232 spe1ur(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) & 233 & * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 234 235 spe2vr(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) + zlocalviscsponge(:,3:ispongearea) ) & 236 & * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 237 ENDIF 238 239 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 240 DO jj = ilcj+1,nlcj-1 241 zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 242 ENDDO 243 spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) & 244 & * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 245 spe2vr(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) + zlocalviscsponge(:,ilcj+2:nlcj-1) ) & 246 & * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 247 ENDIF 248 spongedoneT = .TRUE. 249 ENDIF 250 251 ! Dynamics 252 IF( .NOT. spongedoneU ) THEN 253 zlocalviscsponge(:,:) = 0. 254 spe1ur2(:,:) = 0. 255 spe2vr2(:,:) = 0. 256 257 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 258 DO ji = 2, ispongearea 259 zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 260 ENDDO 261 spe1ur2(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) + zlocalviscsponge(3:ispongearea,: ) ) 262 spe2vr2(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) 263 ENDIF 264 265 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 266 DO ji = ilci+1,nlci-1 267 zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 268 ENDDO 269 spe1ur2(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) ) 270 spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) 271 ENDIF 272 273 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 274 DO jj = 2, ispongearea 275 zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 276 ENDDO 277 spe1ur2(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) 278 spe2vr2(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) + zlocalviscsponge(:,3:ispongearea) ) 279 ENDIF 280 281 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 282 DO jj = ilcj+1,nlcj-1 283 zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 284 ENDDO 285 spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) 286 spe2vr2(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) + zlocalviscsponge(:,ilcj+2:nlcj-1) ) 287 ENDIF 288 spongedoneU = .TRUE. 289 spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) ) 290 ENDIF 291 ! 292 CALL wrk_dealloc( jpi, jpj, zlocalviscsponge ) 293 ! 294 #endif 295 296 END SUBROUTINE Agrif_Sponge 297 326 298 SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 327 299 !!--------------------------------------------- 328 300 !! *** ROUTINE interptsn *** 329 301 !!--------------------------------------------- 330 # include "domzgr_substitute.h90"331 332 302 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 333 303 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 341 311 !! *** ROUTINE interpun *** 342 312 !!--------------------------------------------- 343 # include "domzgr_substitute.h90"344 345 313 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 346 314 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres … … 354 322 !! *** ROUTINE interpvn *** 355 323 !!--------------------------------------------- 356 # include "domzgr_substitute.h90"357 358 324 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 359 325 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r3294 r3566 27 27 28 28 SUBROUTINE Agrif_trc 29 !!--------------------------------------------- 30 !! *** ROUTINE Agrif_trc *** 31 !!--------------------------------------------- 32 33 INTEGER :: ji,jj,jk,jn 34 REAL(wp) :: zrhox 35 REAL(wp) :: alpha1, alpha2, alpha3, alpha4 36 REAL(wp) :: alpha5, alpha6, alpha7 29 !!---------------------------------------------------------------------- 30 !! *** ROUTINE Agrif_Tra *** 31 !!---------------------------------------------------------------------- 32 !! 33 INTEGER :: ji, jj, jk, jn ! dummy loop indices 34 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 35 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 37 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 38 39 IF (Agrif_Root()) RETURN 37 !!---------------------------------------------------------------------- 38 ! 39 IF( Agrif_Root() ) RETURN 40 40 41 41 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 42 42 43 Agrif_SpecialValue =0.43 Agrif_SpecialValue = 0.e0 44 44 Agrif_UseSpecialValue = .TRUE. 45 ztra = 0.e045 ztra(:,:,:,:) = 0.e0 46 46 47 CALL Agrif_Bc_variable( ztra,trn_id, procname =interptrn )47 CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 48 48 Agrif_UseSpecialValue = .FALSE. 49 49 50 50 zrhox = Agrif_Rhox() 51 51 52 alpha1 = ( zrhox-1.)/2.53 alpha2 = 1. -alpha152 alpha1 = ( zrhox - 1. ) * 0.5 53 alpha2 = 1. - alpha1 54 54 55 alpha3 = ( zrhox-1)/(zrhox+1)56 alpha4 = 1. -alpha355 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 56 alpha4 = 1. - alpha3 57 57 58 alpha6 = 2. *(zrhox-1.)/(zrhox+1.)59 alpha7 = -(zrhox-1)/(zrhox+3)58 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 59 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 60 60 alpha5 = 1. - alpha6 - alpha7 61 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 61 62 62 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 63 tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 64 DO jn=1,jptra 65 DO jk=1,jpk 66 DO jj=1,jpj 67 IF (umask(nlci-2,jj,jk).EQ.0.) THEN 63 DO jn = 1, jptra 64 tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 65 DO jk = 1, jpkm1 66 DO jj = 1, jpj 67 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 68 68 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 69 69 ELSE 70 70 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF (un(nlci-2,jj,jk).GT.0.) THEN 72 tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 72 tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 & + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 74 ENDIF 75 ENDIF 76 END DO 77 END DO 78 ENDDO 79 ENDIF 80 81 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 82 83 DO jn = 1, jptra 84 tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 85 DO jk = 1, jpkm1 86 DO ji = 1, jpi 87 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 88 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 89 ELSE 90 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 91 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 92 tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 93 & + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 94 ENDIF 95 ENDIF 96 END DO 97 END DO 98 ENDDO 99 ENDIF 100 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 101 DO jn = 1, jptra 102 tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 103 DO jk = 1, jpkm1 104 DO jj = 1, jpj 105 IF( umask(2,jj,jk) == 0.e0 ) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF( un(2,jj,jk) < 0.e0 ) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 74 111 ENDIF 75 112 ENDIF … … 79 116 ENDIF 80 117 81 IF ((nbondj == 1).OR.(nbondj == 2)) THEN82 tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)83 DO jn=1, jptra84 DO jk=1,jpk 118 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 119 DO jn = 1, jptra 120 tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 121 DO jk=1,jpk 85 122 DO ji=1,jpi 86 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN87 tra(ji, nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)123 IF( vmask(ji,2,jk) == 0.e0 ) THEN 124 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 88 125 ELSE 89 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 90 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 91 tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 92 +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 126 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 127 IF( vn(ji,2,jk) < 0.e0 ) THEN 128 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 93 129 ENDIF 94 130 ENDIF 95 131 END DO 96 132 END DO 97 END 133 ENDDO 98 134 ENDIF 99 100 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 101 tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 102 DO jn=1, jptra 103 DO jk=1,jpk 104 DO jj=1,jpj 105 IF (umask(2,jj,jk).EQ.0.) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF (un(2,jj,jk).LT.0.) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 111 +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 112 ENDIF 113 ENDIF 114 END DO 115 END DO 116 END DO 117 ENDIF 118 119 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 120 tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 121 DO jn=1, jptra 122 DO jk=1,jpk 123 DO ji=1,jpi 124 IF (vmask(ji,2,jk).EQ.0.) THEN 125 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 126 ELSE 127 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 128 IF (vn(ji,2,jk) .LT. 0.) THEN 129 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 130 +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 131 ENDIF 132 ENDIF 133 END DO 134 END DO 135 END DO 136 ENDIF 137 135 ! 138 136 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 137 ! 139 138 140 139 END SUBROUTINE Agrif_trc -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3294 r3566 8 8 USE in_out_manager 9 9 USE agrif_oce 10 USE agrif_opa_sponge 10 11 USE trc 11 12 USE lib_mpp … … 17 18 PUBLIC Agrif_Sponge_Trc, interptrn 18 19 20 !! * Substitutions 21 # include "domzgr_substitute.h90" 19 22 !!---------------------------------------------------------------------- 20 23 !! NEMO/NST 3.3 , NEMO Consortium (2010) … … 29 32 !! *** ROUTINE Agrif_Sponge_Trc *** 30 33 !!--------------------------------------------- 31 #include "domzgr_substitute.h90"32 34 !! 33 INTEGER :: ji,jj,jk,jl 34 INTEGER :: spongearea 35 INTEGER :: ji,jj,jk,jn 35 36 REAL(wp) :: timecoeff 36 37 REAL(wp) :: ztra, zabe1, zabe2, zbtr 37 REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 38 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab 38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 39 41 40 42 #if defined SPONGE_TOP 41 CALL wrk_alloc( jpi, jpj, localviscsponge)42 CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab)43 CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 43 45 44 46 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 46 48 Agrif_SpecialValue=0. 47 49 Agrif_UseSpecialValue = .TRUE. 48 ztab = 0.e049 CALL Agrif_Bc_Variable(ztab , tra_id,calledweight=timecoeff,procname=interptrn)50 ztabr = 0.e0 51 CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 50 52 Agrif_UseSpecialValue = .FALSE. 51 53 52 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab (:,:,:,:)54 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 53 55 54 spongearea = 2 + 2 * Agrif_irhox()56 CALL Agrif_sponge 55 57 56 localviscsponge = 0. 57 58 IF (.NOT. spongedoneT) THEN 59 spe1ur(:,:) = 0. 60 spe2vr(:,:) = 0. 58 DO jn = 1, jptra 59 DO jk = 1, jpkm1 60 ! 61 DO jj = 1, jpjm1 62 DO ji = 1, jpim1 63 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 64 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 65 ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 66 ztrv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 67 ENDDO 68 ENDDO 61 69 62 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 63 DO ji = 2, spongearea 64 localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 70 DO jj = 2,jpjm1 71 DO ji = 2,jpim1 72 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 73 ! horizontal diffusive trends 74 ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1) ) 75 ! add it to the general tracer trends 76 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 77 END DO 78 END DO 79 ! 65 80 ENDDO 66 67 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &68 * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)69 70 spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &71 localviscsponge(2:spongearea,2:jpj)) &72 * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)73 ENDIF74 75 IF ((nbondi == 1).OR.(nbondi == 2)) THEN76 DO ji = nlci-spongearea + 1,nlci-177 localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)78 ENDDO79 80 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &81 localviscsponge(nlci-spongearea + 2:nlci-1,:)) &82 * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)83 84 spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &85 + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &86 * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)87 ENDIF88 89 90 IF ((nbondj == -1).OR.(nbondj == 2)) THEN91 DO jj = 2, spongearea92 localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)93 ENDDO94 95 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &96 localviscsponge(2:jpi,2:spongearea)) &97 * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)98 99 spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &100 localviscsponge(:,3:spongearea)) &101 * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)102 ENDIF103 104 IF ((nbondj == 1).OR.(nbondj == 2)) THEN105 DO jj = nlcj-spongearea + 1,nlcj-1106 localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)107 ENDDO108 109 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &110 localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &111 * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)112 113 spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &114 localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &115 * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)116 ENDIF117 118 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))119 120 spongedoneT = .TRUE.121 ENDIF122 123 DO jl = 1, jptra124 DO jk = 1, jpkm1125 DO jj = 1, jpjm1126 DO ji = 1, jpim1127 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)128 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)129 ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj ,jk,jl) - trbdiff(ji,jj,jk,jl) )130 ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )131 ENDDO132 ENDDO133 134 DO jj = 2,jpjm1135 DO ji = 2,jpim1136 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)137 ! horizontal diffusive trends138 ztra = zbtr * ( ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl) &139 & + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl) )140 ! add it to the general tracer trends141 tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)142 END DO143 END DO144 145 ENDDO146 81 ENDDO 147 82 148 CALL wrk_dealloc( jpi, jpj, localviscsponge)149 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, zt ru, ztrv, ztab)83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 150 85 151 86 #endif … … 153 88 END SUBROUTINE Agrif_Sponge_Trc 154 89 155 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2, l1,l2)90 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 156 91 !!--------------------------------------------- 157 92 !! *** ROUTINE interptn *** 158 93 !!--------------------------------------------- 159 # include "domzgr_substitute.h90" 160 161 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 162 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 163 164 tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2) 94 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 95 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 96 ! 97 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 165 98 166 99 END SUBROUTINE interptrn -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r3294 r3566 38 38 39 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jpt s, ztra )40 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 41 41 42 42 Agrif_UseSpecialValueInUpdate = .TRUE. … … 52 52 nbcline_trc = nbcline_trc + 1 53 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jpt s, ztra )54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 55 55 #endif 56 56 57 57 END SUBROUTINE Agrif_Update_Trc 58 58 59 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2, l1,l2,before)59 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 60 60 !!--------------------------------------------- 61 61 !! *** ROUTINE UpdateTrc *** 62 62 !!--------------------------------------------- 63 # include "domzgr_substitute.h90" 64 65 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 66 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 63 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 67 65 LOGICAL, INTENT(in) :: before 68 66 69 INTEGER :: ji,jj,jk,j l67 INTEGER :: ji,jj,jk,jn 70 68 71 IF (before) THEN72 DO j l=l1,l273 DO jk =k1,k274 DO jj =j1,j275 DO ji =i1,i276 tabres(ji,jj,jk,j l) = trn(ji,jj,jk,jl)69 IF( before ) THEN 70 DO jn = n1, n2 71 DO jk = k1, k2 72 DO jj = j1, j2 73 DO ji = i1, i2 74 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 77 75 ENDDO 78 76 ENDDO … … 80 78 ENDDO 81 79 ELSE 82 DO j l=l1,l283 DO jk =k1,k284 DO jj =j1,j285 DO ji =i1,i286 IF (tabres(ji,jj,jk,jl).NE.0.) THEN87 trn(ji,jj,jk,j l) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)80 DO jn = n1, n2 81 DO jk = k1, k2 82 DO jj = j1, j2 83 DO ji = i1, i2 84 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 85 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 88 86 ENDIF 89 87 ENDDO -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r3454 r3566 434 434 USE dom_oce 435 435 USE nemogcm 436 USE par_trc 436 437 USE trc 437 438 USE in_out_manager … … 457 458 Agrif_SpecialValue=0. 458 459 Agrif_UseSpecialValue = .TRUE. 459 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1. )460 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 460 461 Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 461 462 Agrif_UseSpecialValue = .FALSE. … … 515 516 ENDIF 516 517 517 CALL Agrif_Update_trc(0)518 !ch CALL Agrif_Update_trc(0) 518 519 nbcline_trc = 0 519 520 ! -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r3332 r3566 30 30 PUBLIC prt_ctl_info ! called by all subroutines 31 31 PUBLIC prt_ctl_init ! called by opa.F90 32 PUBLIC sub_dom ! called by opa.F90 32 33 33 34 !!---------------------------------------------------------------------- … … 419 420 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 420 421 421 INTEGER, DIMENSION(:,:), ALLOCATABLE:: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace422 INTEGER, POINTER, DIMENSION(:,:) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 422 423 REAL(wp) :: zidom, zjdom ! temporary scalars 423 424 !!---------------------------------------------------------------------- 424 425 426 ! 427 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 428 ! 425 429 ! 1. Dimension arrays for subdomains 426 430 ! ----------------------------------- … … 438 442 #endif 439 443 440 ALLOCATE(ilcitl (isplt,jsplt))441 ALLOCATE(ilcjtl (isplt,jsplt))442 444 443 445 nrecil = 2 * jpreci … … 512 514 ! ------------------------------- 513 515 514 ALLOCATE(iimpptl(isplt,jsplt))515 ALLOCATE(ijmpptl(isplt,jsplt))516 517 516 iimpptl(:,:) = 1 518 517 ijmpptl(:,:) = 1 … … 572 571 END DO 573 572 ! 574 DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 573 ! 574 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 575 ! 575 576 ! 576 577 END SUBROUTINE sub_dom -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3454 r3566 118 118 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 119 119 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 120 # if defined key_top 121 CALL Agrif_Declare_Var_top ! " " " " " TOP 122 # endif 120 123 # if defined key_lim2 121 124 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 122 # endif123 # if defined key_top124 CALL Agrif_Declare_Var_top ! " " " " " TOP125 125 # endif 126 126 #endif -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r3294 r3566 34 34 USE tranxt 35 35 # if defined key_agrif 36 USE agrif_top_update37 36 USE agrif_top_interp 38 37 # endif … … 146 145 ENDIF 147 146 148 #if defined key_agrif149 ! Update tracer at AGRIF zoom boundaries150 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Trc( kt ) ! children only151 #endif152 153 147 ! trends computation 154 148 IF( l_trdtrc ) THEN ! trends -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r3294 r3566 29 29 30 30 #if defined key_agrif 31 USE agrif_top_sponge ! Momemtum and tracers sponges 31 USE agrif_top_sponge ! tracers sponges 32 USE agrif_top_update ! tracers updates 32 33 #endif 33 34 … … 76 77 CALL trc_nxt( kstp ) ! tracer fields at next time step 77 78 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 79 80 #if defined key_agrif 81 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp ) ! Update tracer at AGRIF zoom boundaries : children only 82 #endif 78 83 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 79 84 ! tracers at the bottom ocean level … … 98 103 !!---------------------------------------------------------------------- 99 104 CONTAINS 100 SUBROUTINE trc_trp( k t) ! Empty routine101 INTEGER, INTENT(in) :: k t102 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', k t105 SUBROUTINE trc_trp( kstp ) ! Empty routine 106 INTEGER, INTENT(in) :: kstp 107 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 103 108 END SUBROUTINE trc_trp 104 109 #endif -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r3294 r3566 56 56 57 57 !* model domain * 58 USE dom_oce , ONLY : lzoom => lzoom !: zoom flag 59 USE dom_oce , ONLY : lzoom_e => lzoom_e !: East zoom type flag 60 USE dom_oce , ONLY : lzoom_w => lzoom_w !: West zoom type flag 61 USE dom_oce , ONLY : lzoom_s => lzoom_s !: South zoom type flag 62 USE dom_oce , ONLY : lzoom_n => lzoom_n !: North zoom type flag 63 USE dom_oce , ONLY : lzoom_arct => lzoom_arct !: ORCA arctic zoom flag 64 USE dom_oce , ONLY : lzoom_anta => lzoom_anta !: ORCA antarctic zoom flag 65 USE dom_oce , ONLY : nperio => nperio !: type of lateral boundary condition 66 USE dom_oce , ONLY : nimpp => nimpp !: i index for mpp-subdomain left bottom 67 USE dom_oce , ONLY : njmpp => njmpp !: j index for mpp-subdomain left bottom 68 USE dom_oce , ONLY : nproc => nproc !: number for local processor 69 USE dom_oce , ONLY : narea => narea !: number for local area 70 USE dom_oce , ONLY : mig => mig !: local ==> global domain i-indice 71 USE dom_oce , ONLY : mjg => mjg !: local ==> global domain i-indice 72 USE dom_oce , ONLY : mi0 => mi0 !: global ==> local domain i-indice 73 USE dom_oce , ONLY : mi1 => mi1 !: (mi0=1 and mi1=0 if the global indice is not in the local one) 74 USE dom_oce , ONLY : mj0 => mj0 !: global ==> local domain j-indice 75 USE dom_oce , ONLY : mj1 => mj1 !: (mj0=1 and mj1=0 if the global indice is not in the local one) 76 USE dom_oce , ONLY : nidom => nidom 77 USE dom_oce , ONLY : nimppt => nimppt !:i-indexes for each processor 78 USE dom_oce , ONLY : njmppt => njmppt !:j-indexes for each processor 79 USE dom_oce , ONLY : ibonit => ibonit !:i-processor neighbour existence 80 USE dom_oce , ONLY : ibonjt => ibonjt !:j- processor neighbour existence 81 USE dom_oce , ONLY : nlci => nlci !:i- & j-dimensions of the local subdomain 82 USE dom_oce , ONLY : nlcj => nlcj !: 83 USE dom_oce , ONLY : nldi => nldi !:first and last indoor i- and j-indexes 84 USE dom_oce , ONLY : nlei => nlei !: 85 USE dom_oce , ONLY : nldj => nldj !: 86 USE dom_oce , ONLY : nlej => nlej !: 87 USE dom_oce , ONLY : nlcit => nlcit !:dimensions of every i-subdomain 88 USE dom_oce , ONLY : nlcjt => nlcjt !:dimensions of every j-subdomain 89 USE dom_oce , ONLY : nldit => nldit !:first indoor index for each i-domain 90 USE dom_oce , ONLY : nleit => nleit !:last indoor index for each i-domain 91 USE dom_oce , ONLY : nldjt => nldjt !:first indoor index for each j-domain 92 USE dom_oce , ONLY : nlejt => nlejt !:last indoor index for each j-domain 93 94 !* horizontal mesh * 95 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 96 USE dom_oce , ONLY : glamu => glamu !: longitude of t-point (degre) 97 USE dom_oce , ONLY : glamv => glamv !: longitude of t-point (degre) 98 USE dom_oce , ONLY : glamf => glamf !: longitude of t-point (degre) 99 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 100 USE dom_oce , ONLY : gphiu => gphiu !: latitude of t-point (degre) 101 USE dom_oce , ONLY : gphiv => gphiv !: latitude of t-point (degre) 102 USE dom_oce , ONLY : gphif => gphif !: latitude of t-point (degre) 103 USE dom_oce , ONLY : e1t => e1t !: horizontal scale factors at t-point (m) 104 USE dom_oce , ONLY : e2t => e2t !: horizontal scale factors at t-point (m) 105 USE dom_oce , ONLY : e1e2t => e1e2t !: cell surface at t-point (m2) 106 USE dom_oce , ONLY : e1u => e1u !: horizontal scale factors at u-point (m) 107 USE dom_oce , ONLY : e2u => e2u !: horizontal scale factors at u-point (m) 108 USE dom_oce , ONLY : e1v => e1v !: horizontal scale factors at v-point (m) 109 USE dom_oce , ONLY : e2v => e2v !: horizontal scale factors at v-point (m) 110 111 !* vertical mesh * 112 USE dom_oce , ONLY : gdept_0 => gdept_0 !: reference depth of t-points (m) 113 USE dom_oce , ONLY : e3t_0 => e3t_0 !: reference depth of t-points (m) 114 USE dom_oce , ONLY : e3w_0 => e3w_0 !: reference depth of w-points (m) 115 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of w-points (m) 116 # if ! defined key_zco 117 USE dom_oce , ONLY : gdep3w => gdep3w !: ??? 118 USE dom_oce , ONLY : gdept => gdept !: depth of t-points (m) 119 USE dom_oce , ONLY : gdepw => gdepw !: depth of t-points (m) 120 USE dom_oce , ONLY : e3t => e3t !: vertical scale factors at t- 121 USE dom_oce , ONLY : e3u => e3u !: vertical scale factors at u- 122 USE dom_oce , ONLY : e3v => e3v !: vertical scale factors v- 123 USE dom_oce , ONLY : e3w => e3w !: w-points (m) 124 USE dom_oce , ONLY : e3f => e3f !: f-points (m) 125 USE dom_oce , ONLY : e3uw => e3uw !: uw-points (m) 126 USE dom_oce , ONLY : e3vw => e3vw !: vw-points (m) 127 # endif 128 USE dom_oce , ONLY : ln_zps => ln_zps !: partial steps flag 129 USE dom_oce , ONLY : ln_sco => ln_sco !: s-coordinate flag 130 USE dom_oce , ONLY : ln_zco => ln_zco !: z-coordinate flag 131 USE dom_oce , ONLY : hbatt => hbatt !: ocean depth at the vertical of t-point (m) 132 USE dom_oce , ONLY : hbatu => hbatu !: ocean depth at the vertical of u-point (m) 133 USE dom_oce , ONLY : hbatv => hbatv !: ocean depth at the vertical of w-point (m) 134 USE dom_oce , ONLY : gsigt => gsigt !: model level depth coefficient at T-levels 135 USE dom_oce , ONLY : gsigw => gsigw !: model level depth coefficient at W-levels 136 USE dom_oce , ONLY : gsi3w => gsi3w !: model level depth coef at w-levels (defined as the sum of e3w) 137 USE dom_oce , ONLY : esigt => esigt !: vertical scale factor coef. at t-levels 138 USE dom_oce , ONLY : esigw => esigw !: vertical scale factor coef. at w-levels 139 USE dom_oce , ONLY : lk_vvl => lk_vvl !: variable grid flag 140 # if defined key_vvl 141 USE dom_oce , ONLY : gdep3w_1 => gdep3w_1 !: ??? 142 USE dom_oce , ONLY : gdept_1 => gdept_1 !: depth of t-points (m) 143 USE dom_oce , ONLY : gdepw_1 => gdepw_1 !: depth of t-points (m) 144 USE dom_oce , ONLY : e3t_1 => e3t_1 !: vertical scale factors at t- 145 USE dom_oce , ONLY : e3u_1 => e3u_1 !: vertical scale factors at u- 146 USE dom_oce , ONLY : e3v_1 => e3v_1 !: vertical scale factors v- 147 USE dom_oce , ONLY : e3w_1 => e3w_1 !: w-points (m) 148 USE dom_oce , ONLY : e3f_1 => e3f_1 !: f-points (m) 149 USE dom_oce , ONLY : e3uw_1 => e3uw_1 !: uw-points (m) 150 USE dom_oce , ONLY : e3vw_1 => e3vw_1 !: vw-points (m) 151 # endif 152 !* masks, bathymetry * 153 USE dom_oce , ONLY : mbkt => mbkt !: vertical index of the bottom last T- ocean level 154 USE dom_oce , ONLY : mbku => mbku !: vertical index of the bottom last U- ocean level 155 USE dom_oce , ONLY : mbkv => mbkv !: vertical index of the bottom last V- ocean level 156 USE dom_oce , ONLY : tmask_i => tmask_i !: Interior mask at t-points 157 USE dom_oce , ONLY : tmask => tmask !: land/ocean mask at t-points 158 USE dom_oce , ONLY : umask => umask !: land/ocean mask at u-points 159 USE dom_oce , ONLY : vmask => vmask !: land/ocean mask at v-points 160 USE dom_oce , ONLY : fmask => fmask !: land/ocean mask at f-points 161 162 !* time domain * 163 USE dom_oce , ONLY : neuler => neuler !: restart euler forward option (0=Euler) 164 USE dom_oce , ONLY : rdt => rdt !: time step for the dynamics 165 USE dom_oce , ONLY : atfp => atfp !: asselin time filter parameter 166 USE dom_oce , ONLY : atfp1 => atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 167 USE dom_oce , ONLY : rdttra => rdttra !: vertical profile of tracer time step 168 ! !: it is the accumulated duration of previous runs 169 ! !: that may have been run with different time steps. 170 !* calendar variables * 171 USE dom_oce , ONLY : nyear => nyear !: current year 172 USE dom_oce , ONLY : nmonth => nmonth !: current month 173 USE dom_oce , ONLY : nday => nday !: current day of the month 174 USE dom_oce , ONLY : ndastp => ndastp !: time step date in yyyymmdd format 175 USE dom_oce , ONLY : nday_year => nday_year !: current day counted from jan 1st of the current year 176 USE dom_oce , ONLY : nsec_year => nsec_year !: current time step counted in second since 00h jan 1st of the current year 177 USE dom_oce , ONLY : nsec_month => nsec_month !: current time step counted in second since 00h 1st day of the current month 178 USE dom_oce , ONLY : nsec_day => nsec_day !: current time step counted in second since 00h of the current day 179 USE dom_oce , ONLY : fjulday => fjulday !: julian day 180 USE dom_oce , ONLY : adatrj => adatrj !: number of elapsed days since the begining of the whole simulation 181 !: (cumulative duration of previous runs 182 !: that may have used different time-step size) 183 USE dom_oce , ONLY : nyear_len => nyear_len !: length in days of the previous/current year 184 USE dom_oce , ONLY : nmonth_len => nmonth_len !: length in days of the months of the current year 58 USE dom_oce 185 59 186 60 … … 217 91 USE oce , ONLY : grv => grv !: 218 92 #endif 219 220 USE dom_oce , ONLY : nn_cla => nn_cla !: flag (0/1) for cross land advection221 93 222 94 !* surface fluxes * -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
r3294 r3566 17 17 USE par_trc ! TOP parameters 18 18 USE oce_trc ! ocean space and time domain variables 19 USE prtctl ! print control for OPA 19 20 20 21 IMPLICIT NONE … … 296 297 END SUBROUTINE prt_ctl_trc_init 297 298 298 299 SUBROUTINE sub_dom300 !!----------------------------------------------------------------------301 !! *** ROUTINE sub_dom ***302 !!303 !! ** Purpose : Lay out the global domain over processors.304 !! CAUTION:305 !! This part has been extracted from the mpp_init306 !! subroutine and names of variables/arrays have been307 !! slightly changed to avoid confusion but the computation308 !! is exactly the same. Any modification about indices of309 !! each sub-domain in the mppini.F90 module should be reported310 !! here.311 !!312 !! ** Method : Global domain is distributed in smaller local domains.313 !! Periodic condition is a function of the local domain position314 !! (global boundary or neighbouring domain) and of the global315 !! periodic316 !! Type : jperio global periodic condition317 !! nperio local periodic condition318 !!319 !! ** Action : - set domain parameters320 !! nimpp : longitudinal index321 !! njmpp : latitudinal index322 !! nperio : lateral condition type323 !! narea : number for local area324 !! nlcil : first dimension325 !! nlcjl : second dimension326 !! nbondil : mark for "east-west local boundary"327 !! nbondjl : mark for "north-south local boundary"328 !!----------------------------------------------------------------------329 INTEGER :: ji, jj, js ! dummy loop indices330 INTEGER :: ii, ij ! temporary integers331 INTEGER :: irestil, irestjl ! " "332 INTEGER :: ijpi , ijpj, nlcil ! temporary logical unit333 INTEGER :: nlcjl , nbondil, nbondjl334 INTEGER :: nrecil, nrecjl, nldil, nleil, nldjl, nlejl335 REAL(wp) :: zidom, zjdom ! temporary scalars336 INTEGER, POINTER, DIMENSION(:,:) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! temporary workspace337 !!----------------------------------------------------------------------338 !339 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )340 !341 ! Dimension arrays for subdomains342 ! -------------------------------343 ! Computation of local domain sizes ilcitl() ilcjtl()344 ! These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo345 ! The subdomains are squares leeser than or equal to the global346 ! dimensions divided by the number of processors minus the overlap347 ! array (cf. par_oce.F90).348 349 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci350 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj351 352 nrecil = 2 * jpreci353 nrecjl = 2 * jprecj354 irestil = MOD( jpiglo - nrecil , isplt )355 irestjl = MOD( jpjglo - nrecjl , jsplt )356 357 IF( irestil == 0 ) irestil = isplt358 DO jj = 1, jsplt359 DO ji = 1, irestil360 ilcitl(ji,jj) = ijpi361 END DO362 DO ji = irestil+1, isplt363 ilcitl(ji,jj) = ijpi -1364 END DO365 END DO366 367 IF( irestjl == 0 ) irestjl = jsplt368 DO ji = 1, isplt369 DO jj = 1, irestjl370 ilcjtl(ji,jj) = ijpj371 END DO372 DO jj = irestjl+1, jsplt373 ilcjtl(ji,jj) = ijpj -1374 END DO375 END DO376 377 zidom = nrecil378 DO ji = 1, isplt379 zidom = zidom + ilcitl(ji,1) - nrecil380 END DO381 382 zjdom = nrecjl383 DO jj = 1, jsplt384 zjdom = zjdom + ilcjtl(1,jj) - nrecjl385 END DO386 387 ! Index arrays for subdomains388 ! ---------------------------389 390 iimpptl(:,:) = 1391 ijmpptl(:,:) = 1392 393 IF( isplt > 1 ) THEN394 DO jj = 1, jsplt395 DO ji = 2, isplt396 iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil397 END DO398 END DO399 ENDIF400 401 IF( jsplt > 1 ) THEN402 DO jj = 2, jsplt403 DO ji = 1, isplt404 ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl405 END DO406 END DO407 ENDIF408 409 ! Subdomain description410 ! ---------------------411 412 DO js = 1, ijsplt413 ii = 1 + MOD( js-1, isplt )414 ij = 1 + (js-1) / isplt415 nimpptl(js) = iimpptl(ii,ij)416 njmpptl(js) = ijmpptl(ii,ij)417 nlcitl (js) = ilcitl (ii,ij)418 nlcil = nlcitl (js)419 nlcjtl (js) = ilcjtl (ii,ij)420 nlcjl = nlcjtl (js)421 nbondjl = -1 ! general case422 IF( js > isplt ) nbondjl = 0 ! first row of processor423 IF( js > (jsplt-1)*isplt ) nbondjl = 1 ! last row of processor424 IF( jsplt == 1 ) nbondjl = 2 ! one processor only in j-direction425 ibonjtl(js) = nbondjl426 427 nbondil = 0 !428 IF( MOD( js, isplt ) == 1 ) nbondil = -1 !429 IF( MOD( js, isplt ) == 0 ) nbondil = 1 !430 IF( isplt == 1 ) nbondil = 2 ! one processor only in i-direction431 ibonitl(js) = nbondil432 433 nldil = 1 + jpreci434 nleil = nlcil - jpreci435 IF( nbondil == -1 .OR. nbondil == 2 ) nldil = 1436 IF( nbondil == 1 .OR. nbondil == 2 ) nleil = nlcil437 nldjl = 1 + jprecj438 nlejl = nlcjl - jprecj439 IF( nbondjl == -1 .OR. nbondjl == 2 ) nldjl = 1440 IF( nbondjl == 1 .OR. nbondjl == 2 ) nlejl = nlcjl441 nlditl(js) = nldil442 nleitl(js) = nleil443 nldjtl(js) = nldjl444 nlejtl(js) = nlejl445 END DO446 !447 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )448 !449 END SUBROUTINE sub_dom450 451 299 #else 452 300 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.