Changeset 14856 for NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/ASM/asminc.F90
- Timestamp:
- 2021-05-12T17:58:07+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/ASM/asminc.F90
r14090 r14856 26 26 USE par_oce ! Ocean space and time domain variables 27 27 USE dom_oce ! Ocean space and time domain 28 USE domtile29 28 USE domvvl ! domain: variable volume level 30 29 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients … … 519 518 ! 520 519 INTEGER :: ji, jj, jk 521 INTEGER :: it , itile520 INTEGER :: it 522 521 REAL(wp) :: zincwgt ! IAU weight for current time step 523 522 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values … … 541 540 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 542 541 ! 543 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only on the first tile542 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 544 543 IF(lwp) THEN 545 544 WRITE(numout,*) … … 578 577 ENDIF 579 578 ! 580 IF( ntile == 0.OR. ntile == nijtile ) THEN ! Do only on the last tile579 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 581 580 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 582 581 DEALLOCATE( t_bkginc ) … … 595 594 IF (ln_temnofreeze) THEN 596 595 ! Do not apply negative increments if the temperature will fall below freezing 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),:)596 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 597 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 599 598 END WHERE 600 599 ELSE 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 600 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 604 601 ENDIF 605 602 IF (ln_salfix) THEN 606 603 ! Do not apply negative increments if the salinity will fall below a specified 607 604 ! minimum value salfixmin 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),:)605 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 606 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 610 607 END WHERE 611 608 ELSE 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 609 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 610 ENDIF 611 612 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 620 613 621 614 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 624 617 !!gm 625 618 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 ! 619 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 620 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 621 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 622 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 623 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 624 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 625 626 DEALLOCATE( t_bkginc ) 627 DEALLOCATE( s_bkginc ) 628 DEALLOCATE( t_bkg ) 629 DEALLOCATE( s_bkg ) 648 630 ENDIF 649 631 ! … … 669 651 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 670 652 ! 671 INTEGER :: j k653 INTEGER :: ji, jj, jk 672 654 INTEGER :: it 673 655 REAL(wp) :: zincwgt ! IAU weight for current time step … … 683 665 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 684 666 ! 685 IF(lwp) THEN 686 WRITE(numout,*) 687 WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 688 WRITE(numout,*) '~~~~~~~~~~~~' 667 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 668 IF(lwp) THEN 669 WRITE(numout,*) 670 WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 671 WRITE(numout,*) '~~~~~~~~~~~~' 672 ENDIF 689 673 ENDIF 690 674 ! 691 675 ! Update the dynamic tendencies 692 DO jk = 1, jpkm1 693 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + u_bkginc(:,:,jk) * zincwgt 694 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + v_bkginc(:,:,jk) * zincwgt 695 END DO 696 ! 697 IF ( kt == nitiaufin_r ) THEN 698 DEALLOCATE( u_bkginc ) 699 DEALLOCATE( v_bkginc ) 676 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 677 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + u_bkginc(ji,jj,jk) * zincwgt 678 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + v_bkginc(ji,jj,jk) * zincwgt 679 END_3D 680 ! 681 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 682 IF ( kt == nitiaufin_r ) THEN 683 DEALLOCATE( u_bkginc ) 684 DEALLOCATE( v_bkginc ) 685 ENDIF 700 686 ENDIF 701 687 ! … … 741 727 ! 742 728 INTEGER :: it 743 INTEGER :: j k729 INTEGER :: ji, jj, jk 744 730 REAL(wp) :: zincwgt ! IAU weight for current time step 745 731 !!---------------------------------------------------------------------- … … 754 740 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 755 741 ! 756 IF(lwp) THEN 757 WRITE(numout,*) 758 WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 759 & kt,' with IAU weight = ', wgtiau(it) 760 WRITE(numout,*) '~~~~~~~~~~~~' 742 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 743 IF(lwp) THEN 744 WRITE(numout,*) 745 WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 746 & kt,' with IAU weight = ', wgtiau(it) 747 WRITE(numout,*) '~~~~~~~~~~~~' 748 ENDIF 761 749 ENDIF 762 750 ! … … 764 752 ! (applied in dynspg.*) 765 753 #if defined key_asminc 766 ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt 754 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 755 ssh_iau(ji,jj) = ssh_bkginc(ji,jj) * zincwgt 756 END_2D 767 757 #endif 768 758 ! … … 770 760 ! 771 761 ! test on ssh_bkginc needed as ssh_asm_inc is called twice by time step 772 IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc ) 762 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 763 IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc ) 764 ENDIF 773 765 ! 774 766 #if defined key_asminc 775 ssh_iau(:,:) = 0._wp 767 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 768 ssh_iau(ji,jj) = 0._wp 769 END_2D 776 770 #endif 777 771 ! … … 820 814 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 821 815 !! 822 INTEGER :: j k! dummy loop index816 INTEGER :: ji, jj, jk ! dummy loop index 823 817 REAL(wp), DIMENSION(:,:) , POINTER :: ztim ! local array 824 818 !!---------------------------------------------------------------------- … … 828 822 ! 829 823 IF( ln_linssh ) THEN 830 phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 824 DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 825 phdivn(ji,jj,1) = phdivn(ji,jj,1) - ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) * tmask(ji,jj,1) 826 END_2D 831 827 ELSE 832 ALLOCATE( ztim(jpi,jpj) ) 833 ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 834 DO jk = 1, jpkm1 835 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 836 END DO 828 ALLOCATE( ztim(A2D(nn_hls)) ) 829 DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 830 ztim(ji,jj) = ssh_iau(ji,jj) / ( ht(ji,jj) + 1.0 - ssmask(ji,jj) ) 831 DO jk = 1, jpkm1 832 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ztim(ji,jj) * tmask(ji,jj,jk) 833 END DO 834 END_2D 837 835 ! 838 836 DEALLOCATE(ztim) … … 876 874 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 877 875 ! 878 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only on the first tile876 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 879 877 IF(lwp) THEN 880 878 WRITE(numout,*) … … 920 918 #endif 921 919 ! 922 IF( ntile == 0.OR. ntile == nijtile ) THEN ! Do only on the last tile920 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 923 921 IF ( kt == nitiaufin_r ) THEN 924 922 DEALLOCATE( seaice_bkginc ) … … 979 977 END_2D 980 978 #endif 981 IF( ntile == 0.OR. ntile == nijtile ) THEN ! Do only on the last tile979 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 982 980 IF ( .NOT. PRESENT(kindic) ) THEN 983 981 DEALLOCATE( seaice_bkginc )
Note: See TracChangeset
for help on using the changeset viewer.