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 8755 for branches/UKMO/r8727_WAVE-2_Clementi_add_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 – NEMO

Ignore:
Timestamp:
2017-11-20T17:25:03+01:00 (6 years ago)
Author:
jcastill
Message:

Further changes for ticket #1980
Receive the ocean wind stress components from a wave model, both in forced and coupled mode

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r8727_WAVE-2_Clementi_add_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r8749 r8755  
    2929   PUBLIC sbc_flx       ! routine called by step.F90 
    3030 
    31    INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
    32    INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    33    INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
    34    INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file 
    35    INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    36    INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
     31   INTEGER             ::   jpfld         ! maximum number of files to read  
     32   INTEGER             ::   jp_utau       ! index of wind stress (i-component) file 
     33   INTEGER             ::   jp_vtau       ! index of wind stress (j-component) file 
     34   INTEGER             ::   jp_qtot       ! index of total (non solar+solar) heat file 
     35   INTEGER             ::   jp_qsr        ! index of solar heat file 
     36   INTEGER             ::   jp_emp        ! index of evaporation-precipation file 
    3737   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3838 
     
    8282      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8383      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
     84      LOGICAL  ::   ln_readtau            ! Is it necessary to read utau, vtau from file? 
    8485      !! 
    8586      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
     
    9091      ! 
    9192      IF( kt == nit000 ) THEN                ! First call kt=nit000   
     93         ln_readtau = .NOT. (ln_wave .AND. ln_tauw ) 
     94 
     95         ! prepare the index of the fields that have to be read 
     96         jpfld = 0 
     97         IF( ln_readtau ) THEN 
     98            jp_utau = jpfld+1 
     99            jp_vtau = jpfld+2 
     100            jpfld = jpfld+2 
     101         ELSE 
     102            jp_utau = 0   ;  jp_vtau = 0 
     103         ENDIF 
     104         jp_qtot = jpfld+1 
     105         jp_qsr = jpfld+2 
     106         jp_emp = jpfld+3 
     107         jpfld = jpfld+3 
     108 
    92109         ! set file information 
    93110         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes 
     
    105122         ! 
    106123         !                                         ! store namelist information in an array 
    107          slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
     124         IF( ln_readtau ) THEN 
     125            slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
     126         ENDIF 
    108127         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    109128         slf_i(jp_emp ) = sn_emp 
     
    133152         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    134153            DO ji = 1, jpi 
    135                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    136                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     154               IF( ln_readtau ) THEN 
     155                  utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     156                  vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     157               ENDIF 
    137158               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    138159               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     
    143164         ! 
    144165         !                                                        ! module of wind stress and wind speed at T-point 
    145          zcoef = 1. / ( zrhoa * zcdrag ) 
    146          DO jj = 2, jpjm1 
    147             DO ji = fs_2, fs_jpim1   ! vect. opt. 
    148                ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    149                zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    150                zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    151                taum(ji,jj) = zmod 
    152                wndm(ji,jj) = SQRT( zmod * zcoef ) 
     166         IF( ln_readtau ) THEN 
     167            zcoef = 1. / ( zrhoa * zcdrag ) 
     168            DO jj = 2, jpjm1 
     169               DO ji = fs_2, fs_jpim1   ! vect. opt. 
     170                  ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     171                  zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     172                  zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     173                  taum(ji,jj) = zmod 
     174                  wndm(ji,jj) = SQRT( zmod * zcoef ) 
     175               END DO 
    153176            END DO 
    154          END DO 
    155          taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
    156          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
     177            taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
     178            CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
     179         ENDIF 
    157180 
    158181         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
Note: See TracChangeset for help on using the changeset viewer.