Changeset 5845 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2015-10-31T08:40:45+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r5656 r5845 46 46 # endif 47 47 48 # include "domzgr_substitute.h90"49 48 # include "vectopt_loop_substitute.h90" 50 49 !!---------------------------------------------------------------------- … … 76 75 !! *** ROUTINE Agrif_DYN *** 77 76 !!---------------------------------------------------------------------- 78 !!79 77 INTEGER, INTENT(in) :: kt 80 ! !78 ! 81 79 INTEGER :: ji,jj,jk, j1,j2, i1,i2 82 80 REAL(wp) :: timeref … … 137 135 DO jk=1,jpkm1 138 136 DO jj=1,jpj 139 spgu(2,jj)=spgu(2,jj)+ fse3u(2,jj,jk)*ua(2,jj,jk)137 spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 140 138 END DO 141 139 END DO … … 143 141 DO jj=1,jpj 144 142 IF (umask(2,jj,1).NE.0.) THEN 145 spgu(2,jj)=spgu(2,jj) /hu(2,jj)143 spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 146 144 ENDIF 147 145 END DO … … 161 159 DO jk=1,jpkm1 162 160 DO jj=1,jpj 163 spgu1(2,jj)=spgu1(2,jj)+ fse3u(2,jj,jk)*ua(2,jj,jk)161 spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 164 162 END DO 165 163 END DO … … 167 165 DO jj=1,jpj 168 166 IF (umask(2,jj,1).NE.0.) THEN 169 spgu1(2,jj)=spgu1(2,jj) /hu(2,jj)167 spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 170 168 ENDIF 171 169 END DO … … 182 180 DO jk=1,jpkm1 183 181 DO jj=1,jpj 184 spgv1(2,jj)=spgv1(2,jj)+ fse3v_a(2,jj,jk)*va(2,jj,jk)182 spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 185 183 END DO 186 184 END DO 187 185 DO jj=1,jpj 188 spgv1(2,jj)=spgv1(2,jj)* hvr_a(2,jj)186 spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 189 187 END DO 190 188 DO jk=1,jpkm1 … … 207 205 DO jk=1,jpkm1 208 206 DO jj=1,jpj 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+ fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)207 spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 208 ENDDO 211 209 ENDDO 212 210 DO jj=1,jpj 213 211 IF (umask(nlci-2,jj,1).NE.0.) THEN 214 spgu(nlci-2,jj)=spgu(nlci-2,jj) /hu(nlci-2,jj)212 spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 215 213 ENDIF 216 214 END DO … … 229 227 DO jk=1,jpkm1 230 228 DO jj=1,jpj 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+ fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)229 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 230 END DO 233 231 END DO 234 232 DO jj=1,jpj 235 233 IF (umask(nlci-2,jj,1).NE.0.) THEN 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj) /hu(nlci-2,jj)234 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 237 235 ENDIF 238 236 END DO … … 248 246 DO jk=1,jpkm1 249 247 DO jj=1,jpj 250 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+ fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk)248 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 251 249 END DO 252 250 END DO 253 251 254 252 DO jj=1,jpj 255 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)* hvr_a(nlci-1,jj)253 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 256 254 END DO 257 255 … … 278 276 DO jk=1,jpkm1 279 277 DO ji=1,jpi 280 spgv(ji,2)=spgv(ji,2)+ fse3v(ji,2,jk)*va(ji,2,jk)278 spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 281 279 END DO 282 280 END DO … … 284 282 DO ji=1,jpi 285 283 IF (vmask(ji,2,1).NE.0.) THEN 286 spgv(ji,2)=spgv(ji,2) /hv(ji,2)284 spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 287 285 ENDIF 288 286 END DO … … 302 300 DO jk=1,jpkm1 303 301 DO ji=1,jpi 304 spgv1(ji,2)=spgv1(ji,2)+ fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)302 spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 305 303 END DO 306 304 END DO … … 308 306 DO ji=1,jpi 309 307 IF (vmask(ji,2,1).NE.0.) THEN 310 spgv1(ji,2)=spgv1(ji,2) /hv(ji,2)308 spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 311 309 ENDIF 312 310 END DO … … 323 321 DO jk=1,jpkm1 324 322 DO ji=1,jpi 325 spgu1(ji,2)=spgu1(ji,2)+ fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk)323 spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 326 324 END DO 327 325 END DO 328 326 329 327 DO ji=1,jpi 330 spgu1(ji,2)=spgu1(ji,2)* hur_a(ji,2)328 spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 331 329 END DO 332 330 … … 353 351 DO jk=1,jpkm1 354 352 DO ji=1,jpi 355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+ fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)353 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 356 354 END DO 357 355 END DO … … 359 357 DO ji=1,jpi 360 358 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2) /hv(ji,nlcj-2)359 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 362 360 ENDIF 363 361 END DO … … 378 376 DO jk=1,jpkm1 379 377 DO ji=1,jpi 380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+ fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)378 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 381 379 END DO 382 380 END DO … … 384 382 DO ji=1,jpi 385 383 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2) /hv(ji,nlcj-2)384 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 387 385 ENDIF 388 386 END DO … … 399 397 DO jk=1,jpkm1 400 398 DO ji=1,jpi 401 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+ fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk)399 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 402 400 END DO 403 401 END DO 404 402 405 403 DO ji=1,jpi 406 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)* hur_a(ji,nlcj-1)404 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 407 405 END DO 408 406 … … 812 810 DO ji=i1,i2 813 811 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 814 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk)812 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 815 813 END DO 816 814 END DO … … 821 819 DO jj=j1,j2 822 820 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 823 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk)821 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 824 822 END DO 825 823 END DO … … 880 878 DO ji=i1,i2 881 879 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 882 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk)880 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 883 881 END DO 884 882 END DO … … 889 887 DO jj=j1,j2 890 888 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 891 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk)889 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 892 890 END DO 893 891 END DO … … 944 942 DO jj=j1,j2 945 943 DO ji=i1,i2 946 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu (ji,jj)944 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj) 947 945 END DO 948 946 END DO … … 1021 1019 DO jj=j1,j2 1022 1020 DO ji=i1,i2 1023 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv (ji,jj)1021 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj) 1024 1022 END DO 1025 1023 END DO … … 1209 1207 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1210 1208 ENDIF 1211 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)1209 WRITE(numout,*) ' ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1212 1210 kindic_agr = kindic_agr + 1 1213 1211 ENDIF … … 1219 1217 ! 1220 1218 END SUBROUTINE interpe3t 1219 1221 1220 1222 1221 SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)
Note: See TracChangeset
for help on using the changeset viewer.
