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 7334 – NEMO

Changeset 7334


Ignore:
Timestamp:
2016-11-25T10:51:35+01:00 (7 years ago)
Author:
jcastill
Message:

Changes after branch review before merging

Location:
branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/CONFIG/cfg.txt

    r7166 r7334  
    1111ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    1212ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     13GYRE_LONG OPA_SRC 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r7193 r7334  
    3939   USE wrk_nemo        ! Memory Allocation 
    4040   USE timing          ! Timing 
    41    USE sbcwave,  ONLY:  usd3dt, vsd3dt,wsd3d 
     41   USE sbcwave         ! Stokes velocities 
    4242 
    4343   IMPLICIT NONE 
    … …  
    162162      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    163163      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv 
    164       REAL(wp) ::  dsshnu, dsshnv 
     164      REAL(wp) ::  zdsshu, zdsshv 
    165165      !!---------------------------------------------------------------------- 
    166166      ! 
    … …  
    209209         END DO 
    210210      ENDIF 
    211 ! 
    212 !     In case ln_wave and ln_sdw, the surface vertical velocity is modified 
    213 !     accounting for Sokes Drift velocity 
    214 ! 
    215       IF ( ln_wave .AND. ln_sdw )  THEN 
    216          ! Compute d(ssh)/dx  and d(ssh)/dy    
    217          ! Compute the surface vertical velocity accounting for the Stokes Drift  
    218          !---------------------------------  
    219          DO jj = 2 , jpjm1  
    220             DO ji = 2 , jpim1  
    221                dsshnu = ( ssha(ji+1,jj) - ssha(ji,jj) ) / e1u(ji,jj)  
    222                dsshnv = ( ssha(ji,jj+1) - ssha(ji,jj) ) / e2v(ji,jj)  
    223                wn(ji,jj,1) = wn(ji,jj,1) +( usd3dt(ji,jj,1) * dsshnu     &  
    224                      &     + vsd3dt(ji,jj,1) * dsshnv                    &  
    225                      &     - ( wsd3d (ji,jj,1) )) * tmask(ji,jj,1)  
    226             ENDDO  
    227        ENDDO 
     211 
     212      IF( ln_wave .AND. ln_sdw ) THEN 
     213         ! Compute d(ssh)/dx  and d(ssh)/dy   
     214         ! Compute the surface vertical velocity accounting for the Stokes Drift 
     215         DO jj = 1 , jpjm1 
     216            DO ji = 1 , fs_jpim1 
     217              zdsshu = ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj) 
     218              zdsshv = ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
     219              wn(ji,jj,1) = wn(ji,jj,1) + ( usd3dt(ji,jj,1) * zdsshu   & 
     220                 &                        + vsd3dt(ji,jj,1) * zdsshv   & 
     221                 &        - wsd3d (ji,jj,1) ) * tmask(ji,jj,1) 
     222            END DO 
     223         END DO 
    228224      ENDIF 
    229225      ! 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7279 r7334  
    305305         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')'  
    306306         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')'  
    307          WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes   ), ' (', TRIM(sn_snd_crtw%clcat   ), ')'  
     307         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')'  
    308308         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref  
    309309         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7279 r7334  
    5353   USE sbcwave          ! Wave module 
    5454   USE bdy_par          ! Require lk_bdy 
    55    USE zdf_oce,  ONLY : ln_zdfqiao 
    5655 
    5756   IMPLICIT NONE 
    … …  
    221220       
    222221      IF ( ln_wave ) THEN 
    223       !Activated wave module but neither drag nor stokes drift activated 
    224       IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) )   THEN  
     222         !Activated wave module but neither drag nor stokes drift activated 
     223         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) )   THEN  
    225224             CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F') 
    226       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
     225         !drag coefficient read from wave model definable only with mfs bulk formulae and core  
    227226         ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )       THEN        
    228227             CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 
    229          ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN  
     228         ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN  
    230229             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    231230         ENDIF 
    232231      ELSE 
    233       IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor )                                &  
     232      IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor )                &  
    234233         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    235          &                  'with drag coefficient (ln_cdgw =T) '  ,                        &  
    236          &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &  
    237          &                  'or ocean stress modification due to waves (ln_tauoc=T) ',      &    
    238          &                  'or Stokes-Coriolis term (ln_stcori=T)'  )  
     234         &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
     235         &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
     236         &                  'or ocean stress modification due to waves (ln_tauoc=T) ',      & 
     237         &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    239238      ENDIF  
    240239      !                          ! Choice of the Surface Boudary Condition (set nsbc) 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r7193 r7334  
    4040   LOGICAL, PUBLIC     ::   cpl_wdrag=.FALSE. 
    4141 
    42    INTEGER             ::   jpfld                ! number of files to read for stokes drift 
    43    INTEGER             ::   jp_usd               ! index of stokes drift  (i-component) (m/s)    at T-point 
    44    INTEGER             ::   jp_vsd               ! index of stokes drift  (j-component) (m/s)    at T-point 
    45    INTEGER             ::   jp_swh               ! index of significant wave hight      (m)      at T-point 
    46    INTEGER             ::   jp_wmp               ! index of mean wave period            (s)      at T-point 
     42   INTEGER ::   jpfld                ! number of files to read for stokes drift 
     43   INTEGER ::   jp_usd               ! index of stokes drift  (i-component) (m/s)    at T-point 
     44   INTEGER ::   jp_vsd               ! index of stokes drift  (j-component) (m/s)    at T-point 
     45   INTEGER ::   jp_swh               ! index of significant wave hight      (m)      at T-point 
     46   INTEGER ::   jp_wmp               ! index of mean wave period            (s)      at T-point 
    4747 
    4848   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_cd    ! structure of input fields (file informations, fields read) Drag Coefficient 
    … …  
    5555   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       :: tsd2d 
    5656   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       :: usd2d, vsd2d 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: usd3d, vsd3d, wsd3d  
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: usd3dt, vsd3dt 
    5957   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       :: zusd2dt, zvsd2dt 
     58   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     :: usd3d, vsd3d, wsd3d  
     59   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     :: usd3dt, vsd3dt 
    6060 
    6161   !! * Substitutions 
    … …  
    8282      !!--------------------------------------------------------------------- 
    8383      INTEGER                ::   jj,ji,jk  
    84       REAL(wp)                       ::  ztransp, zsp0, zk, zus, zvs 
    85       REAL(wp), DIMENSION(jpi,jpj)   ::  zfac  
     84      REAL(wp)                       ::  ztransp, zfac, zsp0, zk, zus, zvs 
    8685      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3hdiv   ! 3D workspace 
    87  
     86      !!--------------------------------------------------------------------- 
     87      ! 
    8888 
    8989      CALL wrk_alloc( jpi,jpj,jpk, ze3hdiv ) 
    … …  
    9191         DO jj = 1, jpj 
    9292            DO ji = 1, jpi 
    93             ! On T grid 
    94             ! Stokes transport speed estimated from Hs and Tmean 
    95             ztransp = 2.0_wp*rpi*swh(ji,jj)**2.0_wp/(16.0_wp*MAX(wmp(ji,jj),0.0000001_wp)) 
    96             ! Stokes surface speed 
    97             zsp0 = SQRT( zusd2dt(ji,jj)**2 + zvsd2dt(ji,jj)**2) 
    98             ! Wavenumber scale 
    99             zk = ABS(zsp0)/MAX(ABS(5.97_wp*ztransp),0.0000001_wp) 
    100             ! Depth attenuation 
    101             zfac(ji,jj) = EXP(-2.0_wp*zk*fsdept(ji,jj,jk))/(1.0_wp+8.0_wp*zk*fsdept(ji,jj,jk)) 
     93               ! On T grid 
     94               ! Stokes transport speed estimated from Hs and Tmean 
     95               ztransp = 2.0_wp*rpi*swh(ji,jj)**2.0_wp/(16.0_wp*MAX(wmp(ji,jj),0.0000001_wp)) 
     96               ! Stokes surface speed 
     97               zsp0 = SQRT( zusd2dt(ji,jj)**2 + zvsd2dt(ji,jj)**2) 
     98               ! Wavenumber scale 
     99               zk = ABS(zsp0)/MAX(ABS(5.97_wp*ztransp),0.0000001_wp) 
     100               ! Depth attenuation 
     101               zfac = EXP(-2.0_wp*zk*fsdept(ji,jj,jk))/(1.0_wp+8.0_wp*zk*fsdept(ji,jj,jk)) 
     102               ! 
     103               usd3dt(ji,jj,jk) = zfac * zusd2dt(ji,jj) * tmask(ji,jj,jk) 
     104               vsd3dt(ji,jj,jk) = zfac * zvsd2dt(ji,jj) * tmask(ji,jj,jk) 
    102105            END DO 
    103106         END DO 
    104          ! 
    105          DO jj = 1, jpj 
    106             DO ji = 1, jpi 
    107                usd3dt(ji,jj,jk) = zfac(ji,jj) * zusd2dt(ji,jj) * tmask(ji,jj,jk)  
    108                vsd3dt(ji,jj,jk) = zfac(ji,jj) * zvsd2dt (ji,jj) * tmask(ji,jj,jk)  
    109             END DO  
    110          END DO  
    111107      END DO  
    112       ! Into the U and V Grid  
    113       DO jk = 1, jpkm1  
     108      ! Into the U and V Grid 
     109      DO jk = 1, jpkm1 
    114110         DO jj = 1, jpjm1 
    115             DO ji = 1, jpim1 
    116                usd3d(ji,jj,jk) =   0.5 *  umask(ji,jj,jk)  *        & 
    117                                &  (usd3dt(ji,jj,jk) + usd3dt(ji+1,jj,jk)) 
    118                vsd3d(ji,jj,jk) =  0.5 *  vmask(ji,jj,jk)  *           & 
    119                                &  (vsd3dt(ji,jj,jk) + vsd3dt(ji,jj+1,jk)) 
     111            DO ji = 1, fs_jpim1 
     112               usd3d(ji,jj,jk) = 0.5 *  umask(ji,jj,jk) *   & 
     113                               &  ( usd3dt(ji,jj,jk) + usd3dt(ji+1,jj,jk) ) 
     114               vsd3d(ji,jj,jk) = 0.5 *  vmask(ji,jj,jk) *   & 
     115                               &  ( vsd3dt(ji,jj,jk) + vsd3dt(ji,jj+1,jk) ) 
    120116            END DO 
    121117         END DO 
    … …  
    125121      CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 
    126122      ! 
    127       DO jk = 1, jpkm1                       ! e3t * Horizontal divergence 
    128          DO jj = 2, jpjm1 
    129             DO ji = fs_2, fs_jpim1   ! vector opt. 
    130                ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u_n(ji  ,jj,jk) * usd3d(ji  ,jj,jk)     & 
    131                   &                 - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk)     & 
    132                   &                 + e1v(ji,jj  ) * fse3v_n(ji,jj  ,jk) * vsd3d(ji,jj  ,jk)     & 
    133                   &                 - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
     123      DO jk = 1, jpkm1               ! Horizontal divergence 
     124         DO jj = 2, jpj 
     125            DO ji = fs_2, jpi 
     126               ze3hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * usd3d(ji  ,jj,jk)     & 
     127                  &                 - e2u(ji-1,jj) * usd3d(ji-1,jj,jk)     & 
     128                  &                 + e1v(ji,jj  ) * vsd3d(ji,jj  ,jk)     & 
     129                  &                 - e1v(ji,jj-1) * vsd3d(ji,jj-1,jk)   ) * r1_e1e2t(ji,jj) 
    134130            END DO 
    135131         END DO 
    136          IF( .NOT. AGRIF_Root() ) THEN 
    137             IF( nbondi ==  1 .OR. nbondi == 2 )   ze3hdiv(nlci-1,   : ,jk) = 0._wp      ! east 
    138             IF( nbondi == -1 .OR. nbondi == 2 )   ze3hdiv(  2   ,   : ,jk) = 0._wp      ! west 
    139             IF( nbondj ==  1 .OR. nbondj == 2 )   ze3hdiv(  :  ,nlcj-1,jk) = 0._wp      ! north 
    140             IF( nbondj == -1 .OR. nbondj == 2 )   ze3hdiv(  :   ,  2  ,jk) = 0._wp      ! south 
    141          ENDIF 
    142132      END DO 
     133      ! 
     134      IF( .NOT. AGRIF_Root() ) THEN 
     135         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3hdiv(nlci-1,   :  ,:) = 0._wp      ! east 
     136         IF( nbondi == -1 .OR. nbondi == 2 )   ze3hdiv(  2   ,   :  ,:) = 0._wp      ! west 
     137         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3hdiv(  :   ,nlcj-1,:) = 0._wp      ! north 
     138         IF( nbondj == -1 .OR. nbondj == 2 )   ze3hdiv(  :   ,  2   ,:) = 0._wp      ! south 
     139      ENDIF 
     140      ! 
    143141      CALL lbc_lnk( ze3hdiv, 'T', 1. ) 
    144142      ! 
    145       DO jk = jpkm1, 1, -1                   !* integrate from the bottom the e3t * hor. divergence 
    146          wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk) 
     143      DO jk = jpkm1, 1, -1                   ! integrate from the bottom the e3t * hor. divergence 
     144         wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - fse3t_n(:,:,jk) * ze3hdiv(:,:,jk) 
    147145      END DO 
    148146#if defined key_bdy 
    … …  
    157155   END SUBROUTINE sbc_stokes 
    158156 
    159    SUBROUTINE sbc_qiao( ) 
     157   SUBROUTINE sbc_qiao 
    160158      !!--------------------------------------------------------------------- 
    161159      !!                     ***  ROUTINE sbc_qiao  *** 
    … …  
    167165      !! ** action   
    168166      !!--------------------------------------------------------------------- 
    169       INTEGER                ::   jj,ji 
     167      INTEGER :: jj, ji 
    170168 
    171169      ! Calculate the module of the stokes drift on T grid 
    … …  
    173171      DO jj = 1, jpj 
    174172         DO ji = 1, jpi 
    175             tsd2d(ji,jj) = SQRT( zusd2dt(ji,jj)**2 + zvsd2dt(ji,jj)**2) 
     173            tsd2d(ji,jj) = SQRT( zusd2dt(ji,jj) * zusd2dt(ji,jj) + zvsd2dt(ji,jj) * zvsd2dt(ji,jj) ) 
    176174         END DO 
    177175      END DO 
    … …  
    193191      !! ** action   
    194192      !!--------------------------------------------------------------------- 
    195       USE zdf_oce    ,  ONLY : ln_zdfqiao 
     193      USE zdf_oce,  ONLY : ln_zdfqiao 
    196194 
    197195      IMPLICIT NONE 
    … …  
    223221         IF(lwm) WRITE ( numond, namsbc_wave ) 
    224222         ! 
    225          IF ( ln_cdgw ) THEN 
    226             IF ( .NOT. cpl_wdrag ) THEN 
     223         IF( ln_cdgw ) THEN 
     224            IF( .NOT. cpl_wdrag ) THEN 
    227225               ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg 
    228226               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 
    … …  
    236234         ENDIF 
    237235 
    238          IF ( ln_tauoc ) THEN 
    239             IF ( .NOT. cpl_wstrf ) THEN 
     236         IF( ln_tauoc ) THEN 
     237            IF( .NOT. cpl_wstrf ) THEN 
    240238               ALLOCATE( sf_tauoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauoc 
    241239               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 
    … …  
    246244            ENDIF 
    247245            ALLOCATE( tauoc_wave(jpi,jpj) ) 
    248             tauoc_wave(:,:) = 0.0 
    249          ENDIF 
    250  
    251          IF ( ln_sdw ) THEN 
     246         ENDIF 
     247 
     248         IF( ln_sdw ) THEN 
    252249            ! Find out how many fields have to be read from file if not coupled 
    253250            jpfld=0 
    … …  
    292289            ALLOCATE( swh(jpi,jpj), wmp(jpi,jpj) ) 
    293290            ALLOCATE( zusd2dt(jpi,jpj), zvsd2dt(jpi,jpj) ) 
    294             usd3d(:,:,:) = 0._wp   ;   usd2d(:,:) = 0._wp   ;    
    295             vsd3d(:,:,:) = 0._wp   ;   vsd2d(:,:) = 0._wp   ;  
    296             wsd3d(:,:,:) = 0._wp   ; 
    297             usd3dt(:,:,:) = 0._wp  ;   vsd3dt(:,:,:) = 0._wp   ; 
    298             swh  (:,:)   = 0._wp   ;    wmp (:,:) = 0._wp ; 
    299             IF ( ln_zdfqiao ) THEN     !==  Vertical mixing enhancement using Qiao,2010  ==! 
    300                IF ( .NOT. cpl_wnum ) THEN 
     291            usd3d(:,:,:) = 0._wp 
     292            vsd3d(:,:,:) = 0._wp 
     293            wsd3d(:,:,:) = 0._wp 
     294            IF( ln_zdfqiao ) THEN     !==  Vertical mixing enhancement using Qiao,2010  ==! 
     295               IF( .NOT. cpl_wnum ) THEN 
    301296                  ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
    302297                  IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable toallocate sf_wave structure' ) 
    … …  
    306301               ENDIF 
    307302               ALLOCATE( wnum(jpi,jpj),tsd2d(jpi,jpj) ) 
    308                wnum(:,:) = 0._wp ; tsd2d(:,:) = 0._wp 
    309             ENDIF 
    310          ENDIF 
    311       ENDIF 
    312       ! 
    313       IF ( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN              !==  Neutral drag coefficient  ==! 
     303            ENDIF 
     304         ENDIF 
     305      ENDIF 
     306      ! 
     307      IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN              !==  Neutral drag coefficient  ==! 
    314308         CALL fld_read( kt, nn_fsbc, sf_cd )      ! read from external forcing 
    315309         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 
    316310      ENDIF 
    317311 
    318       IF ( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN             !==  Wave induced stress  ==! 
     312      IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN             !==  Wave induced stress  ==! 
    319313         CALL fld_read( kt, nn_fsbc, sf_tauoc )      !* read wave norm stress from external forcing 
    320314         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) 
    321315      ENDIF 
    322316 
    323       IF ( ln_sdw )  THEN                         !==  Computation of the 3d Stokes Drift  ==!  
     317      IF( ln_sdw )  THEN                         !==  Computation of the 3d Stokes Drift  ==!  
    324318         ! 
    325319         ! Read from file only if the field is not coupled 
    … …  
    333327         ! 
    334328         ! Read also wave number if needed, so that it is available in coupling routines 
    335          IF ( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 
     329         IF( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 
    336330            CALL fld_read( kt, nn_fsbc, sf_wn )      !* read wave parameters from external forcing 
    337331            wnum(:,:) = sf_wn(1)%fnow(:,:,1) 
    … …  
    344338         IF( jpfld == 4 ) THEN 
    345339            CALL sbc_stokes() 
    346             IF ( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 
     340            IF( ln_zdfqiao .AND. .NOT. cpl_wnum ) THEN 
    347341               CALL sbc_qiao() 
    348342            ENDIF 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7167 r7334  
    3737   USE sbcwave        ! wave module 
    3838   USE sbc_oce        ! surface boundary condition: ocean 
    39  
    4039   USE diaptr         ! Poleward heat transport  
    41    USE sbcwave        ! wave module 
    42    USE sbc_oce        ! surface boundary condition: ocean 
    4340 
    4441   IMPLICIT NONE 
    … …  
    111108      ! 
    112109      !                                         !==  effective transport  ==! 
    113       IF (ln_wave .AND. ln_sdw) THEN 
     110      IF(ln_wave .AND. ln_sdw) THEN 
    114111         DO jk = 1, jpkm1 
    115112            zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) *      & 
    … …  
    121118         END DO 
    122119      ELSE 
    123       DO jk = 1, jpkm1 
    124          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    125          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    126          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    127       END DO 
     120         DO jk = 1, jpkm1 
     121            zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)             ! eulerian transport only 
     122            zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     123            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     124         END DO 
    128125      ENDIF 
    129126      ! 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90

    r7193 r7334  
    66   !! History :  3.6  !  2014-10  (E. Clementi)  Original code 
    77   !!---------------------------------------------------------------------- 
    8    !!---------------------------------------------------------------------- 
    9    !!   qiao_init       
    108   !!   zdf_qiao        : compute Qiao parameters 
    119   !!---------------------------------------------------------------------- 
    1210 
    13    USE iom             ! I/O manager library 
    1411   USE in_out_manager  ! I/O manager 
    1512   USE lib_mpp         ! distribued memory computing library 
    … …  
    1815   USE sbcwave         ! wave module 
    1916   USE dom_oce 
     17   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)   
    2018    
    21    !!---------------------------------------------------------------------- 
    22    !!   qiao_init       : compute QBv: Qiao terms to be added to vertical eddy 
    23    !!                     diffusivity and viscosity coefficients  
    24    !!---------------------------------------------------------------------- 
    25  
    2619   IMPLICIT NONE 
    2720   PRIVATE 
    2821 
    29    PUBLIC   zdf_qiao    ! routine called in zdf_ric 
     22   PUBLIC zdf_qiao    ! routine called in step 
    3023 
    31    REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:)     :: QBv, QBvu, QBvv 
     24   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: qbv, qbvu, qbvv 
    3225 
    3326   !! * Substitutions 
    3427#  include "domzgr_substitute.h90" 
     28#  include "vectopt_loop_substitute.h90" 
    3529   !!---------------------------------------------------------------------- 
    3630   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
    … …  
    4539      !!                     ***  ROUTINE zdf_qiao *** 
    4640      !! 
    47       !! ** Purpose :Compute the Qiao term (QBv) to be added to 
     41      !! ** Purpose :Compute the Qiao term (qbv) to be added to 
    4842      !!             vertical viscosity and diffusivity coeffs.   
    4943      !! 
    50       !! ** Method  :QBv = alpha * A * Us(0) * exp (3 * k * z) 
     44      !! ** Method  :qbv = alpha * A * Us(0) * exp (3 * k * z) 
    5145      !!              
    5246      !! ** action  :Compute the Qiao wave dependent term  
    … …  
    5650      INTEGER, INTENT( in  ) ::  kt   ! ocean time step 
    5751      ! 
    58       INTEGER                ::  jj, ji, jk 
     52      INTEGER :: jj, ji, jk   ! dummy loop indices 
    5953      !!--------------------------------------------------------------------- 
    6054      ! 
    61       ! 
    62       !                                         ! -------------------- ! 
    6355      IF( kt == nit000 ) THEN                   ! First call kt=nit000 ! 
    64          ALLOCATE(QBv(jpi,jpj,jpk))             ! -------------------- ! 
    65          ALLOCATE(QBvu(jpi,jpj,jpk)) 
    66          ALLOCATE(QBvv(jpi,jpj,jpk)) 
     56         IF( .NOT. ( ln_wave .AND. ln_sdw ) )   & 
     57            &   CALL ctl_stop ( 'Ask for wave Qiao enhanced turbulence but ln_wave   & 
     58            &                    and ln_sdw have to be activated') 
     59         IF( zdf_qiao_alloc() /= 0 )   & 
     60            &   CALL ctl_stop( 'STOP', 'zdf_qiao : unable to allocate arrays' ) 
    6761      ENDIF 
    6862 
    69       QBv (:,:,:) = 0.0 
    70       QBvu(:,:,:) = 0.0 
    71       QBvv(:,:,:) = 0.0 
    72  
    7363      ! 
    74       ! Compute the Qiao term Bv (QBv) to be added to 
     64      ! Compute the Qiao term Bv (qbv) to be added to 
    7565      ! vertical viscosity and diffusivity 
    76       ! QBv = alpha * A * Us(0) * exp (3 * k * z) 
     66      ! qbv = alpha * A * Us(0) * exp (3 * k * z) 
    7767      ! alpha here is set to 1 
    7868      !--------------------------------------------------------------------------------- 
    7969      ! 
    80       IF ( ln_wave ) THEN 
    81          DO jk = 1, jpk 
    82             DO jj = 1, jpjm1 
    83                DO ji = 1, jpim1 
    84                   QBv(ji,jj,jk) = 1.0 * 0.353553 * swh(ji,jj) * tsd2d(ji,jj) *       & 
    85                &              exp(3.0 * wnum(ji,jj) *                                &                      
    86                &              (-MIN( fsdept(ji  ,jj  ,jk) , fsdept(ji+1,jj  ,jk),    & 
    87                &                     fsdept(ji  ,jj+1,jk) , fsdept(ji+1,jj+1,jk)))) 
    88                END DO 
     70      DO jk = 1, jpk 
     71         DO jj = 1, jpjm1 
     72            DO ji = 1, fs_jpim1 
     73               qbv(ji,jj,jk) = 1.0 * 0.353553 * swh(ji,jj) * tsd2d(ji,jj) *           & 
     74            &                  EXP(3.0 * wnum(ji,jj) *                                &                      
     75            &                  (-MIN( fsdepw(ji  ,jj  ,jk), fsdepw(ji+1,jj  ,jk),     & 
     76            &                         fsdepw(ji  ,jj+1,jk), fsdepw(ji+1,jj+1,jk))))   & 
     77            &                          * wmask(ji,jj,jk) 
    8978            END DO 
    9079         END DO 
    91  
    92          QBv(jpi,:,:)=QBv(jpim1,:,:) 
    93          QBv(:,jpj,:)=QBv(:,jpjm1,:) 
    94  
    95          ! 
    96          ! Interpolate Qiao parameter QBv into the grid_U and grid_V 
    97          !------------------------------------------------- 
    98          ! 
    99          DO jk = 1, jpk 
    100             DO jj = 1, jpjm1 
    101                DO ji = 1, jpim1 
    102                   QBvu(ji,jj,jk) = 0.5 *  umask(ji,jj,jk)  *               & 
    103                &           ( QBv(ji  ,jj,jk) * tmask(ji  ,jj,jk)           & 
    104                &           + QBv(ji+1,jj,jk) * tmask(ji+1,jj,jk) ) 
    105                   QBvv(ji,jj,jk) = 0.5 *  vmask(ji,jj,jk)  *               & 
    106                &           ( QBv(ji,jj  ,jk) * tmask(ji,jj  ,jk)           & 
    107                &           + QBv(ji,jj+1,jk) * tmask(ji,jj+1,jk) ) 
    108                END DO 
     80      END DO 
     81      ! 
     82      CALL lbc_lnk( qbv, 'W', 1. )   ! Lateral boundary conditions 
     83          
     84      ! 
     85      ! Interpolate Qiao parameter qbv into the grid_U and grid_V 
     86      !---------------------------------------------------------- 
     87      ! 
     88      DO jk = 1, jpk 
     89         DO jj = 1, jpjm1 
     90            DO ji = 1, fs_jpim1 
     91               qbvu(ji,jj,jk) = 0.5 * wumask(ji,jj,jk)  *              &   
     92            &                  ( qbv(ji,jj,jk) + qbv(ji+1,jj  ,jk) ) 
     93               qbvv(ji,jj,jk) = 0.5 * wvmask(ji,jj,jk)  *              & 
     94            &                  ( qbv(ji,jj,jk) + qbv(ji  ,jj+1,jk) ) 
    10995            END DO 
    11096         END DO 
    111          !  
    112          QBvu(jpi,:,:)=QBvu(jpim1,:,:) 
    113          QBvu(:,jpj,:)=QBvu(:,jpjm1,:) 
    114          QBvv(jpi,:,:)=QBvv(jpim1,:,:) 
    115          QBvv(:,jpj,:)=QBvv(:,jpjm1,:) 
     97      END DO 
     98      !  
     99      CALL lbc_lnk( qbvu, 'U', 1. ) ; CALL lbc_lnk( qbvv, 'V', 1. )   ! Lateral boundary conditions 
    116100 
    117         ELSE 
    118            CALL ctl_stop( 'STOP', 'To use Qiao formulation you have to set: ln_wave=.true.') 
    119         ENDIF 
    120         ! 
     101      ! Enhance vertical mixing coeff.          
     102      !------------------------------- 
     103      ! 
     104      DO jk = 1, jpkm1 
     105         DO jj = 1, jpj 
     106            DO ji = 1, jpi 
     107               avmu(ji,jj,jk) = ( avmu(ji,jj,jk) + qbvu(ji,jj,jk) ) * umask(ji,jj,jk) 
     108               avmv(ji,jj,jk) = ( avmv(ji,jj,jk) + qbvv(ji,jj,jk) ) * vmask(ji,jj,jk) 
     109               avt (ji,jj,jk) = ( avt (ji,jj,jk) + qbv (ji,jj,jk) ) * tmask(ji,jj,jk) 
     110            END DO 
     111         END DO 
     112      END DO 
     113      ! 
    121114   END SUBROUTINE zdf_qiao 
     115 
     116   INTEGER FUNCTION zdf_qiao_alloc() 
     117      !!---------------------------------------------------------------------- 
     118      !!                ***  FUNCTION zdf_qiao_alloc  *** 
     119      !!---------------------------------------------------------------------- 
     120      ALLOCATE( qbv(jpi,jpj,jpk), qbvu(jpi,jpj,jpk), qbvv(jpi,jpj,jpk),   & 
     121         &      STAT = zdf_qiao_alloc ) 
     122      ! 
     123      IF( lk_mpp             )  CALL mpp_sum ( zdf_qiao_alloc ) 
     124      IF( zdf_qiao_alloc > 0 )  CALL ctl_warn('zdf_qiao_alloc: allocation of arrays failed.') 
     125      ! 
     126   END FUNCTION zdf_qiao_alloc 
    122127       
    123128   !!====================================================================== 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7279 r7334  
    133133      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz 
    134134      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    135       IF( ln_zdfqiao )   THEN 
    136          !Activated Qiao enhanced turbulence but neither ln_wave or ln_sdw are activated  
    137          IF ( .NOT.( ln_wave .AND. ln_sdw ) )   THEN  
    138             CALL ctl_stop ( 'Ask for wave Qiao enhanced turbulence but ln_wave and ln_sdw have to be activated')  
    139          ELSE  
    140             CALL zdf_qiao(kstp )                             ! Qiao vertical mixing  
    141             DO jk = 1, jpkm1 
    142                DO jj = 1, jpj 
    143                   DO ji = 1, jpi 
    144                      avmu(ji,jj,jk) = (avmu(ji,jj,jk) + QBvu(ji,jj,jk)) * umask(ji,jj,jk) 
    145                      avmv(ji,jj,jk) = (avmv(ji,jj,jk) + QBvv(ji,jj,jk)) * vmask(ji,jj,jk) 
    146                      avt( ji,jj,jk) = (avt( ji,jj,jk) + QBv(ji,jj,jk))  * tmask(ji,jj,jk) 
    147                   END DO 
    148                END DO 
    149             END DO 
    150          ENDIF 
    151       ENDIF 
     135      IF( ln_zdfqiao )   CALL zdf_qiao( kstp )             ! Qiao vertical mixing  
    152136      ! 
    153137      IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value) 

  • branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/SETTE/sette.sh

    r5930 r7334  
    8888# 
    8989# Compiler among those in NEMOGCM/ARCH 
    90 COMPILER=X64_ADA 
    91 export BATCH_COMMAND_PAR="llsubmit" 
     90module load cray-netcdf-hdf5parallel 
     91COMPILER=XC40_METO 
     92export BATCH_COMMAND_PAR="qsub" 
    9293export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR 
    9394export INTERACT_FLAG="no" 
Note: See TracChangeset for help on using the changeset viewer.