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 6060 for branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 – NEMO

Ignore:
Timestamp:
2015-12-16T10:25:22+01:00 (8 years ago)
Author:
timgraham
Message:

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r5860 r6060  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
     
    7271      REAL(wp), DIMENSION(:,:,:), POINTER ::   zusd_t, zvsd_t, ze3hdiv   ! 3D workspace 
    7372      !! 
    74       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn 
     73      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn, ln_cdgw , ln_sdw 
    7574      !!--------------------------------------------------------------------- 
    7675      ! 
     
    8180         READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 
    8281901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp ) 
    83  
     82         ! 
    8483         REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model 
    8584         READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
     
    8786         IF(lwm) WRITE ( numond, namsbc_wave ) 
    8887         ! 
    89          IF ( ln_cdgw ) THEN 
     88         IF(lwp) THEN               ! Control print 
     89            WRITE(numout,*) '        Namelist namsbc_wave : surface wave setting'  
     90            WRITE(numout,*) '           wave drag coefficient                      ln_cdgw  = ', ln_cdgw   
     91            WRITE(numout,*) '           wave stokes drift                          ln_sdw   = ', ln_sdw 
     92         ENDIF 
     93         ! 
     94         IF( .NOT.( ln_cdgw .OR. ln_sdw ) )    & 
     95            &  CALL ctl_warn( 'ln_sbcwave=T but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' ) 
     96         IF( ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )   &        
     97            &  CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 
     98         ! 
     99         IF( ln_cdgw ) THEN 
    90100            ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg 
    91101            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 
     
    97107            cdn_wave(:,:) = 0.0 
    98108         ENDIF 
    99          IF ( ln_sdw ) THEN 
     109         IF( ln_sdw ) THEN 
    100110            slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn 
    101111            ALLOCATE( sf_sd(3), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg 
     
    115125      ENDIF 
    116126      ! 
    117       IF ( ln_cdgw ) THEN              !==  Neutral drag coefficient  ==! 
     127      IF( ln_cdgw ) THEN               !==  Neutral drag coefficient  ==! 
    118128         CALL fld_read( kt, nn_fsbc, sf_cd )      ! read from external forcing 
    119129         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 
    120130      ENDIF 
    121131      ! 
    122       IF ( ln_sdw )  THEN              !==  Computation of the 3d Stokes Drift  ==! 
     132      IF( ln_sdw )  THEN               !==  Computation of the 3d Stokes Drift  ==! 
     133         ! 
     134         CALL wrk_alloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv ) 
    123135         ! 
    124136         CALL fld_read( kt, nn_fsbc, sf_sd )    !* read drag coefficient from external forcing 
    125137         ! 
    126          ! 
    127          CALL wrk_alloc( jpi,jpj,jpk,   zusd_t, zvsd_t, ze3hdiv ) 
    128          !                                      !* distribute it on the vertical 
    129          DO jk = 1, jpkm1 
    130             zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
    131             zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 
     138         DO jk = 1, jpkm1                       !* distribute it on the vertical 
     139            zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 
     140            zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * gdept_n(:,:,jk) ) 
    132141         END DO 
    133          !                                      !* interpolate the stokes drift from t-point to u- and v-points 
    134          DO jk = 1, jpkm1 
     142         DO jk = 1, jpkm1                       !* interpolate the stokes drift from t-point to u- and v-points 
    135143            DO jj = 1, jpjm1 
    136144               DO ji = 1, jpim1 
     
    146154            DO jj = 2, jpjm1 
    147155               DO ji = fs_2, fs_jpim1   ! vector opt. 
    148                   ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     & 
    149                      &                 - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     & 
    150                      &                 + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     & 
    151                      &                 - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
     156                  ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     & 
     157                     &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     & 
     158                     &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     & 
     159                     &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
    152160               END DO   
    153161            END DO   
Note: See TracChangeset for help on using the changeset viewer.