Changeset 495 for trunk/NEMO/OFF_SRC/dtadyn.F90
- Timestamp:
- 2006-09-01T16:11:03+02:00 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/dtadyn.F90
r446 r495 54 54 nficdyn = 2 ! number of dynamical fields 55 55 56 INTEGER :: ndyn1, ndyn2 , & 56 INTEGER :: & 57 ndyn1, ndyn2 , & 57 58 nlecoff = 0 , & ! switch for the first read 58 59 numfl_t, numfl_u, & 59 numfl_v, numfl_w , numfl_s60 numfl_v, numfl_w 60 61 61 62 … … 76 77 #endif 77 78 78 #if defined key_traldf_eiv && defined key_traldf_c2d 79 #if ! defined key_off_degrad 80 81 # if defined key_traldf_c2d 79 82 REAL(wp), DIMENSION(jpi,jpj,2) :: & 80 ahtwdta , & ! Lateral diffusivity 81 eivwdta ! G&M coefficient 82 #endif 83 ahtwdta ! Lateral diffusivity 84 # if defined key_trcldf_eiv 85 REAL(wp), DIMENSION(jpi,jpj,2) :: & 86 aeiwdta ! G&M coefficient 87 # endif 88 # endif 89 90 #else 91 92 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 93 ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity 94 # if defined key_trcldf_eiv 95 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 96 aeiudta, aeivdta, aeiwdta ! G&M coefficient 97 # endif 98 99 #endif 100 # if defined key_diaeiv 101 !! GM Velocity : to be used latter 102 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 103 eivudta, eivvdta, eivwdta 104 # endif 83 105 84 106 REAL(wp), DIMENSION(jpi,jpj,jpflx,2) :: & … … 167 189 !! ! addition : 98-05 (L. Bopp read output of coupled run) 168 190 !! ! addition : 05-03 (O. Aumont and A. El Moussaoui) F90 191 !! ! addition : 05-12 (C. Ethe) Adapted for DEGINT 169 192 !!---------------------------------------------------------------------- 170 193 !! * Modules used … … 256 279 ! DATA READ for the iperm1 period 257 280 ! 258 IF( iperm1 .NE.0 ) THEN281 IF( iperm1 /= 0 ) THEN 259 282 CALL dynrea( kt, iperm1 ) 260 283 ELSE … … 267 290 sn(:,:,:)=sdta(:,:,:,2) 268 291 avt(:,:,:)=avtdta(:,:,:,2) 292 269 293 270 294 IF(lwp) THEN … … 306 330 flxdta(:,:,:,1) = flxdta(:,:,:,2) 307 331 zmxldta(:,:,1)=zmxldta(:,:,2) 308 #if defined key_traldf_eiv && defined key_traldf_c2d 309 ahtwdta(:,:,1)=ahtwdta(:,:,2) 310 eivwdta(:,:,1)=eivwdta(:,:,2) 311 #endif 332 #if ! defined key_off_degrad 333 334 # if defined key_traldf_c2d 335 ahtwdta(:,:,1)= ahtwdta(:,:,2) 336 # if defined key_trcldf_eiv 337 aeiwdta(:,:,1)= aeiwdta(:,:,2) 338 # endif 339 # endif 340 341 #else 342 ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 343 ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 344 ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 345 # if defined key_trcldf_eiv 346 aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 347 aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 348 aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 349 # endif 350 351 #endif 352 312 353 #if defined key_trcbbl_dif || defined key_trcbbl_adv 313 354 bblxdta(:,:,1)=bblxdta(:,:,2) … … 321 362 ! DATA READ for the iper period 322 363 ! 323 CALL dynrea( kt,iper)364 CALL dynrea( kt, iper ) 324 365 ! 325 366 ! Computes wdta (and slopes if key_trahdfiso) … … 369 410 ! swap from record 2 to 1 370 411 ! 371 udta(:,:,:,1) =udta(:,:,:,2)372 vdta(:,:,:,1) =vdta(:,:,:,2)373 wdta(:,:,:,1)= wdta(:,:,:,2)374 avtdta(:,:,:,1) =avtdta(:,:,:,2)375 tdta(:,:,:,1) =tdta(:,:,:,2)376 sdta(:,:,:,1) =sdta(:,:,:,2)412 udta(:,:,:,1) = udta(:,:,:,2) 413 vdta(:,:,:,1) = vdta(:,:,:,2) 414 wdta(:,:,:,1)= wdta(:,:,:,2) 415 avtdta(:,:,:,1) = avtdta(:,:,:,2) 416 tdta(:,:,:,1) = tdta(:,:,:,2) 417 sdta(:,:,:,1) = sdta(:,:,:,2) 377 418 #if defined key_ldfslp 378 uslpdta(:,:,:,1) =uslpdta(:,:,:,2)379 vslpdta(:,:,:,1) =vslpdta(:,:,:,2)380 wslpidta(:,:,:,1) =wslpidta(:,:,:,2)381 wslpjdta(:,:,:,1) =wslpjdta(:,:,:,2)419 uslpdta(:,:,:,1) = uslpdta(:,:,:,2) 420 vslpdta(:,:,:,1) = vslpdta(:,:,:,2) 421 wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 422 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 382 423 #endif 383 424 flxdta(:,:,:,1) = flxdta(:,:,:,2) 384 zmxldta(:,:,1)=zmxldta(:,:,2) 385 #if defined key_traldf_eiv && defined key_traldf_c2d 386 ahtwdta(:,:,1)=ahtwdta(:,:,2) 387 eivwdta(:,:,1)=eivwdta(:,:,2) 388 #endif 425 zmxldta(:,:,1) = zmxldta(:,:,2) 426 427 #if ! defined key_off_degrad 428 429 # if defined key_traldf_c2d 430 ahtwdta(:,:,1)= ahtwdta(:,:,2) 431 # if defined key_trcldf_eiv 432 aeiwdta(:,:,1)= aeiwdta(:,:,2) 433 # endif 434 # endif 435 436 #else 437 ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 438 ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 439 ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 440 # if defined key_trcldf_eiv 441 aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 442 aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 443 aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 444 # endif 445 446 #endif 447 389 448 #if defined key_trcbbl_dif || defined key_trcbbl_adv 390 bblxdta(:,:,1) =bblxdta(:,:,2)391 bblydta(:,:,1) =bblydta(:,:,2)449 bblxdta(:,:,1) = bblxdta(:,:,2) 450 bblydta(:,:,1) = bblydta(:,:,2) 392 451 #endif 393 452 ! … … 398 457 ! READ DATA for the iper period 399 458 ! 400 CALL dynrea( kt,iper)459 CALL dynrea( kt, iper ) 401 460 ! 402 461 ! Computes wdta (and slopes if key_trahdfiso) … … 423 482 ndyn2 = iper 424 483 ! 425 ! we have READ another period of DATA 426 ! 484 ! we have READ another period of DATA ! 427 485 IF (lwp) THEN 428 486 WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1 … … 436 494 ! compute the DATA at the given time step 437 495 ! 438 IF ( nsptint.eq.0) THEN496 IF ( nsptint == 0 ) THEN 439 497 ! 440 498 ! no spatial interpolation … … 464 522 flx(:,:,:) = flxdta(:,:,:,2) 465 523 hmld(:,:)=zmxldta(:,:,2) 466 #if defined key_traldf_eiv && defined key_traldf_c2d 467 ahtw(:,:)=ahtwdta(:,:,2) 468 aeiw(:,:)=eivwdta(:,:,2) 469 #endif 524 #if ! defined key_off_degrad 525 526 # if defined key_traldf_c2d 527 ahtwdta(:,:,1)= ahtwdta(:,:,2) 528 # if defined key_trcldf_eiv 529 aeiwdta(:,:,1)= aeiwdta(:,:,2) 530 # endif 531 # endif 532 533 #else 534 ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 535 ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 536 ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 537 # if defined key_trcldf_eiv 538 aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 539 aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 540 aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 541 # endif 542 543 #endif 544 470 545 #if defined key_trcbbl_dif || defined key_trcbbl_adv 471 546 bblx(:,:)=bblxdta(:,:,2) … … 486 561 487 562 ELSE 488 IF ( nsptint.eq.1) THEN563 IF ( nsptint == 1 ) THEN 489 564 ! 490 565 ! linear interpolation … … 511 586 flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2) 512 587 hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh * zmxldta(:,:,2) 513 #if defined key_traldf_eiv && defined key_traldf_c2d 514 ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2) 515 aeiw(:,:) = zweighm1 * eivwdta(:,:,1) + zweigh * eivwdta(:,:,2) 516 #endif 588 #if ! defined key_off_degrad 589 590 # if defined key_traldf_c2d 591 ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2) 592 # if defined key_trcldf_eiv 593 aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + zweigh * aeiwdta(:,:,2) 594 # endif 595 # endif 596 597 #else 598 ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + zweigh * ahtudta(:,:,:,2) 599 ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + zweigh * ahtvdta(:,:,:,2) 600 ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + zweigh * ahtwdta(:,:,:,2) 601 # if defined key_trcldf_eiv 602 aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + zweigh * aeiudta(:,:,:,2) 603 aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + zweigh * aeivdta(:,:,:,2) 604 aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + zweigh * aeiwdta(:,:,:,2) 605 # endif 606 607 #endif 608 517 609 #if defined key_trcbbl_dif || defined key_trcbbl_adv 518 bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)519 bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)610 bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2) 611 bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2) 520 612 #endif 521 613 ! … … 526 618 #endif 527 619 freeze(:,:) = flx(:,:,jpice) 528 emp(:,:) = flx(:,:,jpemp)529 emps(:,:) = emp(:,:)530 qsr(:,:) = flx(:,:,jpqsr)620 emp(:,:) = flx(:,:,jpemp) 621 emps(:,:) = emp(:,:) 622 qsr(:,:) = flx(:,:,jpqsr) 531 623 ! 532 624 ! other interpolation … … 546 638 CALL eos( tn, sn, rhd, rhop ) 547 639 548 #if defined key_traldf_c2d640 #if ! defined key_off_degrad && defined key_traldf_c2d 549 641 ! In case of 2D varying coefficients, we need aeiv and aeiu 550 642 IF( lk_traldf_eiv ) CALL ldf_eiv( kt ) ! eddy induced velocity coefficient … … 565 657 !! (netcdf FORMAT) 566 658 !! 05-03 (O. Aumont and A. El Moussaoui) F90 659 !! 06-07 : (C. Ethe) use of iom module 567 660 !!---------------------------------------------------------------------- 568 661 !! * Modules used 569 USE io ipsl662 USE iom 570 663 571 664 !! * Arguments 572 665 INTEGER, INTENT( in ) :: kt, kenr ! time index 573 666 !! * Local declarations 574 INTEGER :: ji, jj 575 INTEGER :: ipi,ipj,ipk,itime,jkenr,idtatot 576 INTEGER , DIMENSION(ndtatot) :: istep 577 578 REAL(wp) :: zdate0 667 INTEGER :: ji, jj, jk, jkenr 579 668 580 669 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 581 zu, zv, zw, zt, zs, zavt ! 3-D dynamical fields 582 583 # if defined key_traldf_eiv 584 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 585 zaeiu, zaeiv, zaeiw 586 # endif 587 588 # if defined key_traldf_eiv && defined key_traldf_c2d 589 REAL(wp), DIMENSION(jpi,jpj) :: & 590 zeivw, zahtw 591 # endif 670 zu, zv, zw, zt, zs, zavt , & ! 3-D dynamical fields 671 zhdiv ! horizontal divergence 592 672 593 673 REAL(wp), DIMENSION(jpi,jpj) :: & 594 zlon, zlat, zemp, zqsr, zmld, zice, zwind674 zemp, zqsr, zmld, zice, zwspd 595 675 #if defined key_trcbbl_dif || defined key_trcbbl_adv 596 676 REAL(wp), DIMENSION(jpi,jpj) :: & 597 677 zbblx, zbbly 598 678 #endif 599 REAL(wp), DIMENSION(jpk) :: zlev 679 680 #if ! defined key_off_degrad 681 682 # if defined key_traldf_c2d 683 REAL(wp), DIMENSION(jpi,jpj) :: & 684 zahtw 685 # if defined key_trcldf_eiv 686 REAL(wp), DIMENSION(jpi,jpj) :: & 687 zaeiw 688 # endif 689 # endif 690 691 #else 692 693 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 694 zahtu, zahtv, zahtw ! Lateral diffusivity 695 # if defined key_trcldf_eiv 696 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 697 zaeiu, zaeiv, zaeiw ! G&M coefficient 698 # endif 699 700 #endif 701 702 # if defined key_diaeiv 703 !! GM Velocity : to be used latter 704 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 705 zeivu, zeivv, zeivw 706 # endif 600 707 601 708 CHARACTER(len=45) :: & … … 603 710 clname_u = 'dyna_grid_U.nc', & 604 711 clname_v = 'dyna_grid_V.nc', & 605 clname_w = 'dyna_grid_W.nc', & 606 clname_s = 'dyna_wspd.nc' 712 clname_w = 'dyna_grid_W.nc' 607 713 ! 608 714 ! 0. Initialization … … 616 722 WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 617 723 WRITE(numout,*) ' ~~~~~~~' 724 #if defined key_off_degrad 725 WRITE(numout,*) ' Degraded fields' 726 #endif 618 727 WRITE(numout,*) 619 728 ENDIF 620 729 621 730 731 IF( kt == nit000 .AND. nlecoff == 0 ) THEN 732 733 nlecoff = 1 734 735 CALL iom_open ( clname_t, numfl_t ) 736 CALL iom_open ( clname_u, numfl_u ) 737 CALL iom_open ( clname_v, numfl_v ) 738 CALL iom_open ( clname_w, numfl_w ) 739 740 ENDIF 741 742 ! file grid-T 743 !--------------- 744 CALL iom_get ( numfl_t, jpdom_data, 'votemper', zt (:,:,:), jkenr ) 745 CALL iom_get ( numfl_t, jpdom_data, 'vosaline', zs (:,:,:), jkenr ) 746 CALL iom_get ( numfl_t, jpdom_data, 'somixhgt', zmld (:,: ), jkenr ) 747 CALL iom_get ( numfl_t, jpdom_data, 'sowaflup', zemp (:,: ), jkenr ) 748 CALL iom_get ( numfl_t, jpdom_data, 'soshfldo', zqsr (:,: ), jkenr ) 749 CALL iom_get ( numfl_t, jpdom_data, 'soicecov', zice (:,: ), jkenr ) 750 CALL iom_get ( numfl_t, jpdom_data, 'sowindsp', zwspd(:,: ), jkenr ) 751 752 ! file grid-U 753 !--------------- 754 CALL iom_get ( numfl_u, jpdom_data, 'vozocrtx', zu (:,:,:), jkenr ) 755 #if defined key_trcbbl_dif || defined key_trcbbl_adv 756 CALL iom_get ( numfl_u, jpdom_data, 'sobblcox', zbblx(:,: ), jkenr ) 757 #endif 758 759 #if defined key_diaeiv 760 !! GM Velocity : to be used latter 761 CALL iom_get ( numfl_u, jpdom_data, 'vozoeivu', zeivu(:,:,:), jkenr ) 762 #endif 763 764 # if defined key_off_degrad 765 CALL iom_get ( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 766 # if defined key_trcldf_eiv 767 CALL iom_get ( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 768 # endif 769 #endif 770 771 ! file grid-V 772 !--------------- 773 CALL iom_get ( numfl_v, jpdom_data, 'vomecrty', zv (:,:,:), jkenr ) 774 #if defined key_trcbbl_dif || defined key_trcbbl_adv 775 CALL iom_get ( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,: ), jkenr ) 776 #endif 777 778 #if defined key_diaeiv 779 !! GM Velocity : to be used latter 780 CALL iom_get ( numfl_v, jpdom_data, 'vomeeivv', zeivv(:,:,:), jkenr ) 781 #endif 782 783 #if defined key_off_degrad 784 CALL iom_get ( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 785 # if defined key_trcldf_eiv 786 CALL iom_get ( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 787 # endif 788 #endif 789 790 ! file grid-W 791 !--------------- 792 !! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr ) 793 # if defined key_zdfddm 794 CALL iom_get ( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 795 #else 796 CALL iom_get ( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 797 #endif 798 799 # if defined key_diaeiv 800 !! GM Velocity : to be used latter 801 CALL iom_get ( numfl_w, jpdom_data, 'voveeivw', zeivw(:,:,:), jkenr ) 802 #endif 803 804 #if ! defined key_off_degrad 805 # if defined key_traldf_c2d 806 CALL iom_get ( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr ) 807 # if defined key_traldf_eiv 808 CALL iom_get ( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 809 # endif 810 # endif 811 #else 812 !! degradation-integration 813 CALL iom_get ( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 814 # if defined key_trcldf_eiv 815 CALL iom_get ( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr ) 816 # endif 817 #endif 818 819 udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:) 820 vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:) 821 !! wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 822 823 824 ! Computation of vertical velocity using horizontal divergence 825 zhdiv(:,:,:) = 0. 826 DO jk = 1, jpkm1 827 DO jj = 2, jpjm1 828 DO ji = fs_2, fs_jpim1 ! vector opt. 829 zhdiv(ji,jj,jk) = ( e2u(ji,jj) * udta(ji,jj,jk,2) - e2u(ji-1,jj) * udta(ji-1,jj,jk,2) & 830 & + e1v(ji,jj) * vdta(ji,jj,jk,2) - e1v(ji,jj-1) * vdta(ji,jj-1,jk,2) ) & 831 & / ( e1t(ji,jj) * e2t(ji,jj) ) 832 END DO 833 END DO 834 END DO 622 835 623 idtatot = ndtatot 624 625 IF( kt == nit000 .AND. nlecoff == 0 ) THEN 626 627 nlecoff = 1 628 629 CALL flinopen(clname_t,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 630 & ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_t) 631 632 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 633 IF(lwp) THEN 634 WRITE(numout,*) 635 WRITE(numout,*) 'problem with dimensions' 636 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 637 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 638 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 639 ENDIF 640 STOP 'dynrea ' 641 ENDIF 642 643 CALL flinopen(clname_u,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 644 & ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_u) 645 646 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 647 IF(lwp) THEN 648 WRITE(numout,*) 649 WRITE(numout,*) 'problem with dimensions' 650 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 651 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 652 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 653 ENDIF 654 STOP 'dynrea ' 655 ENDIF 656 657 CALL flinopen(clname_v,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 658 & ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_v) 659 660 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 661 IF(lwp) THEN 662 WRITE(numout,*) 663 WRITE(numout,*) 'problem with dimensions' 664 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 665 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 666 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 667 ENDIF 668 STOP 'dynrea ' 669 ENDIF 670 671 CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 672 & ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_w) 673 674 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 675 IF(lwp) THEN 676 WRITE(numout,*) 677 WRITE(numout,*) 'problem with dimensions' 678 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 679 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 680 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 681 ENDIF 682 STOP 'dynrea ' 683 ENDIF 684 685 CALL flinopen(clname_s,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 686 & ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_s) 687 688 IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 689 IF(lwp) THEN 690 WRITE(numout,*) 691 WRITE(numout,*) 'problem with dimensions' 692 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 693 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 694 ENDIF 695 STOP 'dynrea' 696 ENDIF 697 836 zw(:,:,jpk) = 0. 837 838 ! Computation from the bottom 839 DO jk = jpkm1, 1, -1 840 zw(:,:,jk) = zw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 841 END DO 842 wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 843 844 845 tdta(:,:,:,2) = zt(:,:,:) * tmask(:,:,:) 846 sdta(:,:,:,2) = zs(:,:,:) * tmask(:,:,:) 847 avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 848 #if ! defined key_off_degrad && defined key_traldf_c2d 849 ahtwdta(:,:,2) = zahtw(:,:) * tmask(:,:,1) 850 #if defined key_traldf_eiv 851 aeiwdta(:,:,2) = zaeiw(:,:) * tmask(:,:,1) 852 #endif 853 #endif 854 855 #if defined key_off_degrad 856 ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 857 ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 858 ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 859 # if defined key_trcldf_eiv 860 aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 861 aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 862 aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:) 863 # endif 864 #endif 865 866 ! 867 ! flux : 868 ! 869 flxdta(:,:,jpwind,2) = zwspd(:,:) * tmask(:,:,1) 870 flxdta(:,:,jpice,2) = MIN( 1., zice(:,:) ) * tmask(:,:,1) 871 flxdta(:,:,jpemp,2) = zemp(:,:) * tmask(:,:,1) 872 flxdta(:,:,jpqsr,2) = zqsr(:,:) * tmask(:,:,1) 873 zmxldta(:,:,2) = zmld(:,:) * tmask(:,:,1) 874 875 #if defined key_trcbbl_dif || defined key_trcbbl_adv 876 bblxdta(:,:,2) = MAX( 0., zbblx(:,:) ) 877 bblydta(:,:,2) = MAX( 0., zbbly(:,:) ) 878 879 WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0. 880 WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0. 881 882 #endif 883 884 IF( kt == nitend ) THEN 885 CALL iom_close ( numfl_t ) 886 CALL iom_close ( numfl_u ) 887 CALL iom_close ( numfl_v ) 888 CALL iom_close ( numfl_w ) 698 889 ENDIF 699 700 CALL flinget(numfl_u,'vozocrtx',jpidta,jpjdta,jpk,idtatot,jkenr, & 701 & jkenr,mig(1),nlci,mjg(1),nlcj,zu(1:nlci,1:nlcj,1:jpk)) 702 703 #if defined key_trcbbl_dif || defined key_trcbbl_adv 704 CALL flinget(numfl_u,'sobblcox',jpidta,jpjdta,1,idtatot,jkenr, & 705 & jkenr,mig(1),nlci,mjg(1),nlcj,zbblx(1:nlci,1:nlcj)) 706 #endif 707 708 # if defined key_traldf_eiv 709 CALL flinget(numfl_u,'vozoeivu',jpidta,jpjdta,jpk,idtatot,jkenr, & 710 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiu(1:nlci,1:nlcj,1:jpk)) 711 #endif 712 713 CALL flinget(numfl_v,'vomecrty',jpidta,jpjdta,jpk,idtatot,jkenr, & 714 & jkenr,mig(1),nlci,mjg(1),nlcj,zv(1:nlci,1:nlcj,1:jpk)) 715 716 #if defined key_trcbbl_dif || defined key_trcbbl_adv 717 CALL flinget(numfl_v,'sobblcoy',jpidta,jpjdta,1,idtatot,jkenr, & 718 & jkenr,mig(1),nlci,mjg(1),nlcj,zbbly(1:nlci,1:nlcj)) 719 #endif 720 721 # if defined key_traldf_eiv 722 CALL flinget(numfl_v,'vomeeivv',jpidta,jpjdta,jpk,idtatot,jkenr, & 723 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiv(1:nlci,1:nlcj,1:jpk)) 724 #endif 725 726 CALL flinget(numfl_w,'vovecrtz',jpidta,jpjdta,jpk,idtatot,jkenr, & 727 & jkenr,mig(1),nlci,mjg(1),nlcj,zw(1:nlci,1:nlcj,1:jpk)) 728 729 # if defined key_traldf_eiv 730 CALL flinget(numfl_w,'voveeivw',jpidta,jpjdta,jpk,idtatot,jkenr, & 731 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiw(1:nlci,1:nlcj,1:jpk)) 732 #endif 733 734 735 #if defined key_zdfddm 736 CALL flinget(numfl_w,'voddmavs',jpidta,jpjdta,jpk,idtatot,jkenr, & 737 & jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk)) 738 #else 739 CALL flinget(numfl_w,'votkeavt',jpidta,jpjdta,jpk,idtatot,jkenr, & 740 & jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk)) 741 #endif 742 743 #if defined key_traldf_eiv && defined key_traldf_c2d 744 CALL flinget(numfl_w,'soleahtw',jpidta,jpjdta,1,idtatot,jkenr, & 745 jkenr,mig(1),nlci,mjg(1),nlcj,zahtw(1:nlci,1:nlcj)) 746 747 CALL flinget(numfl_w,'soleaeiw',jpidta,jpjdta,1,idtatot,jkenr, & 748 jkenr,mig(1),nlci,mjg(1),nlcj,zeivw(1:nlci,1:nlcj)) 749 #endif 750 751 CALL flinget(numfl_t,'votemper',jpidta,jpjdta,jpk,idtatot,jkenr, & 752 & jkenr,mig(1),nlci,mjg(1),nlcj,zt(1:nlci,1:nlcj,1:jpk)) 753 754 CALL flinget(numfl_t,'vosaline',jpidta,jpjdta,jpk,idtatot,jkenr, & 755 & jkenr,mig(1),nlci,mjg(1),nlcj,zs(1:nlci,1:nlcj,1:jpk)) 756 757 CALL flinget(numfl_t,'somixhgt',jpidta,jpjdta,1,idtatot,jkenr, & 758 & jkenr,mig(1),nlci,mjg(1),nlcj,zmld(1:nlci,1:nlcj)) 759 760 761 CALL flinget(numfl_t,'sowaflup',jpidta,jpjdta,1,idtatot,jkenr, & 762 & jkenr,mig(1),nlci,mjg(1),nlcj,zemp(1:nlci,1:nlcj)) 763 764 CALL flinget(numfl_t,'soshfldo',jpidta,jpjdta,1,idtatot,jkenr, & 765 & jkenr,mig(1),nlci,mjg(1),nlcj,zqsr(1:nlci,1:nlcj)) 766 767 CALL flinget(numfl_t,'soicecov',jpidta,jpjdta,1,idtatot,jkenr, & 768 & jkenr,mig(1),nlci,mjg(1),nlcj,zice(1:nlci,1:nlcj)) 769 770 CALL flinget(numfl_s,'wspd', jpidta,jpjdta,1,idtatot,jkenr, & 771 & jkenr,mig(1),nlci,mjg(1),nlcj,zwind(1:nlci,1:nlcj)) 772 773 774 ! Extra-halo initialization in MPP 775 IF( lk_mpp ) THEN 776 DO ji = nlci+1, jpi 777 zu(ji,:,:) = zu(1,:,:) 778 zv(ji,:,:) = zv(1,:,:) 779 zw(ji,:,:) = zw(1,:,:) 780 zavt(ji,:,:)=zavt(1,:,:) 781 zt(ji,:,:)=zt(1,:,:) 782 zs(ji,:,:)=zs(1,:,:) 783 zmld(ji,:)=zmld(1,:) 784 zwind(ji,:)=zwind(1,:) 785 zemp(ji,:)=zemp(1,:) 786 zqsr(ji,:)=zqsr(1,:) 787 zice(ji,:)=zice(1,:) 788 #if defined key_trcbbl_dif || defined key_trcbbl_adv 789 zbblx(ji,:)=zbblx(1,:) 790 zbbly(ji,:)=zbbly(1,:) 791 #endif 792 #if defined key_traldf_eiv 793 zaeiu(ji,:,:)=zaeiu(1,:,:) 794 zaeiv(ji,:,:)=zaeiv(1,:,:) 795 zaeiw(ji,:,:)=zaeiw(1,:,:) 796 #endif 797 #if defined key_traldf_eiv && defined key_traldf_c2d 798 zahtw(ji,:)=zahtw(1,:) 799 zeivw(ji,:)=zeivw(1,:) 800 #endif 801 ENDDO 802 DO jj = nlcj+1, jpj 803 zu(:,jj,:) = zu(:,1,:) 804 zv(:,jj,:) = zv(:,1,:) 805 zw(:,jj,:) = zw(:,1,:) 806 zavt(:,jj,:)=zavt(:,1,:) 807 zt(:,jj,:)=zt(:,1,:) 808 zs(:,jj,:)=zs(:,1,:) 809 zmld(:,jj)=zmld(:,1) 810 zwind(:,jj)=zwind(:,1) 811 zemp(:,jj)=zemp(:,1) 812 zqsr(:,jj)=zqsr(:,1) 813 zice(:,jj)=zice(:,1) 814 #if defined key_trcbbl_dif || defined key_trcbbl_adv 815 zbblx(:,jj)=zbblx(:,1) 816 zbbly(:,jj)=zbbly(:,1) 817 #endif 818 #if defined key_traldf_eiv 819 zaeiu(:,jj,:)=zaeiu(:,1,:) 820 zaeiv(:,jj,:)=zaeiv(:,1,:) 821 zaeiw(:,jj,:)=zaeiw(:,1,:) 822 #endif 823 #if defined key_traldf_eiv && defined key_traldf_c2d 824 zahtw(:,jj)=zahtw(:,1) 825 zeivw(:,jj)=zeivw(:,1) 826 #endif 827 ENDDO 828 ENDIF 829 830 831 udta(:,:,:,2)=zu(:,:,:)*umask(:,:,:) 832 vdta(:,:,:,2)=zv(:,:,:)*vmask(:,:,:) 833 wdta(:,:,:,2)=zw(:,:,:)*tmask(:,:,:) 834 tdta(:,:,:,2)=zt(:,:,:)*tmask(:,:,:) 835 sdta(:,:,:,2)=zs(:,:,:)*tmask(:,:,:) 836 avtdta(:,:,:,2)=zavt(:,:,:)*tmask(:,:,:) 837 #if defined key_traldf_eiv && defined key_traldf_c2d 838 ahtwdta(:,:,2)=zahtw(:,:)*tmask(:,:,1) 839 eivwdta(:,:,2)=zeivw(:,:)*tmask(:,:,1) 840 #endif 841 ! 842 ! 843 ! flux : 844 ! 845 flxdta(:,:,jpwind,2)=zwind(:,:)*tmask(:,:,1) 846 flxdta(:,:,jpice,2)=min(1.,zice(:,:))*tmask(:,:,1) 847 flxdta(:,:,jpemp,2)=zemp(:,:)*tmask(:,:,1) 848 flxdta(:,:,jpqsr,2)=zqsr(:,:)*tmask(:,:,1) 849 zmxldta(:,:,2)=zmld(:,:)*tmask(:,:,1) 850 851 #if defined key_trcbbl_dif || defined key_trcbbl_adv 852 bblxdta(:,:,2)=max(0.,zbblx(:,:)) 853 bblydta(:,:,2)=max(0.,zbbly(:,:)) 854 855 DO ji=1,jpi 856 DO jj=1,jpj 857 if (bblxdta(ji,jj,2).gt.2.) bblxdta(ji,jj,2)=0. 858 if (bblydta(ji,jj,2).gt.2.) bblydta(ji,jj,2)=0. 859 END DO 860 END DO 861 #endif 862 890 863 891 END SUBROUTINE dynrea 864 892
Note: See TracChangeset
for help on using the changeset viewer.