New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST/agrif_oce_sponge.F90 – NEMO

Ignore:
Timestamp:
2021-03-26T15:33:49+01:00 (3 years ago)
Author:
sparonuz
Message:

Merge trunk -r14642:HEAD

Location:
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette_wave@13990         sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/NST/agrif_oce_sponge.F90

    r14200 r14644  
    44   !!====================================================================== 
    55   !!                   ***  MODULE  agrif_oce_interp  *** 
    6    !! AGRIF: sponge package for the ocean dynamics (OPA) 
     6   !! AGRIF: sponge package for the ocean dynamics (OCE) 
    77   !!====================================================================== 
    88   !! History :  2.0  !  2002-06  (XXX)  Original cade 
    … …  
    236236      END_2D 
    237237       
    238       CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
     238      CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
    239239      ! 
    240240      ! Remove vertical interpolation where not needed: 
    … …  
    368368         fspf_2d(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    369369         END_2D 
    370       CALL lbc_lnk_multi( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp ) 
     370      CALL lbc_lnk( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp ) 
    371371      ! 
    372372#endif 
    … …  
    658658                  tabres_child(ji,jj,:) = 0._wp 
    659659                  N_in = mbku_parent(ji,jj) 
    660                   zhtot = 0._wp 
    661                   DO jk=1,N_in 
    662                      !IF (jk==N_in) THEN 
    663                      !   h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
    664                      !ELSE 
    665                      !   h_in(jk) = tabres(ji,jj,jk,m2) 
    666                      !ENDIF 
    667                      h_in(jk) = e3u0_parent(ji,jj,jk) 
    668                      zhtot = zhtot + h_in(jk) 
    669                      tabin(jk) = tabres(ji,jj,jk,m1) 
    670                   END DO 
    671                   !          
    672                   N_out = 0 
    673                   DO jk=1,jpk 
    674                      IF (umask(ji,jj,jk) == 0) EXIT 
    675                      N_out = N_out + 1 
    676                      h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 
    677                   END DO 
    678  
    679                   ! Account for small differences in free-surface 
    680                   IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
    681                      h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    682                   ELSE 
    683                      h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    684                   ENDIF 
     660                  N_out = mbku(ji,jj) 
     661                  IF (N_in * N_out > 0) THEN 
     662                     zhtot = 0._wp 
     663                     DO jk=1,N_in 
     664                        !IF (jk==N_in) THEN 
     665                        !   h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     666                        !ELSE 
     667                        !   h_in(jk) = tabres(ji,jj,jk,m2) 
     668                        !ENDIF 
     669                        h_in(jk) = e3u0_parent(ji,jj,jk) 
     670                        zhtot = zhtot + h_in(jk) 
     671                        tabin(jk) = tabres(ji,jj,jk,m1) 
     672                     END DO 
     673                     !          
     674                     DO jk=1,N_out 
     675                        h_out(jk) = e3u(ji,jj,jk,Kbb_a) 
     676                     END DO 
     677 
     678                     ! Account for small differences in free-surface 
     679                     IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     680                        h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
     681                     ELSE 
     682                        h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     683                     ENDIF 
    685684                   
    686                   IF (N_in * N_out > 0) THEN 
    687685                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    688686                  ENDIF  
    … …  
    843841                  tabres_child(ji,jj,:) = 0._wp 
    844842                  N_in = mbkv_parent(ji,jj) 
    845                   zhtot = 0._wp 
    846                   DO jk=1,N_in 
    847                      !IF (jk==N_in) THEN 
    848                      !   h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
    849                      !ELSE 
    850                      !   h_in(jk) = tabres(ji,jj,jk,m2) 
    851                      !ENDIF 
    852                      h_in(jk) = e3v0_parent(ji,jj,jk) 
    853                      zhtot = zhtot + h_in(jk) 
    854                      tabin(jk) = tabres(ji,jj,jk,m1) 
    855                   END DO 
    856                   !           
    857                   N_out = 0 
    858                   DO jk=1,jpk 
    859                      IF (vmask(ji,jj,jk) == 0) EXIT 
    860                      N_out = N_out + 1 
    861                      h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 
    862                   END DO 
    863  
    864                   ! Account for small differences in free-surface 
    865                   IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
    866                      h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    867                   ELSE 
    868                      h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    869                   ENDIF 
     843                  N_out = mbkv(ji,jj) 
     844                  IF (N_in * N_out > 0) THEN 
     845                     zhtot = 0._wp 
     846                     DO jk=1,N_in 
     847                        !IF (jk==N_in) THEN 
     848                        !   h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     849                        !ELSE 
     850                        !   h_in(jk) = tabres(ji,jj,jk,m2) 
     851                        !ENDIF 
     852                        h_in(jk) = e3v0_parent(ji,jj,jk) 
     853                        zhtot = zhtot + h_in(jk) 
     854                        tabin(jk) = tabres(ji,jj,jk,m1) 
     855                     END DO 
     856                     !           
     857                     DO jk=1,N_out 
     858                        h_out(jk) = e3v(ji,jj,jk,Kbb_a) 
     859                     END DO 
     860 
     861                     ! Account for small differences in free-surface 
     862                     IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     863                        h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
     864                     ELSE 
     865                        h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     866                     ENDIF 
    870867          
    871                   IF (N_in * N_out > 0) THEN 
    872868                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     869 
    873870                  ENDIF 
    874871               END DO 
Note: See TracChangeset for help on using the changeset viewer.