- Timestamp:
- 2020-09-24T20:49:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/ASM/asminc.F90
r13295 r13518 520 520 INTEGER :: it 521 521 REAL(wp) :: zincwgt ! IAU weight for current time step 522 REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values522 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 523 523 !!---------------------------------------------------------------------- 524 524 ! 525 525 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 526 ! used to prevent the applied increments taking the temperature below the local freezing point 527 DO jk = 1, jpkm1 528 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 529 END DO 527 ! TODO: NOT TESTED- logical is forced to False 528 IF( ln_temnofreeze ) THEN 529 DO jk = 1, jpkm1 530 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 531 END DO 532 ENDIF 530 533 ! 531 534 ! !-------------------------------------- … … 538 541 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 542 ! 540 IF(lwp) THEN 541 WRITE(numout,*) 542 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 543 WRITE(numout,*) '~~~~~~~~~~~~' 543 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 544 IF(lwp) THEN 545 WRITE(numout,*) 546 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 547 WRITE(numout,*) '~~~~~~~~~~~~' 548 ENDIF 544 549 ENDIF 545 550 ! 546 551 ! Update the tracer tendencies 552 ! TODO: NOT TESTED- logical is forced to False 547 553 DO jk = 1, jpkm1 548 554 IF (ln_temnofreeze) THEN 549 555 ! Do not apply negative increments if the temperature will fall below freezing 550 WHERE(t_bkginc( :,:,jk) > 0.0_wp .OR. &551 & pts( :,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )552 pts( :,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt556 WHERE(t_bkginc(ST_2D(0),jk) > 0.0_wp .OR. & 557 & pts(ST_2D(0),jk,jp_tem,Kmm) + pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 558 pts(ST_2D(0),jk,jp_tem,Krhs) = pts(ST_2D(0),jk,jp_tem,Krhs) + t_bkginc(ST_2D(0),jk) * zincwgt 553 559 END WHERE 554 560 ELSE 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 561 DO_2D( 0, 0, 0, 0 ) 562 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 563 END_2D 556 564 ENDIF 557 565 IF (ln_salfix) THEN 558 566 ! Do not apply negative increments if the salinity will fall below a specified 559 567 ! minimum value salfixmin 560 WHERE(s_bkginc( :,:,jk) > 0.0_wp .OR. &561 & pts( :,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )562 pts( :,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt568 WHERE(s_bkginc(ST_2D(0),jk) > 0.0_wp .OR. & 569 & pts(ST_2D(0),jk,jp_sal,Kmm) + pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * wgtiau(it) > salfixmin ) 570 pts(ST_2D(0),jk,jp_sal,Krhs) = pts(ST_2D(0),jk,jp_sal,Krhs) + s_bkginc(ST_2D(0),jk) * zincwgt 563 571 END WHERE 564 572 ELSE 565 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 573 DO_2D( 0, 0, 0, 0 ) 574 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 575 END_2D 566 576 ENDIF 567 577 END DO … … 569 579 ENDIF 570 580 ! 571 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 572 DEALLOCATE( t_bkginc ) 573 DEALLOCATE( s_bkginc ) 581 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 582 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 583 DEALLOCATE( t_bkginc ) 584 DEALLOCATE( s_bkginc ) 585 ENDIF 574 586 ENDIF 575 587 ! !-------------------------------------- … … 582 594 ! 583 595 ! Initialize the now fields with the background + increment 596 ! TODO: NOT TESTED- logical is forced to False 584 597 IF (ln_temnofreeze) THEN 585 598 ! Do not apply negative increments if the temperature will fall below freezing 586 WHERE( t_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )587 pts( :,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)599 WHERE( t_bkginc(ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_tem,Kmm) + t_bkginc(ST_2D(0),:) > fzptnz(:,:,:) ) 600 pts(ST_2D(0),:,jp_tem,Kmm) = t_bkg(ST_2D(0),:) + t_bkginc(ST_2D(0),:) 588 601 END WHERE 589 602 ELSE 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 603 DO_3D( 0, 0, 0, 0, 1, jpk ) 604 pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 605 END_3D 591 606 ENDIF 592 607 IF (ln_salfix) THEN 593 608 ! Do not apply negative increments if the salinity will fall below a specified 594 609 ! minimum value salfixmin 595 WHERE( s_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )596 pts( :,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)610 WHERE( s_bkginc(ST_2D(0),:) > 0.0_wp .OR. pts(ST_2D(0),:,jp_sal,Kmm) + s_bkginc(ST_2D(0),:) > salfixmin ) 611 pts(ST_2D(0),:,jp_sal,Kmm) = s_bkg(ST_2D(0),:) + s_bkginc(ST_2D(0),:) 597 612 END WHERE 598 613 ELSE 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 ENDIF 601 602 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 614 DO_3D( 0, 0, 0, 0, 1, jpk ) 615 pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 616 END_3D 617 ENDIF 618 619 DO_3D( 0, 0, 0, 0, 1, jpk ) 620 pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm) ! Update before fields 621 END_3D 603 622 604 623 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 607 626 !!gm 608 627 609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 610 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 613 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 614 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 615 616 DEALLOCATE( t_bkginc ) 617 DEALLOCATE( s_bkginc ) 618 DEALLOCATE( t_bkg ) 619 DEALLOCATE( s_bkg ) 628 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 629 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 630 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 631 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 632 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 633 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 634 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 635 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 636 ENDIF 637 638 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 639 DEALLOCATE( t_bkginc ) 640 DEALLOCATE( s_bkginc ) 641 DEALLOCATE( t_bkg ) 642 DEALLOCATE( s_bkg ) 643 ENDIF 644 ! 620 645 ENDIF 621 646 ! 622 647 ENDIF 648 ! TODO: NOT TESTED- logical is forced to False 623 649 ! Perhaps the following call should be in step 624 650 IF ( ln_seaiceinc ) CALL seaice_asm_inc ( kt ) ! apply sea ice concentration increment … … 829 855 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 830 856 ! 857 INTEGER :: ji, jj 831 858 INTEGER :: it 832 859 REAL(wp) :: zincwgt ! IAU weight for current time step 833 860 #if defined key_si3 834 REAL(wp), DIMENSION( jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc861 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc 835 862 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres 836 863 #endif … … 847 874 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 848 875 ! 849 IF(lwp) THEN 850 WRITE(numout,*) 851 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 852 WRITE(numout,*) '~~~~~~~~~~~~' 876 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 877 IF(lwp) THEN 878 WRITE(numout,*) 879 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 880 WRITE(numout,*) '~~~~~~~~~~~~' 881 ENDIF 853 882 ENDIF 854 883 ! … … 856 885 ! 857 886 #if defined key_si3 858 zofrld (:,:) = 1._wp - at_i(:,:) 859 zohicif(:,:) = hm_i(:,:) 860 ! 861 at_i (:,:) = 1. - MIN( MAX( 1.-at_i (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 862 at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 863 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 864 ! 865 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 887 DO_2D( 0, 0, 0, 0 ) 888 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 889 zohicif(ji,jj) = hm_i(ji,jj) 890 ! 891 at_i (ji,jj) = 1. - MIN( MAX( 1.-at_i (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 892 at_i_b(ji,jj) = 1. - MIN( MAX( 1.-at_i_b(ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 893 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 894 ! 895 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 896 END_2D 866 897 ! 867 898 ! Nudge sea ice depth to bring it up to a required minimum depth 868 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )869 zhicifinc(:,:) = (zhicifmin - hm_i( :,:)) * zincwgt899 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 900 zhicifinc(:,:) = (zhicifmin - hm_i(ST_2D(0))) * zincwgt 870 901 ELSEWHERE 871 902 zhicifinc(:,:) = 0.0_wp … … 873 904 ! 874 905 ! nudge ice depth 875 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 906 DO_2D( 0, 0, 0, 0 ) 907 hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 908 END_2D 876 909 ! 877 910 ! seaice salinity balancing (to add) … … 880 913 #if defined key_cice && defined key_asminc 881 914 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 882 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 883 #endif 884 ! 885 IF ( kt == nitiaufin_r ) THEN 886 DEALLOCATE( seaice_bkginc ) 915 DO_2D( 0, 0, 0, 0 ) 916 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 917 END_2D 918 #endif 919 ! 920 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 921 IF ( kt == nitiaufin_r ) THEN 922 DEALLOCATE( seaice_bkginc ) 923 ENDIF 887 924 ENDIF 888 925 ! … … 890 927 ! 891 928 #if defined key_cice && defined key_asminc 892 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 929 DO_2D( 0, 0, 0, 0 ) 930 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 931 END_2D 893 932 #endif 894 933 ! … … 905 944 ! 906 945 #if defined key_si3 907 zofrld (:,:) = 1._wp - at_i(:,:) 908 zohicif(:,:) = hm_i(:,:) 909 ! 910 ! Initialize the now fields the background + increment 911 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 912 at_i_b(:,:) = at_i(:,:) 913 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 914 ! 915 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 946 DO_2D( 0, 0, 0, 0 ) 947 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 948 zohicif(ji,jj) = hm_i(ji,jj) 949 ! 950 ! Initialize the now fields the background + increment 951 at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 952 at_i_b(ji,jj) = at_i(ji,jj) 953 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 954 ! 955 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 956 END_2D 916 957 ! 917 958 ! Nudge sea ice depth to bring it up to a required minimum depth 918 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )919 zhicifinc(:,:) = zhicifmin - hm_i( :,:)959 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(ST_2D(0)) < zhicifmin ) 960 zhicifinc(:,:) = zhicifmin - hm_i(ST_2D(0)) 920 961 ELSEWHERE 921 962 zhicifinc(:,:) = 0.0_wp … … 923 964 ! 924 965 ! nudge ice depth 925 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 966 DO_2D( 0, 0, 0, 0 ) 967 hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 968 END_2D 926 969 ! 927 970 ! seaice salinity balancing (to add) … … 930 973 #if defined key_cice && defined key_asminc 931 974 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 932 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 933 #endif 934 IF ( .NOT. PRESENT(kindic) ) THEN 935 DEALLOCATE( seaice_bkginc ) 936 END IF 975 DO_2D( 0, 0, 0, 0 ) 976 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 977 END_2D 978 #endif 979 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 980 IF ( .NOT. PRESENT(kindic) ) THEN 981 DEALLOCATE( seaice_bkginc ) 982 END IF 983 ENDIF 937 984 ! 938 985 ELSE 939 986 ! 940 987 #if defined key_cice && defined key_asminc 941 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 988 DO_2D( 0, 0, 0, 0 ) 989 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 990 END_2D 942 991 #endif 943 992 !
Note: See TracChangeset
for help on using the changeset viewer.
