- Timestamp:
- 2021-04-27T13:27:53+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ASM/asminc.F90
r14537 r14751 26 26 USE par_oce ! Ocean space and time domain variables 27 27 USE dom_oce ! Ocean space and time domain 28 ! TEMP: [tiling] This change not necessary after extended haloes development29 USE domtile30 28 USE domvvl ! domain: variable volume level 31 29 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients … … 596 594 IF (ln_temnofreeze) THEN 597 595 ! Do not apply negative increments if the temperature will fall below freezing 598 WHERE( t_bkginc( A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) )599 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(:,:,:) 600 598 END WHERE 601 599 ELSE 602 DO_3D( 0, 0, 0, 0, 1, jpk ) 603 pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 604 END_3D 600 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 605 601 ENDIF 606 602 IF (ln_salfix) THEN 607 603 ! Do not apply negative increments if the salinity will fall below a specified 608 604 ! minimum value salfixmin 609 WHERE( s_bkginc( A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin )610 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(:,:,:) 611 607 END WHERE 612 608 ELSE 613 DO_3D( 0, 0, 0, 0, 1, jpk ) 614 pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 615 END_3D 616 ENDIF 617 618 DO_3D( 0, 0, 0, 0, 1, jpk ) 619 pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm) ! Update before fields 620 END_3D 609 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 610 ENDIF 611 612 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 621 613 622 614 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 625 617 !!gm 626 618 627 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 628 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only for the full domain 629 IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE., cstr='asminc' ) ! 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_start( ldhold=.TRUE., cstr='asminc' ) ! Revert to tile domain 639 ENDIF 640 641 IF( .NOT. l_istiled .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 ! 667 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 685 668 IF(lwp) THEN 686 669 WRITE(numout,*) … … 688 671 WRITE(numout,*) '~~~~~~~~~~~~' 689 672 ENDIF 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 ! 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 697 682 IF ( kt == nitiaufin_r ) THEN 698 683 DEALLOCATE( u_bkginc ) 699 684 DEALLOCATE( v_bkginc ) 700 685 ENDIF 701 ! 702 ENDIF 686 ENDIF 687 ! 688 ENDIF 703 689 ! !----------------------------------------- 704 690 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization … … 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 ! 742 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 756 743 IF(lwp) THEN 757 744 WRITE(numout,*) … … 760 747 WRITE(numout,*) '~~~~~~~~~~~~' 761 748 ENDIF 749 ENDIF 762 750 ! 763 751 ! Save the tendency associated with the IAU weighted SSH increment 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 762 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 772 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(:,:) ) 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) ) 834 831 DO jk = 1, jpkm1 835 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk)832 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ztim(ji,jj) * tmask(ji,jj,jk) 836 833 END DO 834 END_2D 837 835 ! 838 836 DEALLOCATE(ztim)
Note: See TracChangeset
for help on using the changeset viewer.
