Changeset 8129 for branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

Timestamp:

2017-06-02T16:08:12+02:00 (7 years ago)

Author:

clem

Message:

make those things work: ghostcells>1 + nn_ice(child)=0 + fix timing

File:

• branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90 (modified) (10 diffs)

branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

@@ -34 +34 @@
       !!   *** ROUTINE Agrif_Sponge_Tra ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
       !
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       CALL Agrif_Sponge
@@ -45 +45 @@
       tabspongedone_tsn = .FALSE.
 
-      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -57 +57 @@
       !!   *** ROUTINE Agrif_Sponge_dyn ***
       !!---------------------------------------------
-      REAL(wp) :: timecoeff
+      REAL(wp) :: zcoef
       !!---------------------------------------------
 
 #if defined SPONGE
-      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
 
       Agrif_SpecialValue=0.
@@ -68 +68 @@
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.         
-      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge)
 
       tabspongedone_u = .FALSE.
       tabspongedone_v = .FALSE.
-      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge)
 
       Agrif_UseSpecialValue = .FALSE.
@@ -84 +84 @@
       !!   *** ROUTINE  Agrif_Sponge ***
       !!---------------------------------------------
-      INTEGER  :: ji,jj,jk
-      INTEGER  :: ispongearea, ilci, ilcj
-      LOGICAL  :: ll_spdone
-      REAL(wp) :: z1spongearea, zramp
-      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp
+      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
+      !
+      INTEGER  :: ji, jj, ind1, ind2
+      INTEGER  :: ispongearea
+      REAL(wp) :: z1_spongearea
+      !!---------------------------------------------
 
 #if defined SPONGE || defined SPONGE_TOP
-      ll_spdone=.TRUE.
       IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
-         ! Define ramp from boundaries towards domain interior
-         ! at T-points
+         ! Define ramp from boundaries towards domain interior at T-points
          ! Store it in ztabramp
-         ll_spdone=.FALSE.
-
-         CALL wrk_alloc( jpi, jpj, ztabramp )
 
          ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
-         ilci = nlci - ispongearea
-         ilcj = nlcj - ispongearea 
-         z1spongearea = 1._wp / REAL( ispongearea - 2 )
-
+         z1_spongearea = 1._wp / REAL( ispongearea - 1 )
+         
          ztabramp(:,:) = 0._wp
 
+         ! --- West --- !
          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
             DO jj = 1, jpj
-               IF ( umask(2,jj,1) == 1._wp ) THEN
-                 DO ji = 2, ispongearea                  
-                    ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea
-                 END DO
-               ENDIF
+               DO ji = ind1, ind2                  
+                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
+               END DO
             ENDDO
          ENDIF
 
+         ! --- East --- !
          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            ind1 = nlci - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlci - (1+nbghostcells)
             DO jj = 1, jpj
-               IF ( umask(nlci-2,jj,1) == 1._wp ) THEN
-                  DO ji = ilci+1,nlci-1
-                     zramp = (ji - (ilci+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  ENDDO
-               ENDIF
+               DO ji = ind1, ind2
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) )
+               ENDDO
             ENDDO
          ENDIF
 
+         ! --- South --- !
          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,2,1) == 1._wp ) THEN
-                  DO jj = 2, ispongearea
-                     zramp = ( ispongearea-jj ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + (ispongearea-1)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
+               END DO
             ENDDO
          ENDIF
 
+         ! --- North --- !
          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-            DO ji = 1, jpi
-               IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN
-                  DO jj = ilcj+1,nlcj-1
-                     zramp = (jj - (ilcj+1) ) * z1spongearea
-                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
-                  END DO
-               ENDIF
+            ind1 = nlcj - (1+nbghostcells) - (ispongearea-1)
+            ind2 = nlcj - (1+nbghostcells)
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+               END DO
             ENDDO
          ENDIF
@@ -158 +153 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
-               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
-            END DO
-         END DO
-
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) )
+            END DO
+         END DO
          CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsaht_spv, 'V', 1. )
+         
          spongedoneT = .TRUE.
       ENDIF
@@ -179 +174 @@
             END DO
          END DO
-
          CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( fsahm_spf, 'F', 1. )
+         
          spongedoneU = .TRUE.
       ENDIF
-      !
-      IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )
       !
 #endif
@@ -205 +198 @@
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !!---------------------------------------------    
       !
       IF( before ) THEN
@@ -327 +321 @@
 
          jmax = j2-1
-         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North
 
          DO jj = j1+1, jmax
@@ -404 +398 @@
 
          imax = i2-1
-         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3)
+         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East
 
          DO jj = j1+1, j2