Changeset 4376


Ignore:
Timestamp:
2014-01-28T19:47:54+01:00 (7 years ago)
Author:
hliu
Message:

updating wetting/drying filter for explicit time_splitting

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r4050_NOC_WaD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3680 r4376  
    126126      REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e  
    127127      REAL(wp), POINTER, DIMENSION(:,:) :: zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum 
     128 
     129      REAL(wp), POINTER, DIMENSION(:,:) :: zwadflt 
    128130      !!---------------------------------------------------------------------- 
    129131      ! 
     
    133135      CALL wrk_alloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e   ) 
    134136      CALL wrk_alloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 
     137 
     138      IF(ln_wad) CALL wrk_alloc( jpi, jpj, zwadflt) 
    135139      ! 
    136140      IF( kt == nit000 ) THEN             !* initialisation 
     
    180184        z2dt_bf = 2.0_wp * rdt 
    181185      ENDIF 
     186 
     187      IF(ln_wad) zwadflt(:,:) = 1._wp 
    182188 
    183189      ! ----------------------------------------------------------------------------- 
     
    427433#endif 
    428434         ! 
    429          DO jj = 2, jpjm1                                      ! leap-frog on ssh_e 
    430             DO ji = fs_2, fs_jpim1   ! vector opt. 
    431                ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)  
    432             END DO 
    433          END DO 
     435         IF(ln_wad) THEN 
     436            DO jj = 2, jpjm1                                      ! leap-frog on ssh_e 
     437               DO ji = fs_2, fs_jpim1   ! vector opt. 
     438                  ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * & 
     439                                &   ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)  
     440                  IF(ssha_e(ji,jj) <= rn_wadmin) THEN 
     441                    zwadflt(ji,   jj  ) = 0._wp 
     442                    zwadflt(ji-1, jj  ) = 0._wp 
     443                    zwadflt(ji,   jj-1) = 0._wp 
     444                    zwadflt(ji-1, jj-1) = 0._wp 
     445                  END IF 
     446               END DO 
     447            END DO 
     448         ELSE 
     449            DO jj = 2, jpjm1                                      ! leap-frog on ssh_e 
     450               DO ji = fs_2, fs_jpim1   ! vector opt. 
     451                  ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * & 
     452                                &   ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)  
     453               END DO 
     454            END DO 
     455         END IF 
    434456 
    435457         !                                                !* after barotropic velocities (vorticity scheme dependent) 
     
    669691      !  
    670692      !                                   !* update the general momentum trend 
    671       DO jk=1,jpkm1 
    672          ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b 
    673          va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b 
    674       END DO 
     693      IF(ln_wad) THEN 
     694         DO jk=1,jpkm1 
     695            ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b * zwadflt(:,:) 
     696            va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b * zwadflt(:,:) 
     697         END DO 
     698      ELSE 
     699         DO jk=1,jpkm1 
     700            ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b 
     701            va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b 
     702         END DO 
     703      END IF 
     704 
    675705      un_b  (:,:) =  zu_sum(:,:)  
    676706      vn_b  (:,:) =  zv_sum(:,:)  
     
    683713      CALL wrk_dealloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e   ) 
    684714      CALL wrk_dealloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 
     715 
     716      IF(ln_wad) CALL wrk_dealloc( jpi, jpj, zwadflt) 
    685717      ! 
    686718      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
Note: See TracChangeset for help on using the changeset viewer.