- Timestamp:
- 2020-12-02T16:13:45+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13559sette10 ^/utils/CI/sette_MPI3_LoopFusion@13943 sette
-
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/ASM/asminc.F90
r13899 r14012 26 26 USE par_oce ! Ocean space and time domain variables 27 27 USE dom_oce ! Ocean space and time domain 28 USE domain, ONLY : dom_tile 28 29 USE domvvl ! domain: variable volume level 29 30 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients … … 518 519 ! 519 520 INTEGER :: ji, jj, jk 520 INTEGER :: it 521 INTEGER :: it, itile 521 522 REAL(wp) :: zincwgt ! IAU weight for current time step 522 REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values523 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 523 524 !!---------------------------------------------------------------------- 524 525 ! 525 526 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 527 ! 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 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 ! … … 548 553 IF (ln_temnofreeze) THEN 549 554 ! 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) * zincwgt555 WHERE(t_bkginc(A2D(0),jk) > 0.0_wp .OR. & 556 & pts(A2D(0),jk,jp_tem,Kmm) + pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 557 pts(A2D(0),jk,jp_tem,Krhs) = pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * zincwgt 553 558 END WHERE 554 559 ELSE 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 560 DO_2D( 0, 0, 0, 0 ) 561 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 562 END_2D 556 563 ENDIF 557 564 IF (ln_salfix) THEN 558 565 ! Do not apply negative increments if the salinity will fall below a specified 559 566 ! 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) * zincwgt567 WHERE(s_bkginc(A2D(0),jk) > 0.0_wp .OR. & 568 & pts(A2D(0),jk,jp_sal,Kmm) + pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * wgtiau(it) > salfixmin ) 569 pts(A2D(0),jk,jp_sal,Krhs) = pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * zincwgt 563 570 END WHERE 564 571 ELSE 565 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 572 DO_2D( 0, 0, 0, 0 ) 573 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 574 END_2D 566 575 ENDIF 567 576 END DO … … 569 578 ENDIF 570 579 ! 571 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 572 DEALLOCATE( t_bkginc ) 573 DEALLOCATE( s_bkginc ) 580 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 581 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 582 DEALLOCATE( t_bkginc ) 583 DEALLOCATE( s_bkginc ) 584 ENDIF 574 585 ENDIF 575 586 ! !-------------------------------------- … … 584 595 IF (ln_temnofreeze) THEN 585 596 ! 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(:,:,:)597 WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) ) 598 pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:) 588 599 END WHERE 589 600 ELSE 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 601 DO_3D( 0, 0, 0, 0, 1, jpk ) 602 pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 603 END_3D 591 604 ENDIF 592 605 IF (ln_salfix) THEN 593 606 ! Do not apply negative increments if the salinity will fall below a specified 594 607 ! 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(:,:,:)608 WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin ) 609 pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:) 597 610 END WHERE 598 611 ELSE 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 ENDIF 601 602 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 612 DO_3D( 0, 0, 0, 0, 1, jpk ) 613 pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 614 END_3D 615 ENDIF 616 617 DO_3D( 0, 0, 0, 0, 1, jpk ) 618 pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm) ! Update before fields 619 END_3D 603 620 604 621 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 607 624 !!gm 608 625 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 ) 626 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 627 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 628 itile = ntile 629 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 630 631 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 632 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 633 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 634 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 635 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 636 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 637 638 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 639 ENDIF 640 641 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 642 DEALLOCATE( t_bkginc ) 643 DEALLOCATE( s_bkginc ) 644 DEALLOCATE( t_bkg ) 645 DEALLOCATE( s_bkg ) 646 ENDIF 647 ! 620 648 ENDIF 621 649 ! … … 829 857 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 830 858 ! 859 INTEGER :: ji, jj 831 860 INTEGER :: it 832 861 REAL(wp) :: zincwgt ! IAU weight for current time step 833 862 #if defined key_si3 834 REAL(wp), DIMENSION( jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc863 REAL(wp), DIMENSION(A2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc 835 864 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres 836 865 #endif … … 847 876 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 848 877 ! 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,*) '~~~~~~~~~~~~' 878 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 879 IF(lwp) THEN 880 WRITE(numout,*) 881 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 882 WRITE(numout,*) '~~~~~~~~~~~~' 883 ENDIF 853 884 ENDIF 854 885 ! … … 856 887 ! 857 888 #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 889 DO_2D( 0, 0, 0, 0 ) 890 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 891 zohicif(ji,jj) = hm_i(ji,jj) 892 ! 893 at_i (ji,jj) = 1. - MIN( MAX( 1.-at_i (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 894 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) 895 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 896 ! 897 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 898 END_2D 866 899 ! 867 900 ! 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( :,:)) * zincwgt901 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 902 zhicifinc(:,:) = (zhicifmin - hm_i(A2D(0))) * zincwgt 870 903 ELSEWHERE 871 904 zhicifinc(:,:) = 0.0_wp … … 873 906 ! 874 907 ! nudge ice depth 875 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 908 DO_2D( 0, 0, 0, 0 ) 909 hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 910 END_2D 876 911 ! 877 912 ! seaice salinity balancing (to add) … … 880 915 #if defined key_cice && defined key_asminc 881 916 ! 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 ) 917 DO_2D( 0, 0, 0, 0 ) 918 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 919 END_2D 920 #endif 921 ! 922 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 923 IF ( kt == nitiaufin_r ) THEN 924 DEALLOCATE( seaice_bkginc ) 925 ENDIF 887 926 ENDIF 888 927 ! … … 890 929 ! 891 930 #if defined key_cice && defined key_asminc 892 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 931 DO_2D( 0, 0, 0, 0 ) 932 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 933 END_2D 893 934 #endif 894 935 ! … … 905 946 ! 906 947 #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 948 DO_2D( 0, 0, 0, 0 ) 949 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 950 zohicif(ji,jj) = hm_i(ji,jj) 951 ! 952 ! Initialize the now fields the background + increment 953 at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 954 at_i_b(ji,jj) = at_i(ji,jj) 955 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 956 ! 957 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 958 END_2D 916 959 ! 917 960 ! 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( :,:)961 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 962 zhicifinc(:,:) = zhicifmin - hm_i(A2D(0)) 920 963 ELSEWHERE 921 964 zhicifinc(:,:) = 0.0_wp … … 923 966 ! 924 967 ! nudge ice depth 925 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 968 DO_2D( 0, 0, 0, 0 ) 969 hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 970 END_2D 926 971 ! 927 972 ! seaice salinity balancing (to add) … … 930 975 #if defined key_cice && defined key_asminc 931 976 ! 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 977 DO_2D( 0, 0, 0, 0 ) 978 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 979 END_2D 980 #endif 981 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 982 IF ( .NOT. PRESENT(kindic) ) THEN 983 DEALLOCATE( seaice_bkginc ) 984 END IF 985 ENDIF 937 986 ! 938 987 ELSE 939 988 ! 940 989 #if defined key_cice && defined key_asminc 941 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 990 DO_2D( 0, 0, 0, 0 ) 991 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 992 END_2D 942 993 #endif 943 994 !
Note: See TracChangeset
for help on using the changeset viewer.