- Timestamp:
- 2014-03-26T10:48:29+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/LBC/lbcnfd_tam.F90
r3611 r4584 55 55 INTEGER :: ji, jk 56 56 INTEGER :: ijt, iju, ijpj, ijpjm1 57 ! 58 REAL(wp) :: ztmp 57 59 !!---------------------------------------------------------------------- 58 60 … … 73 75 DO ji = jpiglo, jpiglo/2+1, -1 74 76 ijt = jpiglo-ji+2 75 pt3d(ijt,ijpjm1,jk) = pt3d(ijt,ijpjm1,jk) +psgn * pt3d(ji,ijpjm1,jk)77 ztmp = psgn * pt3d(ji,ijpjm1,jk) 76 78 pt3d(ji ,ijpjm1,jk) = 0.0_wp 77 END DO 79 pt3d(ijt,ijpjm1,jk) = pt3d(ijt,ijpjm1,jk) + ztmp 80 END DO 81 78 82 DO ji = jpiglo, 2, -1 79 83 ijt = jpiglo-ji+2 … … 84 88 DO ji = jpiglo-1, jpiglo/2, -1 85 89 iju = jpiglo-ji+1 86 pt3d(iju,ijpjm1,jk) = pt3d(iju,ijpjm1,jk) +psgn * pt3d(ji,ijpjm1,jk)90 ztmp = psgn * pt3d(ji,ijpjm1,jk) 87 91 pt3d(ji ,ijpjm1,jk) = 0.0_wp 88 END DO 92 pt3d(iju,ijpjm1,jk) = pt3d(iju,ijpjm1,jk) + ztmp 93 END DO 94 89 95 DO ji = jpiglo-1, 1, -1 90 96 iju = jpiglo-ji+1 … … 128 134 DO ji = jpiglo, jpiglo/2+1, -1 129 135 ijt = jpiglo-ji+1 130 pt3d(ijt,ijpjm1,jk) = pt3d(ijt,ijpjm1,jk) +psgn * pt3d(ji,ijpjm1,jk)136 ztmp = psgn * pt3d(ji,ijpjm1,jk) 131 137 pt3d(ji ,ijpjm1,jk) = 0.0_wp 138 pt3d(ijt,ijpjm1,jk) = pt3d(ijt,ijpjm1,jk) + ztmp 132 139 END DO 133 140 DO ji = jpiglo, 1, -1 … … 139 146 DO ji = jpiglo-1, jpiglo/2+1, -1 140 147 iju = jpiglo-ji 141 pt3d(iju,ijpjm1,jk) = pt3d(iju,ijpjm1,jk) +psgn * pt3d(ji,ijpjm1,jk)148 ztmp = psgn * pt3d(ji,ijpjm1,jk) 142 149 pt3d(ji ,ijpjm1,jk) = 0.0_wp 150 pt3d(iju,ijpjm1,jk) = pt3d(iju,ijpjm1,jk) + ztmp 143 151 END DO 144 152 DO ji = jpiglo-1, 1, -1 … … 187 195 INTEGER :: ji, jl, ipr2dj 188 196 INTEGER :: ijt, iju, ijpj, ijpjm1 197 ! 198 REAL(wp) :: ztmp 189 199 !!---------------------------------------------------------------------- 190 200 … … 211 221 DO ji = jpiglo, jpiglo/2+1, -1 212 222 ijt=jpiglo-ji+2 213 pt2d(ijt,ijpj-1) = pt2d(ijt,ijpj-1) +psgn * pt2d(ji,ijpj-1)223 ztmp = psgn * pt2d(ji,ijpj-1) 214 224 pt2d(ji,ijpj-1) = 0.0_wp 225 pt2d(ijt,ijpj-1) = pt2d(ijt,ijpj-1) + ztmp 215 226 END DO 216 227 DO jl = ipr2dj, 0, -1 217 228 DO ji = jpiglo, 2, -1 218 229 ijt=jpiglo-ji+2 219 pt2d(ijt,ijpj-2-jl) = pt2d(ijt,ijpj-2-jl) +psgn * pt2d(ji,ijpj+jl)230 ztmp = psgn * pt2d(ji,ijpj+jl) 220 231 pt2d(ji ,ijpj+jl ) = 0.0_wp 232 pt2d(ijt,ijpj-2-jl) = pt2d(ijt,ijpj-2-jl) + ztmp 221 233 END DO 222 234 END DO … … 224 236 DO ji = jpiglo-1, jpiglo/2, -1 225 237 iju = jpiglo-ji+1 226 pt2d(iju,ijpjm1) = pt2d(iju,ijpjm1) +psgn * pt2d(ji,ijpjm1)238 ztmp = psgn * pt2d(ji,ijpjm1) 227 239 pt2d(ji,ijpjm1) = 0.0_wp 240 pt2d(iju,ijpjm1) = pt2d(iju,ijpjm1) + ztmp 228 241 END DO 229 242 DO jl = ipr2dj, 0, -1 230 243 DO ji = jpiglo-1, 1, -1 231 244 iju = jpiglo-ji+1 232 pt2d(iju,ijpj-2-jl) = pt2d(iju,ijpj-2-jl) +psgn * pt2d(ji,ijpj+jl)245 ztmp = psgn * pt2d(ji,ijpj+jl) 233 246 pt2d(ji ,ijpj+jl ) = 0.0_wp 247 pt2d(iju,ijpj-2-jl) = pt2d(iju,ijpj-2-jl) + ztmp 234 248 END DO 235 249 END DO … … 238 252 DO ji = jpiglo, 2, -1 239 253 ijt = jpiglo-ji+2 240 pt2d(ijt,ijpj-3-jl) = pt2d(ijt,ijpj-3-jl) +psgn * pt2d(ji,ijpj+jl)254 ztmp = psgn * pt2d(ji,ijpj+jl) 241 255 pt2d(ji ,ijpj+jl ) = 0.0_wp 256 pt2d(ijt,ijpj-3-jl) = pt2d(ijt,ijpj-3-jl) + ztmp 242 257 END DO 243 258 END DO … … 246 261 DO ji = jpiglo-1, 1, -1 247 262 iju = jpiglo-ji+1 248 pt2d(iju,ijpj-3-jl) = pt2d(iju,ijpj-3-jl) +psgn * pt2d(ji,ijpj+jl)263 ztmp = psgn * pt2d(ji,ijpj+jl) 249 264 pt2d(ji,ijpj+jl) = 0.0_wp 265 pt2d(iju,ijpj-3-jl) = pt2d(iju,ijpj-3-jl) + ztmp 250 266 END DO 251 267 END DO … … 254 270 DO ji = jpiglo, 3, -1 255 271 iju = jpiglo - ji + 3 256 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) +psgn * pt2d(ji,ijpj+jl)272 ztmp = psgn * pt2d(ji,ijpj+jl) 257 273 pt2d(ji,ijpj+jl) = 0.0_wp 258 END DO 259 pt2d(3,ijpj-1+jl) = pt2d(3,ijpj-1+jl) + psgn * pt2d(2,ijpj+jl) 274 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) + ztmp 275 END DO 276 ztmp = psgn * pt2d(2,ijpj+jl) 260 277 pt2d(2,ijpj+jl) = 0.0_wp 278 pt2d(3,ijpj-1+jl) = pt2d(3,ijpj-1+jl) + ztmp 261 279 END DO 262 280 CASE ( 'J' ) ! first ice U-V point … … 264 282 DO ji = 3, jpiglo 265 283 iju = jpiglo - ji + 3 266 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) +psgn * pt2d(ji,ijpj+jl)284 ztmp = psgn * pt2d(ji,ijpj+jl) 267 285 pt2d(ji,ijpj+jl) = 0.0_wp 286 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) + ztmp 268 287 END DO 269 288 pt2d(3,ijpj-1+jl) = pt2d(3,ijpj-1+jl) + psgn * pt2d(2,ijpj+jl) … … 277 296 pt2d(ji,ijpj+jl) = 0.0_wp 278 297 END DO 279 pt2d(3,ijpj-1+jl) = pt2d(3,ijpj-1+jl) + psgn * pt2d(ji,ijpj+jl) 280 pt2d(3,ijpj-1+jl) = 0.0_wp 298 ztmp = psgn * pt2d(2,ijpj+jl) 299 pt2d(2,ijpj+jl) = 0.0_wp 300 pt2d(3,ijpj-1+jl) = pt2d(3,ijpj-1+jl) + ztmp 281 301 END DO 282 302 END SELECT … … 289 309 DO ji = jpiglo, 1, -1 290 310 ijt = jpiglo-ji+1 291 pt2d(ijt,ijpj-1-jl) = pt2d(ijt,ijpj-1-jl) +psgn * pt2d(ji,ijpj+jl)311 ztmp = psgn * pt2d(ji,ijpj+jl) 292 312 pt2d(ji ,ijpj+jl ) = 0.0_wp 313 pt2d(ijt,ijpj-1-jl) = pt2d(ijt,ijpj-1-jl) + ztmp 293 314 END DO 294 315 END DO … … 297 318 DO ji = jpiglo-1, 1, -1 298 319 iju = jpiglo-ji 299 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) +psgn * pt2d(ji,ijpj+jl)320 ztmp = psgn * pt2d(ji,ijpj+jl) 300 321 pt2d(ji,ijpj+jl) = 0.0_wp 322 pt2d(iju,ijpj-1-jl) = pt2d(iju,ijpj-1-jl) + ztmp 301 323 END DO 302 324 END DO … … 304 326 DO ji = jpiglo, jpiglo/2+1, -1 305 327 ijt = jpiglo-ji+1 306 pt2d(ijt,ijpjm1) = pt2d(ijt,ijpjm1) +psgn * pt2d(ji,ijpjm1)328 ztmp = psgn * pt2d(ji,ijpjm1) 307 329 pt2d(ji ,ijpjm1) = 0.0_wp 330 pt2d(ijt,ijpjm1) = pt2d(ijt,ijpjm1) + ztmp 308 331 END DO 309 332 DO jl = ipr2dj, 0, -1 310 333 DO ji = jpiglo, 1, -1 311 334 ijt = jpiglo-ji+1 312 pt2d(ijt,ijpj-2-jl) = pt2d(ijt,ijpj-2-jl) +psgn * pt2d(ji,ijpj+jl)335 ztmp = psgn * pt2d(ji,ijpj+jl) 313 336 pt2d(ji,ijpj+jl) = 0.0_wp 337 pt2d(ijt,ijpj-2-jl) = pt2d(ijt,ijpj-2-jl) + ztmp 314 338 END DO 315 339 END DO … … 317 341 DO ji = jpiglo-1, jpiglo/2+1, -1 318 342 iju = jpiglo-ji 319 pt2d(iju,ijpjm1) = pt2d(iju,ijpjm1) +psgn * pt2d(ji,ijpjm1)343 ztmp = psgn * pt2d(ji,ijpjm1) 320 344 pt2d(ji ,ijpjm1) = 0.0_wp 345 pt2d(iju,ijpjm1) = pt2d(iju,ijpjm1) + ztmp 321 346 END DO 322 347 DO jl = ipr2dj, 0, -1 323 348 DO ji = jpiglo-1, 1, -1 324 349 iju = jpiglo-ji 325 pt2d(iju,ijpj-2-jl) = pt2d(iju,ijpj-2-jl) +psgn * pt2d(ji,ijpj+jl)350 ztmp = psgn * pt2d(ji,ijpj+jl) 326 351 pt2d(ji ,ijpj+jl ) = 0.0_wp 352 pt2d(iju,ijpj-2-jl) = pt2d(iju,ijpj-2-jl) + ztmp 327 353 END DO 328 354 END DO … … 415 441 & prntst_adj 416 442 USE dom_oce , ONLY: & ! Ocean space and time domain 417 & e1u, &418 & e2u, &419 & e1v, &420 & e2v, &421 & e1t, &422 & e2t, &423 #if defined key_zco424 & e3t_0, &425 #else426 & e3u, &427 & e3v, &428 #endif429 443 & tmask, & 430 444 & umask, & … … 486 500 487 501 zijpj = 4 502 503 SELECT CASE ( jpni ) 504 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 505 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 506 END SELECT 488 507 489 508 ALLOCATE( & … … 600 619 601 620 ! DOT_PRODUCT 602 zsp1 = sum( & 603 & PACK(zu_tlout(:,:,:),.TRUE.) * & 621 zsp1 = sum( PACK(zu_tlout(:,:,:),.TRUE.) * & 604 622 & PACK( zu_adin(:,:,:),.TRUE.) ) 605 623 … … 616 634 zt_adout(:,:,:) = zt_ad(:,:,:) 617 635 618 zsp2 = sum( & 619 & PACK(zu_tlin(:,:,:),.TRUE.) * & 636 zsp2 = sum( PACK(zu_tlin(:,:,:),.TRUE.) * & 620 637 & PACK( zu_adout(:,:,:),.TRUE.) ) 638 639 CALL mpp_sum( zsp1 ) 640 CALL mpp_sum( zsp2 ) 621 641 622 642 cl_name = 'lbc_nfd U 3d' 623 643 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 624 644 625 zsp1 = sum( & 626 & PACK(zv_tlout(:,:,:),.TRUE.) * & 645 zsp1 = sum( PACK(zv_tlout(:,:,:),.TRUE.) * & 627 646 & PACK( zv_adin(:,:,:),.TRUE.) ) 628 647 629 zsp2 = sum( & 630 & PACK(zv_tlin(:,:,:),.TRUE.) * & 648 zsp2 = sum( PACK(zv_tlin(:,:,:),.TRUE.) * & 631 649 & PACK( zv_adout(:,:,:),.TRUE.) ) 650 651 CALL mpp_sum( zsp1 ) 652 CALL mpp_sum( zsp2 ) 632 653 cl_name = 'lbc_nfd V 3d' 633 654 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 634 655 635 zsp1 = sum( & 636 & PACK(zt_tlout(:,:,:),.TRUE.) * & 656 zsp1 = sum( PACK(zt_tlout(:,:,:),.TRUE.) * & 637 657 & PACK( zt_adin(:,:,:),.TRUE.) ) 638 658 639 zsp2 = sum( & 640 & PACK(zt_tlin(:,:,:),.TRUE.) * & 659 zsp2 = sum( PACK(zt_tlin(:,:,:),.TRUE.) * & 641 660 & PACK( zt_adout(:,:,:),.TRUE.) ) 661 662 CALL mpp_sum( zsp1 ) 663 CALL mpp_sum( zsp2 ) 664 642 665 cl_name = 'lbc_nfd T 3d' 643 666 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) … … 680 703 & prntst_adj 681 704 USE dom_oce , ONLY: & ! Ocean space and time domain 682 & e1u, &683 & e2u, &684 & e1v, &685 & e2v, &686 & e1t, &687 & e2t, &688 #if defined key_zco689 & e3t_0, &690 #else691 & e3u, &692 & e3v, &693 #endif694 705 & tmask, & 695 706 & umask, & … … 752 763 ! Allocate memory 753 764 754 zijpj = 4 765 SELECT CASE ( jpni ) 766 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 767 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 768 END SELECT 755 769 756 770 ALLOCATE( & … … 859 873 END DO 860 874 861 zsp1 = sum( & 862 & PACK(zu_tlout(:,:),.TRUE.) * & 875 zsp1 = sum( PACK(zu_tlout(:,:),.TRUE.) * & 863 876 & PACK( zu_adin(:,:),.TRUE.) ) 864 877 zu_ad(:,:) = zu_adin(:,:) … … 874 887 zt_adout(:,:) = zt_ad(:,:) 875 888 876 zsp2 = sum( & 877 & PACK(zu_tlin(:,:),.TRUE.) * & 889 zsp2 = sum( PACK(zu_tlin(:,:),.TRUE.) * & 878 890 & PACK( zu_adout(:,:),.TRUE.) ) 891 892 CALL mpp_sum( zsp1 ) 893 CALL mpp_sum( zsp2 ) 894 879 895 cl_name = 'lbc_nfd U 2d' 880 896 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 881 897 882 zsp1 = sum( & 883 & PACK(zv_tlout(:,:),.TRUE.) * & 898 zsp1 = sum( PACK(zv_tlout(:,:),.TRUE.) * & 884 899 & PACK( zv_adin(:,:),.TRUE.) ) 885 900 886 zsp2 = sum( & 887 & PACK(zv_tlin(:,:),.TRUE.) * & 901 zsp2 = sum( PACK(zv_tlin(:,:),.TRUE.) * & 888 902 & PACK( zv_adout(:,:),.TRUE.) ) 903 904 CALL mpp_sum( zsp1 ) 905 CALL mpp_sum( zsp2 ) 906 889 907 cl_name = 'lbc_nfd V 2d' 890 908 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 891 909 892 zsp1 = sum( & 893 & PACK(zt_tlout(:,:),.TRUE.) * & 910 zsp1 = sum( PACK(zt_tlout(:,:),.TRUE.) * & 894 911 & PACK( zt_adin(:,:),.TRUE.) ) 895 912 896 zsp2 = sum( & 897 & PACK(zt_tlin(:,:),.TRUE.) * & 913 zsp2 = sum( PACK(zt_tlin(:,:),.TRUE.) * & 898 914 & PACK( zt_adout(:,:),.TRUE.) ) 915 916 CALL mpp_sum( zsp1 ) 917 CALL mpp_sum( zsp2 ) 918 899 919 cl_name = 'lbc_nfd T 2d' 900 920 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
Note: See TracChangeset
for help on using the changeset viewer.
