Changeset 13251 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

Timestamp:

2020-07-05T16:59:00+02:00 (4 years ago)

Author:

smasson

Message:

Extra_Halo: bugfix following merge with trunk@13218, see #2366

File:

• NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90 (modified) (13 diffs)

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

@@ -78 +78 @@
       zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
 
-      Agrif_SpecialValue=0.
+      Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = ln_spc_dyn
-      use_sign_north = .TRUE.
-      sign_north = -1.
+      use_sign_north        = .TRUE.
+      sign_north            = -1._wp
       !
       tabspongedone_u = .FALSE.
@@ -92 +92 @@
       !
       Agrif_UseSpecialValue = .FALSE.
-      use_sign_north = .FALSE.
+      use_sign_north        = .FALSE.
 #endif
       !
@@ -109 +109 @@
       REAL(wp) ::   z1_ispongearea, z1_jspongearea
       REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
+#if defined key_vertical
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv
+#endif
       REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast
       REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth
@@ -129 +133 @@
          ! Retrieve masks at open boundaries:
 
-         ! --- West --- !
-         IF( lk_west) THEN
+         IF( lk_west ) THEN                             ! --- West --- !
             ztabramp(:,:) = 0._wp
             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
@@ -139 +142 @@
             zmskwest(jpj+1:jpjmax) = 0._wp
          ENDIF
-
-         ! --- East --- !
-         IF( lk_east ) THEN
+         IF( lk_east ) THEN                             ! --- East --- !
             ztabramp(:,:) = 0._wp
             ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
@@ -150 +151 @@
             zmskeast(jpj+1:jpjmax) = 0._wp
          ENDIF
-
-         ! --- South --- !
-         IF( lk_south ) THEN
+         IF( lk_south ) THEN                            ! --- South --- !
             ztabramp(:,:) = 0._wp
             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
@@ -161 +160 @@
             zmsksouth(jpi+1:jpimax) = 0._wp
          ENDIF
-
-         ! --- North --- !
-         IF( lk_north) THEN
+         IF( lk_north ) THEN                            ! --- North --- !
             ztabramp(:,:) = 0._wp
             ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells
@@ -188 +185 @@
          ! Store it in ztabramp
 
-         ispongearea  = nn_sponge_len * Agrif_irhox()
-         z1_ispongearea = 1._wp / REAL( ispongearea )
-         jspongearea  = nn_sponge_len * Agrif_irhoy()
-         z1_jspongearea = 1._wp / REAL( jspongearea )
+         ispongearea    = nn_sponge_len * Agrif_irhox()
+         z1_ispongearea = 1._wp / REAL( ispongearea, wp )
+         jspongearea    = nn_sponge_len * Agrif_irhoy()
+         z1_jspongearea = 1._wp / REAL( jspongearea, wp )
          
          ztabramp(:,:) = 0._wp
@@ -199 +196 @@
          IF ( nbcellsy <= 3 ) jspongearea = -1
 
-         ! --- West --- !
-         IF(lk_west) THEN
+         IF( lk_west ) THEN                             ! --- West --- !
             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
             ind2 = nn_hls + 1 + nbghostcells + ispongearea 
             DO ji = mi0(ind1), mi1(ind2)   
                DO jj = 1, jpj               
-                  ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj)
+                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea   * zmskwest(jj)
                END DO
             END DO
@@ -217 +213 @@
             END DO
          ENDIF
-
-         ! --- East --- !
-         IF(lk_east) THEN
+         IF( lk_east ) THEN                             ! --- East --- !
             ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea
             ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
             DO ji = mi0(ind1), mi1(ind2)
                DO jj = 1, jpj
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj)
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj)
                END DO
             END DO
@@ -235 +229 @@
                END DO
             END DO
-         ENDIF
-         
-         ! --- South --- !
-         IF( lk_south ) THEN 
+         ENDIF      
+         IF( lk_south ) THEN                            ! --- South --- !
             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells
             ind2 = nn_hls + 1 + nbghostcells + jspongearea 
             DO jj = mj0(ind1), mj1(ind2) 
                DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji)
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji)
                END DO
             END DO
@@ -255 +247 @@
             END DO
          ENDIF
-               
-         ! --- North --- !
-         IF( lk_north ) THEN  
+         IF( lk_north ) THEN                            ! --- North --- !
             ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea
             ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1
             DO jj = mj0(ind1), mj1(ind2)
                DO ji = 1, jpi
-                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji)
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji)
                END DO
             END DO
@@ -333 +323 @@
       ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp )
       ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp )
-      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1., ztabrampu, 'U', 1., ztabrampv, 'V', 1. )
+      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp )
       mbkt_parent(:,:) = NINT( ztabramp (:,:) )
       mbku_parent(:,:) = NINT( ztabrampu(:,:) )