- Timestamp:
- 2013-09-25T15:30:21+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r3764 r4036 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2010-05 (M. Dunphy, R. Benshila) Original code 7 !! 3.4 ! 2013-06 (C. Rousset) add glob_min, glob_max 8 !! + 3d dim. of input is fexible (jpk, jpl...) 7 9 !!---------------------------------------------------------------------- 8 10 … … 23 25 24 26 PUBLIC glob_sum ! used in many places 27 PUBLIC glob_min, glob_max 25 28 PUBLIC DDPDD ! also used in closea module 26 29 #if defined key_nosignedzero … … 31 34 MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 32 35 & glob_sum_2d_a, glob_sum_3d_a 36 END INTERFACE 37 INTERFACE glob_min 38 MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a 39 END INTERFACE 40 INTERFACE glob_max 41 MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a 33 42 END INTERFACE 34 43 … … 49 58 50 59 #if ! defined key_mpp_rep 60 ! --- SUM --- 61 51 62 FUNCTION glob_sum_1d( ptab, kdim ) 52 63 !!----------------------------------------------------------------------- … … 91 102 !! 92 103 INTEGER :: jk 93 !!----------------------------------------------------------------------- 104 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 105 !!----------------------------------------------------------------------- 106 ! 107 ijpk = SIZE(ptab,3) 94 108 ! 95 109 glob_sum_3d = 0.e0 96 DO jk = 1, jpk110 DO jk = 1, ijpk 97 111 glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 98 112 END DO … … 129 143 !! 130 144 INTEGER :: jk 131 !!----------------------------------------------------------------------- 145 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 146 !!----------------------------------------------------------------------- 147 ! 148 ijpk = SIZE(ptab1,3) 132 149 ! 133 150 glob_sum_3d_a(:) = 0.e0 134 DO jk = 1, jpk151 DO jk = 1, ijpk 135 152 glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 136 153 glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) … … 140 157 END FUNCTION glob_sum_3d_a 141 158 142 #else 159 ! --- MIN --- 160 FUNCTION glob_min_2d( ptab ) 161 !!----------------------------------------------------------------------- 162 !! *** FUNCTION glob_min_2D *** 163 !! 164 !! ** Purpose : perform a masked min on the inner global domain of a 2D array 165 !!----------------------------------------------------------------------- 166 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array 167 REAL(wp) :: glob_min_2d ! global masked min 168 !!----------------------------------------------------------------------- 169 ! 170 glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 171 IF( lk_mpp ) CALL mpp_min( glob_min_2d ) 172 ! 173 END FUNCTION glob_min_2d 174 175 FUNCTION glob_min_3d( ptab ) 176 !!----------------------------------------------------------------------- 177 !! *** FUNCTION glob_min_3D *** 178 !! 179 !! ** Purpose : perform a masked min on the inner global domain of a 3D array 180 !!----------------------------------------------------------------------- 181 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array 182 REAL(wp) :: glob_min_3d ! global masked min 183 !! 184 INTEGER :: jk 185 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 186 !!----------------------------------------------------------------------- 187 ! 188 ijpk = SIZE(ptab,3) 189 ! 190 glob_min_3d = 0.e0 191 DO jk = 1, ijpk 192 glob_min_3d = glob_min_3d + MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) 193 END DO 194 IF( lk_mpp ) CALL mpp_min( glob_min_3d ) 195 ! 196 END FUNCTION glob_min_3d 197 198 199 FUNCTION glob_min_2d_a( ptab1, ptab2 ) 200 !!----------------------------------------------------------------------- 201 !! *** FUNCTION glob_min_2D _a *** 202 !! 203 !! ** Purpose : perform a masked min on the inner global domain of two 2D array 204 !!----------------------------------------------------------------------- 205 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array 206 REAL(wp) , DIMENSION(2) :: glob_min_2d_a ! global masked min 207 !!----------------------------------------------------------------------- 208 ! 209 glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 210 glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 211 IF( lk_mpp ) CALL mpp_min( glob_min_2d_a, 2 ) 212 ! 213 END FUNCTION glob_min_2d_a 214 215 216 FUNCTION glob_min_3d_a( ptab1, ptab2 ) 217 !!----------------------------------------------------------------------- 218 !! *** FUNCTION glob_min_3D_a *** 219 !! 220 !! ** Purpose : perform a masked min on the inner global domain of two 3D array 221 !!----------------------------------------------------------------------- 222 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array 223 REAL(wp) , DIMENSION(2) :: glob_min_3d_a ! global masked min 224 !! 225 INTEGER :: jk 226 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 227 !!----------------------------------------------------------------------- 228 ! 229 ijpk = SIZE(ptab1,3) 230 ! 231 glob_min_3d_a(:) = 0.e0 232 DO jk = 1, ijpk 233 glob_min_3d_a(1) = glob_min_3d_a(1) + MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 234 glob_min_3d_a(2) = glob_min_3d_a(2) + MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 235 END DO 236 IF( lk_mpp ) CALL mpp_min( glob_min_3d_a, 2 ) 237 ! 238 END FUNCTION glob_min_3d_a 239 240 ! --- MAX --- 241 FUNCTION glob_max_2d( ptab ) 242 !!----------------------------------------------------------------------- 243 !! *** FUNCTION glob_max_2D *** 244 !! 245 !! ** Purpose : perform a masked max on the inner global domain of a 2D array 246 !!----------------------------------------------------------------------- 247 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array 248 REAL(wp) :: glob_max_2d ! global masked max 249 !!----------------------------------------------------------------------- 250 ! 251 glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 252 IF( lk_mpp ) CALL mpp_max( glob_max_2d ) 253 ! 254 END FUNCTION glob_max_2d 255 256 FUNCTION glob_max_3d( ptab ) 257 !!----------------------------------------------------------------------- 258 !! *** FUNCTION glob_max_3D *** 259 !! 260 !! ** Purpose : perform a masked max on the inner global domain of a 3D array 261 !!----------------------------------------------------------------------- 262 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array 263 REAL(wp) :: glob_max_3d ! global masked max 264 !! 265 INTEGER :: jk 266 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 267 !!----------------------------------------------------------------------- 268 ! 269 ijpk = SIZE(ptab,3) 270 ! 271 glob_max_3d = 0.e0 272 DO jk = 1, ijpk 273 glob_max_3d = glob_max_3d + MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) 274 END DO 275 IF( lk_mpp ) CALL mpp_max( glob_max_3d ) 276 ! 277 END FUNCTION glob_max_3d 278 279 280 FUNCTION glob_max_2d_a( ptab1, ptab2 ) 281 !!----------------------------------------------------------------------- 282 !! *** FUNCTION glob_max_2D _a *** 283 !! 284 !! ** Purpose : perform a masked max on the inner global domain of two 2D array 285 !!----------------------------------------------------------------------- 286 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array 287 REAL(wp) , DIMENSION(2) :: glob_max_2d_a ! global masked max 288 !!----------------------------------------------------------------------- 289 ! 290 glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 291 glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 292 IF( lk_mpp ) CALL mpp_max( glob_max_2d_a, 2 ) 293 ! 294 END FUNCTION glob_max_2d_a 295 296 297 FUNCTION glob_max_3d_a( ptab1, ptab2 ) 298 !!----------------------------------------------------------------------- 299 !! *** FUNCTION glob_max_3D_a *** 300 !! 301 !! ** Purpose : perform a masked max on the inner global domain of two 3D array 302 !!----------------------------------------------------------------------- 303 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array 304 REAL(wp) , DIMENSION(2) :: glob_max_3d_a ! global masked max 305 !! 306 INTEGER :: jk 307 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 308 !!----------------------------------------------------------------------- 309 ! 310 ijpk = SIZE(ptab1,3) 311 ! 312 glob_max_3d_a(:) = 0.e0 313 DO jk = 1, ijpk 314 glob_max_3d_a(1) = glob_max_3d_a(1) + MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) 315 glob_max_3d_a(2) = glob_max_3d_a(2) + MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) 316 END DO 317 IF( lk_mpp ) CALL mpp_max( glob_max_3d_a, 2 ) 318 ! 319 END FUNCTION glob_max_3d_a 320 321 322 #else 143 323 !!---------------------------------------------------------------------- 144 324 !! 'key_mpp_rep' MPP reproducibility 145 325 !!---------------------------------------------------------------------- 146 326 327 ! --- SUM --- 147 328 FUNCTION glob_sum_1d( ptab, kdim ) 148 329 !!---------------------------------------------------------------------- … … 177 358 !! ** Purpose : perform a sum in calling DDPDD routine 178 359 !!---------------------------------------------------------------------- 179 REAL(wp), INTENT(in), DIMENSION( jpi,jpj) :: ptab180 REAL(wp) 360 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 361 REAL(wp) :: glob_sum_2d ! global masked sum 181 362 !! 182 363 COMPLEX(wp):: ctmp … … 205 386 !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 206 387 !!---------------------------------------------------------------------- 207 REAL(wp), INTENT(in), DIMENSION( jpi,jpj,jpk) :: ptab208 REAL(wp) 388 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 389 REAL(wp) :: glob_sum_3d ! global masked sum 209 390 !! 210 391 COMPLEX(wp):: ctmp 211 392 REAL(wp) :: ztmp 212 393 INTEGER :: ji, jj, jk ! dummy loop indices 213 !!----------------------------------------------------------------------- 214 ! 215 ztmp = 0.e0 216 ctmp = CMPLX( 0.e0, 0.e0, wp ) 217 DO jk = 1, jpk 394 INTEGER :: ijpk ! local variables: size of ptab 395 !!----------------------------------------------------------------------- 396 ! 397 ijpk = SIZE(ptab,3) 398 ! 399 ztmp = 0.e0 400 ctmp = CMPLX( 0.e0, 0.e0, wp ) 401 DO jk = 1, ijpk 218 402 DO jj = 1, jpj 219 403 DO ji =1, jpi … … 235 419 !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine 236 420 !!---------------------------------------------------------------------- 237 REAL(wp), INTENT(in), DIMENSION( jpi,jpj) :: ptab1, ptab2238 REAL(wp) 421 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 422 REAL(wp) :: glob_sum_2d_a ! global masked sum 239 423 !! 240 424 COMPLEX(wp):: ctmp … … 265 449 !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine 266 450 !!---------------------------------------------------------------------- 267 REAL(wp), INTENT(in), DIMENSION( jpi,jpj,jpk) :: ptab1, ptab2268 REAL(wp) 451 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 452 REAL(wp) :: glob_sum_3d_a ! global masked sum 269 453 !! 270 454 COMPLEX(wp):: ctmp 271 455 REAL(wp) :: ztmp 272 456 INTEGER :: ji, jj, jk ! dummy loop indices 273 !!----------------------------------------------------------------------- 274 ! 275 ztmp = 0.e0 276 ctmp = CMPLX( 0.e0, 0.e0, wp ) 277 DO jk = 1, jpk 457 INTEGER :: ijpk ! local variables: size of ptab 458 !!----------------------------------------------------------------------- 459 ! 460 ijpk = SIZE(ptab1,3) 461 ! 462 ztmp = 0.e0 463 ctmp = CMPLX( 0.e0, 0.e0, wp ) 464 DO jk = 1, ijpk 278 465 DO jj = 1, jpj 279 DO ji = 1, jpi280 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj)281 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )282 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj)283 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )466 DO ji = 1, jpi 467 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj) 468 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 469 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj) 470 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 284 471 END DO 285 END DO 472 END DO 286 473 END DO 287 474 IF( lk_mpp ) CALL mpp_sum( ctmp ) ! sum over the global domain 288 475 glob_sum_3d_a = REAL(ctmp,wp) 289 476 ! 290 END FUNCTION glob_sum_3d_a 477 END FUNCTION glob_sum_3d_a 478 479 480 ! --- MIN --- 481 FUNCTION glob_min_2d( ptab ) 482 !!---------------------------------------------------------------------- 483 !! *** FUNCTION glob_min_2d *** 484 !! 485 !! ** Purpose : perform a min in calling DDPDD routine 486 !!---------------------------------------------------------------------- 487 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 488 REAL(wp) :: glob_min_2d ! global masked min 489 !! 490 COMPLEX(wp):: ctmp 491 REAL(wp) :: ztmp 492 INTEGER :: ji, jj ! dummy loop indices 493 !!----------------------------------------------------------------------- 494 ! 495 ztmp = 0.e0 496 ctmp = CMPLX( 0.e0, 0.e0, wp ) 497 DO jj = 1, jpj 498 DO ji = 1, jpi 499 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 500 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 501 END DO 502 END DO 503 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 504 glob_min_2d = REAL(ctmp,wp) 505 ! 506 END FUNCTION glob_min_2d 507 508 509 FUNCTION glob_min_3d( ptab ) 510 !!---------------------------------------------------------------------- 511 !! *** FUNCTION glob_min_3d *** 512 !! 513 !! ** Purpose : perform a min on a 3D array in calling DDPDD routine 514 !!---------------------------------------------------------------------- 515 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 516 REAL(wp) :: glob_min_3d ! global masked min 517 !! 518 COMPLEX(wp):: ctmp 519 REAL(wp) :: ztmp 520 INTEGER :: ji, jj, jk ! dummy loop indices 521 INTEGER :: ijpk ! local variables: size of ptab 522 !!----------------------------------------------------------------------- 523 ! 524 ijpk = SIZE(ptab,3) 525 ! 526 ztmp = 0.e0 527 ctmp = CMPLX( 0.e0, 0.e0, wp ) 528 DO jk = 1, ijpk 529 DO jj = 1, jpj 530 DO ji = 1, jpi 531 ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj) 532 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 533 END DO 534 END DO 535 END DO 536 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 537 glob_min_3d = REAL(ctmp,wp) 538 ! 539 END FUNCTION glob_min_3d 540 541 542 FUNCTION glob_min_2d_a( ptab1, ptab2 ) 543 !!---------------------------------------------------------------------- 544 !! *** FUNCTION glob_min_2d_a *** 545 !! 546 !! ** Purpose : perform a min on two 2D arrays in calling DDPDD routine 547 !!---------------------------------------------------------------------- 548 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 549 REAL(wp) :: glob_min_2d_a ! global masked min 550 !! 551 COMPLEX(wp):: ctmp 552 REAL(wp) :: ztmp 553 INTEGER :: ji, jj ! dummy loop indices 554 !!----------------------------------------------------------------------- 555 ! 556 ! 557 ztmp = 0.e0 558 ctmp = CMPLX( 0.e0, 0.e0, wp ) 559 DO jj = 1, jpj 560 DO ji = 1, jpi 561 ztmp = ptab1(ji,jj) * tmask_i(ji,jj) 562 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 563 ztmp = ptab2(ji,jj) * tmask_i(ji,jj) 564 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 565 END DO 566 END DO 567 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 568 glob_min_2d_a = REAL(ctmp,wp) 569 ! 570 END FUNCTION glob_min_2d_a 571 572 573 FUNCTION glob_min_3d_a( ptab1, ptab2 ) 574 !!---------------------------------------------------------------------- 575 !! *** FUNCTION glob_min_3d_a *** 576 !! 577 !! ** Purpose : perform a min on two 3D array in calling DDPDD routine 578 !!---------------------------------------------------------------------- 579 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 580 REAL(wp) :: glob_min_3d_a ! global masked min 581 !! 582 COMPLEX(wp):: ctmp 583 REAL(wp) :: ztmp 584 INTEGER :: ji, jj, jk ! dummy loop indices 585 INTEGER :: ijpk ! local variables: size of ptab 586 !!----------------------------------------------------------------------- 587 ! 588 ijpk = SIZE(ptab1,3) 589 ! 590 ztmp = 0.e0 591 ctmp = CMPLX( 0.e0, 0.e0, wp ) 592 DO jk = 1, ijpk 593 DO jj = 1, jpj 594 DO ji = 1, jpi 595 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj) 596 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 597 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj) 598 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 599 END DO 600 END DO 601 END DO 602 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 603 glob_min_3d_a = REAL(ctmp,wp) 604 ! 605 END FUNCTION glob_min_3d_a 606 607 608 ! --- MAX --- 609 FUNCTION glob_max_2d( ptab ) 610 !!---------------------------------------------------------------------- 611 !! *** FUNCTION glob_max_2d *** 612 !! 613 !! ** Purpose : perform a max in calling DDPDD routine 614 !!---------------------------------------------------------------------- 615 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 616 REAL(wp) :: glob_max_2d ! global masked max 617 !! 618 COMPLEX(wp):: ctmp 619 REAL(wp) :: ztmp 620 INTEGER :: ji, jj ! dummy loop indices 621 !!----------------------------------------------------------------------- 622 ! 623 ztmp = 0.e0 624 ctmp = CMPLX( 0.e0, 0.e0, wp ) 625 DO jj = 1, jpj 626 DO ji = 1, jpi 627 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 628 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 629 END DO 630 END DO 631 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 632 glob_max_2d = REAL(ctmp,wp) 633 ! 634 END FUNCTION glob_max_2d 635 636 637 FUNCTION glob_max_3d( ptab ) 638 !!---------------------------------------------------------------------- 639 !! *** FUNCTION glob_max_3d *** 640 !! 641 !! ** Purpose : perform a max on a 3D array in calling DDPDD routine 642 !!---------------------------------------------------------------------- 643 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 644 REAL(wp) :: glob_max_3d ! global masked max 645 !! 646 COMPLEX(wp):: ctmp 647 REAL(wp) :: ztmp 648 INTEGER :: ji, jj, jk ! dummy loop indices 649 INTEGER :: ijpk ! local variables: size of ptab 650 !!----------------------------------------------------------------------- 651 ! 652 ijpk = SIZE(ptab,3) 653 ! 654 ztmp = 0.e0 655 ctmp = CMPLX( 0.e0, 0.e0, wp ) 656 DO jk = 1, ijpk 657 DO jj = 1, jpj 658 DO ji = 1, jpi 659 ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj) 660 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 661 END DO 662 END DO 663 END DO 664 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 665 glob_max_3d = REAL(ctmp,wp) 666 ! 667 END FUNCTION glob_max_3d 668 669 670 FUNCTION glob_max_2d_a( ptab1, ptab2 ) 671 !!---------------------------------------------------------------------- 672 !! *** FUNCTION glob_max_2d_a *** 673 !! 674 !! ** Purpose : perform a max on two 2D arrays in calling DDPDD routine 675 !!---------------------------------------------------------------------- 676 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 677 REAL(wp) :: glob_max_2d_a ! global masked max 678 !! 679 COMPLEX(wp):: ctmp 680 REAL(wp) :: ztmp 681 INTEGER :: ji, jj ! dummy loop indices 682 !!----------------------------------------------------------------------- 683 ! 684 ! 685 ztmp = 0.e0 686 ctmp = CMPLX( 0.e0, 0.e0, wp ) 687 DO jj = 1, jpj 688 DO ji = 1, jpi 689 ztmp = ptab1(ji,jj) * tmask_i(ji,jj) 690 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 691 ztmp = ptab2(ji,jj) * tmask_i(ji,jj) 692 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 693 END DO 694 END DO 695 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 696 glob_max_2d_a = REAL(ctmp,wp) 697 ! 698 END FUNCTION glob_max_2d_a 699 700 701 FUNCTION glob_max_3d_a( ptab1, ptab2 ) 702 !!---------------------------------------------------------------------- 703 !! *** FUNCTION glob_max_3d_a *** 704 !! 705 !! ** Purpose : perform a max on two 3D array in calling DDPDD routine 706 !!---------------------------------------------------------------------- 707 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 708 REAL(wp) :: glob_max_3d_a ! global masked max 709 !! 710 COMPLEX(wp):: ctmp 711 REAL(wp) :: ztmp 712 INTEGER :: ji, jj, jk ! dummy loop indices 713 INTEGER :: ijpk ! local variables: size of ptab 714 !!----------------------------------------------------------------------- 715 ! 716 ijpk = SIZE(ptab1,3) 717 ! 718 ztmp = 0.e0 719 ctmp = CMPLX( 0.e0, 0.e0, wp ) 720 DO jk = 1, ijpk 721 DO jj = 1, jpj 722 DO ji = 1, jpi 723 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj) 724 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 725 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj) 726 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 727 END DO 728 END DO 729 END DO 730 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 731 glob_max_3d_a = REAL(ctmp,wp) 732 ! 733 END FUNCTION glob_max_3d_a 291 734 292 735 #endif
Note: See TracChangeset
for help on using the changeset viewer.